Trailing-Edge
-
PDP-10 Archives
-
BB-R775A-BM
-
uetp/f6t1.for
There are 4 other files named f6t1.for in the archive. Click here to see a list.
C F6T1
C Test program for DEC-10/20 Fortran Version 6
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 for a detailed bit-by-bit justification of the initial
C and final values used in this test. The data is too extensive to
C attempt to maintain in multiple places.
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'7', '1-Nov-82', 'David Dyer-Bennet')
C %( Change fortran DEC-20 test programs to look for interface files
C in SYS:.
C Files: F6T1.FOR, F7T1.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'15', '19-Jan-83', 'Sandy Clemens')
C %( Change erroneous program message "Tests through 10 completed
C successfully" to correct message "Tests though 9 completed
C successfully." Files: F6T1.FOR, F7T1.FOR )%
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 [%O'7'] Add SYS: to file specs.
C Include the DIL interface files
INCLUDE 'SYS:DIXV6'
INCLUDE 'SYS:DILV6'
C Foreign field descriptors
INTEGER STR20 (3), SBF20 (3), FLT20 (3)
INTEGER STRVAX (3), SBFVAX (3), FLTVAX (3)
C BUFFERS
INTEGER SRCDAT (4)
INTEGER DSTDAT (5)
C VARIABLES
INTEGER TEST, STAT
C Initialize foreign field descriptors
TEST = 1
STAT = XDESCR (STR20, SRCDAT, SYS36, 7, 0, 0, ASCII7, 7, 0)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 2
STAT = XDESCR (SBF20, SRCDAT, SYS36, 36, 2, 0, SBF36, 0, 2)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 3
STAT = XDESCR (FLT20, SRCDAT, SYS36, 36, 3, 0, FLOT36, 0, 0)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 4
STAT = XDESCR (STRVAX, DSTDAT, SYSVAX, 8, 0, 0, ASCII8, 7, 0)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 5
STAT = XDESCR (SBFVAX, DSTDAT, SYSVAX, 8, 8, 0, SBF32, 0, 2)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 6
STAT = XDESCR (FLTVAX, DSTDAT, SYSVAX, 8, 12, 0, DFLOAT, 0, 0)
IF (STAT.NE.NORMAL) GOTO 777
C INITIALIZE SRC BUFFER
C Data is as described at top.
SRCDAT (1) = -33408571294
SRCDAT (2) = 27015512064
SRCDAT (3) = 2147483647
SRCDAT (4) = 17553718994
C INITIALIZE DESTINATION BUFFER TO ZEROS
DO 10 I = 1, 5
10 DSTDAT (I) = 0
C DO CONVERSIONS
WRITE (5, 1001)
1001 FORMAT (' Doing conversions')
C
TEST = 7
STAT = XCVST (STR20, STRVAX)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 8
STAT = XCVFB (SBF20, SBFVAX)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 9
STAT = XCGEN (FLT20, FLTVAX)
IF (STAT.NE.NORMAL) GOTO 777
WRITE (5, 781)
781 FORMAT (' Tests through 9 completed successfully')
GO TO 100
C PRINT ERROR INFORMATION
777 WRITE (5, 778) TEST, STAT
778 FORMAT (' ? Failure in test ', I4, ' Status = ', I10)
STOP
C CHECK RESULTS
C What we should have created is the VAX form of the record as
C described in the comments at the head of this program.
100 DO 20 I = 1, 5
20 WRITE (5, 779) I, DSTDAT (I)
779 FORMAT (' DSTDAT sub ', I3, ' = ', I12)
TEST = 10
IF (DSTDAT (1) .NEQ. 4972569153) GO TO 777
TEST = 11
IF (DSTDAT (2) .NEQ. -268266717) GO TO 777
TEST = 12
IF (DSTDAT (3) .NEQ. 5528092671) GO TO 777
TEST = 13
C Since the initial precision is only float-36, the full D_float
C precision will not be produced in the answer.
C Float-36 has 26 mantissa bits. F_Float has 24 (first one hidden).
C Therefore, 2 bits, which happen to be 10, will overflow into the
C second word of the D_Float. The remainder of that word
C (vax word N+16) will be 0. Lay this out on the chart, and you will
C see that 20 word n+3 will thus be 200000,,176644, or 17179934116.
IF (DSTDAT (4) .NEQ. 17179934116) GO TO 777
TEST = 14
IF (DSTDAT (5) .NEQ. 0) GO TO 777
WRITE (5, 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 = XDESCR (STR20, SRCDAT, 3, 7, 0, 0, ASCII7, 7, 0)
IF (STAT .NEQ. UNKSYS) GO TO 777
C GET AN INVALID DATA TYPE ERROR AND VERIFY USE OF DATTYP
TEST = 16
STAT = XDESCR (STR20, SRCDAT, SYS36, 7, 0, 0, -75, 7, 0)
IF (STAT .NEQ. DATTYP) GO TO 777
WRITE (5, 782)
782 FORMAT (' Tests through 16 successfully completed')
WRITE (5, 783)
783 FORMAT (' F6T1 successfully completed')
END