Google
 

Trailing-Edge - PDP-10 Archives - BB-AE97A-BM - sources/f32t1.vax-for
There are 2 other files named f32t1.vax-for in the archive. Click here to see a list.
C F32T1
C	Test program for VMS Fortran version 3
C	This program performs minimal confidence test on DIX
C
C	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1983
C
C This software  is furnished  under a  license and  may be  used  and
C copied only in accordance  with the terms of  such license and  with
C the inclusion of the above  copyright notice.  This software or  any
C other copies thereof may not be provided or otherwise made available
C to any other person.  No title  to and ownership of the software  is
C hereby transferred.
C
C The information in this software is subject to change without notice
C and should not  be construed  as a commitment  by Digital  Equipment
C Corporation.
C
C Digital assumes no responsibility for the use or reliability of  its
C software on equipment which is not supplied by Digital.
C

C See F7T1.FOR a bit-by-bit justification of the initial and
C expected final values used here.

C Facility: DIX-TEST
C
C Edit History:
C
C Edit (%O'3', '16-Oct-82', 'David Dyer-Bennet')
C %(  Add fortran interface tests: FOR36 V6 (F6T1.FOR), FOR36 V7 (F7T1.FOR),
C     FOR32 V3 (F32T1.VAX-FOR).  F7T1 has the detailed justification
C     of the source and expected destination values used. )%
C
C Edit (%O'12', '07-Dec-82', 'Sandy Clemens')
C %(  Change VAX fortran interface test to use "6" for output device
C     rather than "5", in order to make VAX batch stream work.
C     File: FT32T1.VAX-FOR )%
C
C Edit (%O'14', '14-Jan-83', 'Sandy Clemens')
C %(  Many edits to the Installation Verification system (ICS)  files.
C     Add SYS:  to all  the  10/20 programs  in  the COPY  or  INCLUDE
C     statement for the interface files.   Add SYS$LIBRARY to the  VAX
C     programs in  the COPY  or INCLUDE  statement for  the  interface
C     files.  Add check for INFO or  SUCCESS status return in all  ICS
C     programs.   Add  Lib$Match_Cond  to  VMS  programs  for   status
C     checking.  Change  some  of  the  symbolic  variable  names  for
C     clarification.   Change  use  of  numeric  parameter  values  to
C     symbolic variable names.  Get rid  of use of "IMPLICIT  INTEGER"
C     in FORTRAN test programs.   Add copyright notice to  everything.
C     Make the TOPS-10 test programs  EXACTLY the same as the  TOPS-20
C     programs, in order to use the same ones on both systems.  Files:
C     F6T1.10-FOR  (DELETED),  F7T1.10-FOR  (DELETED),  C32T1.VAX-COB,
C     C36T1.CBL, F32T1.VAX-FOR, F6T1.FOR, F7T1.FOR, DIXTHST.TXT )%
C
C Edit (%O'20', '24-Jan-83', 'Sandy Clemens')
C %(  Add copyright and liability waiver to whatever needs it.
C     FILE: C32T1.VAX-COB, C36T1.CBL, CREDIX.CTL, CREDIX.VAX-COM,
C     DIXDMP.CBL, DIXDMP.VAX-COB, DIXMNT.CBL, DIXTST.CBL,
C     DIXTST.VAX-COB, F32T1.VAX-FOR, F6T1.FOR, F7T1.FOR, PART1.CBL,
C     PART3.VAX-COB, RUNDIX.CTL, RUNDIX.VAX-COM, SUB6X1.FOR,
C     SUB7X1.FOR  )%

C	Include the DIL interfaces files for Tops-10/Tops-20
C	compatible (Ansi Standard) Fortran
	INCLUDE 'SYS$LIBRARY:DIL.TLB (DIL$ANSI_FORTRAN)'
	INCLUDE 'SYS$LIBRARY:DIL.TLB (DIX$ANSI_FORTRAN)'

C	Foreign field descriptors
	INTEGER STR20 (3), SBF20 (3), FLT20 (3)
	INTEGER STRVAX (3), SBFVAX (3), FLTVAX (3)

C	BUFFERS
	INTEGER SRCDAT (6)
	INTEGER DSTDAT (5)

C	VARIABLES
	INTEGER TEST, STAT

C	Initialize foreign field descriptors
	TEST = 1
	STAT = DIX$MAK_DES_DET (STR20, SRCDAT, SYS36, 7, 0, 0, ASCII7, 7, 0)
	IF (STAT.NE.NORMAL) GOTO 777
	TEST = 2
	STAT = DIX$MAK_DES_DET (SBF20, SRCDAT, SYS36, 36, 2, 0, SBF36, 0, 2)
	IF (STAT.NE.NORMAL) GOTO 777
	TEST = 3
	STAT = DIX$MAK_DES_DET (FLT20, SRCDAT, SYS36, 36, 3, 0, FLOT36, 0, 0)
	IF (STAT.NE.NORMAL) GOTO 777
	TEST = 4
	STAT = DIX$MAK_DES_DET (STRVAX, DSTDAT, SYSVAX, 8, 0, 0, ASCII8, 7, 0)
	IF (STAT.NE.NORMAL) GOTO 777
	TEST = 5
	STAT = DIX$MAK_DES_DET (SBFVAX, DSTDAT, SYSVAX, 8, 8, 0, SBF32, 0, 2)
	IF (STAT.NE.NORMAL) GOTO 777
	TEST = 6
	STAT = DIX$MAK_DES_DET (FLTVAX, DSTDAT, SYSVAX, 8, 12, 0, DFLOAT, 0, 0)
	IF (STAT.NE.NORMAL) GOTO 777

C	INITIALIZE SRC BUFFER (20 data in vax memory)
	SRCDAT (1) = 951167074
	SRCDAT (2) = -1543503864
	SRCDAT (3) = -156
	SRCDAT (4) = -2014502785
	SRCDAT (5) = 16740

C	INITIALIZE DESTINATION BUFFER TO ZEROS
	DO 10 I = 1, 5
10	DSTDAT (I) = 0

C	DO CONVERSIONS (20 to vax)
	WRITE (6, 1001)
1001	FORMAT (' Doing conversions')
C
	TEST = 7
	STAT = DIX$BY_DIX_DES (STR20, STRVAX)
	IF (STAT.NE.NORMAL) GOTO 777
	TEST = 8
	STAT = DIX$BY_DIX_DES (SBF20, SBFVAX)
	IF (STAT.NE.NORMAL) GOTO 777
	TEST = 9
	STAT = DIX$BY_DIX_DES (FLT20, FLTVAX)
	IF (STAT.NE.NORMAL) GOTO 777

	WRITE (6, 781)
781	FORMAT (' Tests through 10 completed successfully')

	GO TO 100

C	PRINT ERROR INFORMATION
777	WRITE (6, 778) TEST, STAT
778	FORMAT (' ? Failure in test ', I4, ' Status = ', I10)
	STOP

C	CHECK RESULTS
100	DO 20 I = 1, 5
20	WRITE (6, 779) I, DSTDAT (I)
779	FORMAT (' DSTDAT sub ', I3, ' = ', I10)

	TEST = 10
	IF (DSTDAT (1) .ne. 677601857) GO TO 777
	TEST = 11
	IF (DSTDAT (2) .ne. 2699825) GO TO 777
	TEST = 12
	IF (DSTDAT (3) .ne. 2147483647) GO TO 777
	TEST = 13
C	Since our source data has only 26 bits of precision, we won't get
C	more than that as the result of our conversion.  In fact, the first
C	word will hold 24 bits of mantissa (including the hidden bit),
C	and only two will overflow into the second word.  Of those two,
C	the second is 0.  Thus, the second word of the D_Float will only
C	have the one bit set.  See diagram of D_Float for why it's the
C	bit it is, buried in the middle of the word.  Or take my word for it.
	IF (DSTDAT (4) .ne. 265961801) GO TO 777
	TEST = 14
	IF (DSTDAT (5) .ne. 16384) GO TO 777

	WRITE (6, 780)
780	FORMAT (' Tests through 14 successfully completed')

C	TRY A COUPLE OF ERROR CASES

C	GET AN UNKNOWN SYSTEM OF ORIGIN ERROR AND VERIFY USE OF UNKSYS
	TEST = 15
	STAT = DIX$MAK_DES_DET (STR20, SRCDAT, 3, 7, 0, 0, ASCII7, 7, 0)
	IF (STAT .ne. UNKSYS) GO TO 777

C	GET AN INVALID DATA TYPE ERROR AND VERIFY USE OF DATTYP
	TEST = 16
	STAT = DIX$MAK_DES_DET (STR20, SRCDAT, SYS36, 7, 0, 0, -75, 7, 0)
	IF (STAT .ne. DATTYP) GO TO 777
	
	WRITE (6, 782)
782	FORMAT (' Tests through 16 successfully completed')

	WRITE (6, 783)
783	FORMAT (' F32T1 successfully completed')

	END