PDP-10 Archive: uetp/lib/c36t1.cbl from BB-AE97A-BM

Trailing-Edge - PDP-10 Archives - BB-AE97A-BM - uetp/lib/c36t1.cbl

There are 4 other files named c36t1.cbl in the archive. Click here to see a list.

IDENTIFICATION DIVISION. 

PROGRAM-ID.

	C36T1.

AUTHOR.

	DIGITAL EQUIPMENT CORPORATION.

	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1983.

	This software is furnished under a license and may be used and
	copied only in accordance with  the terms of such license  and
	with the  inclusion  of  the  above  copyright  notice.   This
	software or any other  copies thereof may  not be provided  or
	otherwise made available to any other person.  No title to and
	ownership of the software is hereby transferred.

	The information in this software is subject to change  without
	notice and should not be construed as a commitment by  Digital
	Equipment Corporation.

	Digital assumes no responsibility  for the use or  reliability
	of its software on equipment which is not supplied by Digital.


	Test program for DEC-10/20 Cobol.

	This program performs minimal confidence test on DIX.   Please
	see program  F7T1.FOR for  a bit-by-bit  justification of  the
	initial and expected final values used here.

*
* Facility: DIX-TEST
*
* Edit History:
*
* Edit (%O'10', '3-Nov-82', 'Sandy Clemens')
* %(  Add cobol interface tests.  NOTE:  F7T1 has the detailed
*     justification of the source and expected destination values
*     used.
*     Files: C36T1.CBL (NEW), C32T1.VAX-COB (NEW) )%
*
* Edit (%O'11', '07-Dec-82', 'Sandy Clemens')
* %(  Add correct error status checking to interface verification
*     tests.  Files: C36T1.CBL (NEW), C32T1.VAX-COB (NEW) )%
*
*
* Edit (%O'14', '14-Jan-83', 'Sandy Clemens')
* %(  Many edits to the Installation Verification system (ICS)  files.
*     Add SYS:  to all  the  10/20 programs  in  the COPY  or  INCLUDE
*     statement for the interface files.   Add SYS$LIBRARY to the  VAX
*     programs in  the COPY  or INCLUDE  statement for  the  interface
*     files.  Add check for INFO or  SUCCESS status return in all  ICS
*     programs.   Add  Lib$Match_Cond  to  VMS  programs  for   status
*     checking.  Change  some  of  the  symbolic  variable  names  for
*     clarification.   Change  use  of  numeric  parameter  values  to
*     symbolic variable names.  Get rid  of use of "IMPLICIT  INTEGER"
*     in FORTRAN test programs.   Add copyright notice to  everything.
*     Make the TOPS-10 test programs  EXACTLY the same as the  TOPS-20
*     programs, in order to use the same ones on both systems.  Files:
*     F6T1.10-FOR   (DELETED),   F7T1.10-FOR   (DELETED),   C32T1.VAX-COB,
*     C36T1.CBL, F32T1.VAX-FOR, F6T1.FOR, F7T1.FOR, DIXTHST.TXT )%
*
* Edit (%O'20', '24-Jan-83', 'Sandy Clemens')
* %(  Add copyright and liability waiver to whatever needs it.
*     FILE: C32T1.VAX-COB, C36T1.CBL, CREDIX.CTL, CREDIX.VAX-COM,
*     DIXDMP.CBL, DIXDMP.VAX-COB, DIXMNT.CBL, DIXTST.CBL,
*     DIXTST.VAX-COB, F32T1.VAX-FOR, F6T1.FOR, F7T1.FOR, PART1.CBL,
*     PART3.VAX-COB, RUNDIX.CTL, RUNDIX.VAX-COM, SUB6X1.FOR,
*     SUB7X1.FOR  )%
*
* Edit (%O'21', '25-Jan-83', 'Sandy Clemens')
* %(  Standardize "Author" entry in ICS Cobol programs.
*     FILES: C32T1.VAX-COB, C36T1.CBL  )%

INSTALLATION.

	DEC-MARLBOROUGH.

DATE-WRITTEN.

	NOVEMBER 1, 1982.


ENVIRONMENT DIVISION.

CONFIGURATION SECTION.

SOURCE-COMPUTER.

	DECSYSTEM-20.

OBJECT-COMPUTER.

	DECSYSTEM-20.

INPUT-OUTPUT SECTION.

DATA DIVISION.

WORKING-STORAGE SECTION.

* source data values

* Since VERY large numbers are going to be put into the source fields,
* and Cobol will not allow  for direct VALUE clause specifications  of
* such large numeric  values into  an S9(10) COMP  fields, the  values
* will be entered as sixbit values and then redefined as sbf36 values.

*	field	  numeric value	  sixbit
*	SRCDAT1   -33408571294    @XL:AB
*	SRCDAT2   27015512064     9*0   
*	SRCDAT3   2147483647      !_____
*	SRCDAT4   17553718994     062'[2

01 SRC-SIXBIT PIC X(24) USAGE DISPLAY-6
			VALUE "@XL:AB9*0   !_____062'[2".

01 SRCDAT REDEFINES SRC-SIXBIT.
    05  SRCDAT1 PIC S9(10) COMP.
    05  SRCDAT2 PIC S9(10) COMP.
    05  SRCDAT3 PIC S9(10) COMP.
    05  SRCDAT4 PIC S9(10) COMP.

* destination data fields
01  DSTDAT PIC S9(10) COMP OCCURS 5.

* foreign field descriptors
01  FFDS.
    05  STR20 PIC S9(10) COMP OCCURS 3.
    05  SBF20 PIC S9(10) COMP OCCURS 3.
    05  FLT20 PIC S9(10) COMP OCCURS 3.
    05  STRVAX PIC S9(10) COMP OCCURS 3.
    05  SBFVAX PIC S9(10) COMP OCCURS 3.
    05  FLTVAX PIC S9(10) COMP OCCURS 3.

01  INTERFACE-FILES.
    COPY DIL OF "SYS:DIL.LIB".
    COPY DIX OF "SYS:DIL.LIB".

01  DILINI-PARAMS.
    05  DIL-INIT-STATUS PIC S9(10) COMP.
    05  DIL-STATUS PIC S9(10) COMP.
    05  DIL-SEVERITY PIC S9(10) COMP.
    05  DIL-MESSAGE PIC S9(10) COMP.

* success flag
01  SUCCESS-FLAG PIC X(8).
    88  OK VALUE "SUCCESS".
    88  NOT-OK VALUE "FAILURE".

* keep track of which test is running
77  TEST PIC S9(10) COMP.

77  SUB PIC S9(5) COMP.

PROCEDURE DIVISION.

INITIALIZE-STUFF.

    MOVE "SUCCESS" TO SUCCESS-FLAG.

    ENTER MACRO DILINI USING DIL-INIT-STATUS, DIL-STATUS,
			     DIL-MESSAGE, DIL-SEVERITY.

    IF DIL-INIT-STATUS NOT = 1
	DISPLAY "? Failure in DILINI. Dil-status = " DIL-STATUS.

* initialize destination buffer to zeros
    PERFORM INITIALIZE-DSTDAT THRU INIT-EXIT
		VARYING SUB FROM 1 BY 1 UNTIL SUB > 5.

MAKE-FFDS.

    MOVE 1 TO TEST.
    ENTER MACRO XDESCR USING STR20(1), SRCDAT, DIX-SYS-10-20, 7, 0, 0,
			     DIX-DT-ASCII-7, 7, 0.

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 2 TO TEST.
    ENTER MACRO XDESCR USING SBF20(1), SRCDAT, DIX-SYS-10-20, 36, 2, 0,
			     DIX-DT-SBF36, 0, 2.

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 3 TO TEST.
    ENTER MACRO XDESCR USING FLT20(1), SRCDAT, DIX-SYS-10-20, 36, 3, 0,
			     DIX-DT-FLOAT-36, 0, 0.

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 4 TO TEST.
    ENTER MACRO XDESCR USING STRVAX(1), DSTDAT(1), DIX-SYS-VAX, 8, 0, 0,
			     DIX-DT-ASCII-8, 7, 0.

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 5 TO TEST.
    ENTER MACRO XDESCR USING SBFVAX(1), DSTDAT(1), DIX-SYS-VAX, 8, 8, 0,
			     DIX-DT-SBF32, 0, 2.

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 6 TO TEST.
    ENTER MACRO XDESCR USING FLTVAX(1), DSTDAT(1), DIX-SYS-VAX, 8, 12, 0,
			     DIX-DT-D-FLOAT, 0, 0.

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

DO-CONVERSIONS.
* (20 to vax)

    DISPLAY " Doing conversions... ".

    MOVE 7 TO TEST.
    ENTER MACRO XCVST USING STR20(1), STRVAX(1).

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.


    MOVE 8 TO TEST.
    ENTER MACRO XCVFB USING SBF20(1), SBFVAX(1).

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.


    MOVE 9 TO TEST.
    ENTER MACRO XCGEN USING FLT20(1), FLTVAX(1).

    IF DIL-SEVERITY NOT = STS-K-SUCCESS
       AND DIL-SEVERITY NOT = STS-K-INFO
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    IF OK DISPLAY " Tests through 9 completed successfully.".

CHECK-RESULTS.
* what we should have created is the VAX form of the record as
* described in the comments in F7T1.FOR.

    PERFORM SHOW-RESULTS THRU SHOW-EXIT VARYING SUB FROM 1 BY 1 UNTIL SUB > 5.

    MOVE 10 TO TEST.
    IF DSTDAT(1) NOT = 4972569153
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "  Test 10 is checking the conversions."
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 11 TO TEST.
    IF DSTDAT(2) NOT = -268266717
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "  Test 11 is checking the conversions."
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 12 TO TEST.
    IF DSTDAT(3) NOT = 5528092671
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "  Test 12 is checking the conversions."
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 13 TO TEST.
* Since the  initial  precision is  only  float-36, the  full  D_float
* precision will not be  produced in the  answer.  D_Float is  exactly
* like F_Float for the first word.  The second word consists  entirely
* of lower-order  mantissa bits.   In our  example, however,  mantissa
* bits cannot be manufactured from nowhere.  Float-36 has 26  mantissa
* bits.  F_Float has 24 (first one hidden).  Therefore, 2 bits,  which
* happen to be 10, will overflow into the second word of the  D_Float.
* The remainder of that word (vax word N+16) will be 0.  Lay this  out
* on the  chart, and  you  will see  that 20  word  n+3 will  thus  be
* 200000,,176644, or 17179934116.

    IF DSTDAT(4) NOT = 17179934116
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "  Test 13 is checking the conversions."
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    MOVE 14 TO TEST.
    IF DSTDAT(5) NOT = 0
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "  Test 14 is checking the conversions."
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

   IF OK DISPLAY " Tests through 14 completed successfully. ".

ERROR-CASES.
* try a couple of error cases.

ERROR-CASE-UNKSYS.
* get and unknown system of origin error and verify use of
* dix-c-unksys

    MOVE 15 TO TEST.
    ENTER MACRO XDESCR USING STR20(1), SRCDAT, 3, 7, 0, 0,
			     DIX-DT-ASCII-7, 7, 0.

    IF DIL-MESSAGE NOT = DIX-C-UNKSYS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.
 

ERROR-CASE-INVDATTYP.
* get and invalid data type error and verify use of dix-c-invdattyp

    MOVE 16 TO TEST.
    ENTER MACRO XDESCR USING STR20(1), SRCDAT, 
			     DIX-SYS-10-20, 7, 0, 0, -75, 7, 0.

    IF DIL-MESSAGE NOT = DIX-C-INVDATTYP
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TEST " Dil-status = " DIL-STATUS.

    IF OK DISPLAY " Tests through 16 completed successfully. "
	  DISPLAY " "
	  DISPLAY " C36T1 successfully completed.".

    STOP RUN.


INITIALIZE-DSTDAT.
    MOVE 0 TO DSTDAT(SUB).
INIT-EXIT.



SHOW-RESULTS.
    DISPLAY "DSTDAT(" SUB ") value is: " DSTDAT(SUB).
SHOW-EXIT.