PDP-10 Archive: source/c32t1.vax-cob from BB-R775B-BM

Trailing-Edge - PDP-10 Archives - BB-R775B-BM - source/c32t1.vax-cob

There are 2 other files named c32t1.vax-cob in the archive. Click here to see a list.

IDENTIFICATION DIVISION. 

PROGRAM-ID.

	C32T1.

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 VAX 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 3, 1982.


ENVIRONMENT DIVISION.

CONFIGURATION SECTION.

SOURCE-COMPUTER.

	VAX-11.

OBJECT-COMPUTER.

	VAX-11.

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  single precision fields, the  values
* will be put  into double precision  fields and then  moved into  the
* correct single precision fields.

01  HOLD-SRCDAT-DP.
    05  HOLD-SRCDAT-DP1 PIC S9(18) COMP VALUE 951167074.
    05  HOLD-SRCDAT-DP2 PIC S9(18) COMP VALUE -1543503864.
    05  HOLD-SRCDAT-DP3 PIC S9(18) COMP VALUE -156.
    05  HOLD-SRCDAT-DP4 PIC S9(18) COMP VALUE -2014502785.
    05  HOLD-SRCDAT-DP5 PIC S9(18) COMP VALUE 16740.

01  SRCDAT.
    05  SRCDAT1 PIC S9(9) COMP.
    05  SRCDAT2 PIC S9(9) COMP.
    05  SRCDAT3 PIC S9(9) COMP.
    05  SRCDAT4 PIC S9(9) COMP.
    05  SRCDAT5 PIC S9(9) COMP.
    05  SRCDAT6 PIC S9(9) COMP.

* destination data fields
01  DSTDAT-BUFFER.
    05  DSTDAT PIC S9(9) COMP OCCURS 5.

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

01  INTERFACE-FILES.
    COPY DIL$COBOL OF "SYS$LIBRARY:DIL.TLB".
    COPY DIX$COBOL OF "SYS$LIBRARY:DIL.TLB".

* Dil status return
01  DIL-STATUS PIC S9(9) COMP.

* Dix call parameters.

01  DIX-SYS PIC S9(9) COMP.
01  DIX-DT PIC S9(9) COMP.
01  DIX-BYSZ PIC S9(9) COMP.
01  DIX-BYO PIC S9(9) COMP.
01  DIX-BTO PIC S9(9) COMP VALUE 0.
01  DIX-LEN PIC S9(9) COMP.
01  DIX-SCAL PIC S9(9) COMP.

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

* fields for lib$match_cond call
01  DIL-MATCH PIC S9(9) COMP.
    88  NO-MATCH VALUE 0.
    88  FIRST-MATCH VALUE 1.

* keep track of which test is running
77  TESTNUM PIC S9(5) COMP.

77  SUB PIC S9(5) COMP.

PROCEDURE DIVISION.

INITIALIZE-STUFF.

    MOVE "SUCCESS" TO SUCCESS-FLAG.

* Initialize source  buffers:  20  data  in  vax  memory  Move  double
* precision "hold" areas into single precision words...

    MOVE HOLD-SRCDAT-DP1 TO SRCDAT1.
    MOVE HOLD-SRCDAT-DP2 TO SRCDAT2.
    MOVE HOLD-SRCDAT-DP3 TO SRCDAT3.
    MOVE HOLD-SRCDAT-DP4 TO SRCDAT4.
    MOVE HOLD-SRCDAT-DP5 TO SRCDAT5.
    MOVE 0 TO SRCDAT6.

* initialize destination buffer to zeros

    PERFORM INITIALIZE-DSTDAT THRU INIT-EXIT
		VARYING SUB FROM 1 BY 1 UNTIL SUB > 5.

MAKE-FFDS.

    MOVE 7 TO DIX-BYSZ.
    MOVE 0 TO DIX-BYO.
    MOVE 7 TO DIX-LEN.
    MOVE 0 TO DIX-SCAL.

    MOVE 1 TO TESTNUM.

    CALL "DIX$MAK_DES_DET" USING STR20(1), SRCDAT, DIX$K_SYS_10_20,
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX$K_DT_ASCII_7, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.


    MOVE 36 TO DIX-BYSZ.
    MOVE 2 TO DIX-BYO.
    MOVE 0 TO DIX-LEN.
    MOVE 2 TO DIX-SCAL.

    MOVE 2 TO TESTNUM.

    CALL "DIX$MAK_DES_DET" USING SBF20(1), SRCDAT, DIX$K_SYS_10_20,
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX$K_DT_SBF36, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.


    MOVE 36 TO DIX-BYSZ.
    MOVE 3 TO DIX-BYO.
    MOVE 0 TO DIX-LEN.
    MOVE 0 TO DIX-SCAL.

    MOVE 3 TO TESTNUM.

    CALL "DIX$MAK_DES_DET" USING FLT20(1), SRCDAT, DIX$K_SYS_10_20,
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX$K_DT_FLOAT_36, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.

    MOVE 8 TO DIX-BYSZ.
    MOVE 0 TO DIX-BYO.
    MOVE 7 TO DIX-LEN.
    MOVE 0 TO DIX-SCAL.

    MOVE 4 TO TESTNUM.

    CALL "DIX$MAK_DES_DET" USING STRVAX(1), DSTDAT(1), DIX$K_SYS_VAX,
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX$K_DT_ASCII_8, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.


    MOVE 8 TO DIX-BYSZ.
    MOVE 8 TO DIX-BYO.
    MOVE 0 TO DIX-LEN.
    MOVE 2 TO DIX-SCAL.

    MOVE 5 TO TESTNUM.

    CALL "DIX$MAK_DES_DET" USING SBFVAX(1), DSTDAT(1), DIX$K_SYS_VAX,
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX$K_DT_SBF32, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.


    MOVE 8 TO DIX-BYSZ.
    MOVE 12 TO DIX-BYO.
    MOVE 0 TO DIX-LEN.
    MOVE 0 TO DIX-SCAL.

    MOVE 6 TO TESTNUM.

    CALL "DIX$MAK_DES_DET" USING FLTVAX(1), DSTDAT(1), DIX$K_SYS_VAX, 
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX$K_DT_D_FLOAT, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.

DO-CONVERSIONS.
* (20 to vax)

    DISPLAY " Doing conversions... ".

    MOVE 7 TO TESTNUM.
    CALL "DIX$BY_DIX_DES" USING STR20(1), STRVAX(1)
			  GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.


    MOVE 8 TO TESTNUM.
    CALL "DIX$BY_DIX_DES" USING SBF20(1), SBFVAX(1)
			  GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.


    MOVE 9 TO TESTNUM.
    CALL "DIX$BY_DIX_DES" USING FLT20(1), FLTVAX(1)
			  GIVING DIL-STATUS.

    IF DIL-STATUS IS NOT SUCCESS
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " 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.

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

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

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

    MOVE 13 TO TESTNUM.
* Since our source data  has only 26 bits  of precision, we won't  get
* more than that as the result of our conversion.  In fact, the  first
* word will hold 24 bits of  mantissa (including the hidden bit),  and
* only two will  overflow into  the second  word.  Of  those two,  the
* second is 0.  Thus,  the second word of  the D_Float will only  have
* the one bit set.  See diagram of D_Float for why it's the bit it is,
* buried in the middle of the word.  Or take my word for it.
    IF DSTDAT(4) NOT = 265961801
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "  Test 13 is checking the conversions."
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.

    MOVE 14 TO TESTNUM.
    IF DSTDAT(5) NOT = 16384
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "  Test 14 is checking the conversions."
	DISPLAY "? Failure in test " TESTNUM " 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 3 TO DIX-SYS.
    MOVE 7 TO DIX-BYSZ.
    MOVE 0 TO DIX-BYO.
    MOVE 7 TO DIX-LEN.
    MOVE 0 TO DIX-SCAL.

    MOVE 15 TO TESTNUM.
    CALL "DIX$MAK_DES_DET" USING STR20(1), SRCDAT, DIX-SYS,
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX$K_DT_ASCII_7, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    CALL "LIB$MATCH_COND" USING DIL-STATUS,
				DIX$_UNKSYS
			  GIVING DIL-MATCH.
    IF NO-MATCH
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " Dil-status = " DIL-STATUS.

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

    MOVE -75 TO DIX-DT.
    MOVE 7 TO DIX-BYSZ.
    MOVE 0 TO DIX-BYO.
    MOVE 7 TO DIX-LEN.
    MOVE 0 TO DIX-SCAL.

    MOVE 16 TO TESTNUM.
    CALL "DIX$MAK_DES_DET" USING STR20(1), SRCDAT, DIX$K_SYS_10_20,
				 DIX-BYSZ, DIX-BYO, DIX-BTO,
				 DIX-DT, DIX-LEN, DIX-SCAL
			   GIVING DIL-STATUS.

    CALL "LIB$MATCH_COND" USING DIL-STATUS,
				DIX$_INVDATTYP
			  GIVING DIL-MATCH.
    IF NO-MATCH
	MOVE "FAILURE" TO SUCCESS-FLAG
	DISPLAY "? Failure in test " TESTNUM " 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.