Trailing-Edge
-
PDP-10 Archives
-
cuspmar86binsrc_2of2_bb-fp63a-sb
-
10,7/dil/dilics/f7t2.for
There are 17 other files named f7t2.for in the archive. Click here to see a list.
C F7T2
C Test program for DEC-10/20 Fortran Version 7
C This program performs minimal confidence test on DIX
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
C OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
C
C COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1983, 1985.
C ALL RIGHTS RESERVED.
C Facility: DIX-TEST
C
C Edit History:
C
C new_version (2, 0)
C
C Edit (%O'23', '13-Apr-84', 'Sandy Clemens')
C %( Add new DIX V2 tests to DXT2:. )%
C
C Edit (%O'26', '17-Jul-84', 'Sandy Clemens')
C %( Change the DIX ICS tests so that they do not print out the
C values of the destination buffers. Since what COBOL and what
C FORTRAN prints out is different, it causes confusion.
C FILES: C36T2.CBL, F7T2.FOR, F32T2.VAX-FOR
C )%
C
C Edit (%O'31', '8-Oct-84', 'Sandy Clemens')
C %( Put in new copyright notices. FILES: C36T2.CBL, C32T2.VAX-COB,
C F7T2.FOR, F32T2.VAX-FOR )%
C Here are a DEC-20 record, shown as seen in DEC-20 memory and as seen
C in VAX memory, in octal, decimal and binary, and a VAX record
C containing the proper converted equivalent values, represented in as
C many forms.
C
C DEC-20 FORM OF TEST RECORD:
C
C Descr
C Nam Fld Type Lng Scal Contents Comments
C ----- --- ---- --- ---- -------- --------
C STR20 1 ASCII-7 7 "Abc(12)"
C 2 ASCII-7 3 Nulls Filler
C SBF20 3 SBF36 2 21474836.47
C FLT20 4 FLOAT-36 3.1415925E+00
C DN20 5 DN6TS 5 3 "2479+" Interpret as
C numeric +2.479
C PD20 6 PD9 5 2 -134.79 Sign char = dec 13;
C COB36 PIC S999V99
C
C DEC: { 27015512064 }{ -33408571294 }
C OCT: {3 1 1 2 2 0 0 0 0 0 0 0}{4 0 7 0 5 4 3 2 4 1 4 2}
C 20: { 20 WORD N+1 }{ 20 WORD N }
C INT: { 2 }{ ) }{ FILL }X{ A }{ b }{ c }{ ( }{ 1 }X
C BIT: 011001001010010000000000000000000000100000111000101100011010100001100010
C VAX: <= N+8 }{ VAX WORD N+4 }{ VAX WORD N }
C OCT: 5 4 4}{2 4 4 0 0 0 0 0 0 1 0}{0 7 0 5 4 3 2 4 1 4 2}
C DEC: <= }{ -1543503864 }{ 951167074 }
C
C -----------------------------------------------------------------------------
C
C DEC: { 17553718994 }{ 2147483647 }
C OCT: {2 0 2 6 2 2 0 7 7 3 2 2}{0 1 7 7 7 7 7 7 7 7 7 7}
C 20: { 20 WORD N+3 }{ 20 WORD N+2 }
C INT: { FLOAT-36: 3.1415926E+00 }{ SBF36: 2147483647 }
C BIT: 010000010110010010000111111011010010000001111111111111111111111111111111
C VAX: <= N+16 }{ VAX WORD N+12 }{ VAX WORD N+8 =>
C OCT: <=4 0 5 4 4}{2 0 7 7 3 2 2 0 1 7 7}{3 7 7 7 7 7 7 7=>
C DEC: <= }{ -2014502785 }{ -156 =>
C
C -----------------------------------------------------------------------------
C
C DEC: { 2568829440 }{ 19669029568 }
C OCT: {0 2 3 1 0 7 2 3 5 0 0 0}{2 2 2 4 2 7 3 1 1 3 0 0}
C 20: { 20 WORD N+5 }{ 20 WORD N+4 }
C INT: { PD9 -134.79 }{ DN6TS: 2479+ }
C BIT: 000010011001000111010011101000000000010010010100010111011001001011000000
C VAX: <= WORD N+24 }{ VAX WORD N+20 }{ WORD N+16 =>
C OCT: 0 2 3 1 0 7 2 3}{2 4 0 0 1 1 1 2 1 3 5}{2 2 2 6 0 0
C DEC: <= 627155 }{ -1610312611 }{ -1832894108 =>
C
C -----------------------------------------------------------------------------
C
C BIT: 00000000
C VAX: { N+24=>
C OCT: {0 0 0
C DEC: { =>
C
C =============================================================================
C
C VAX FORM OF TEST RECORD:
C
C Descr
C Nam Fld Type Lng Scal Contents Comments
C ----- --- ---- --- ---- -------- --------
C STRVAX 1 ASCII-8 7 "Abc(12)"
C 2 ASCII-8 1 Nulls Filler
C SBFVAX 3 SBF32 2 21474836.47
C FLTVAX 4 D-FLOAT 3.141592562198639E0
C DNVAX 5 DN8LO 4 3 "2479" Interpret as
C numeric +2.479
C PDVAX 6 PD8 5 2 -134.79 Sign char = dec 13,
C COB32 PIC S999V99
C
C Note: The value given here for the D_Float field is the correct
C conversion from SBF36 3.1415926E0. Since D_Float is a form of greater
C precision, there is no difficulty in conversion: The same string of
C mantissa bits, properly represented for the other system, is used.
C
C DEC: { 2699825 }{ 677601857 }
C OCT: {0 0 0 1 2 2 3 1 0 6 1}{0 5 0 3 0 6 6 1 1 0 1}
C VAX: { VAX WORD N+4 }{ VAX WORD N }
C INT: { }{ ) }{ 2 }{ 1 }{ ( }{ c }{ b }{ A }
C BIT: 0000000000101001001100100011000100101000011000110110001001000001
C 20: <= 20 WORD N+1 }{ 20 WORD N }
C OCT: 0 0 0 5 1 1 4 4 3}{0 4 5 0 3 0 6 6 1 1 0 1}
C DEC: <= -268266717 }{ 4972569153 }
C
C DEC: { 2147483647 }
C OCT: {1 7 7 7 7 7 7 7 7 7 7}
C VAX: { VAX WORD N+8 }
C INT: { 21474836.47 }
C BIT: 01111111111111111111111111111111
C 20: <= 20 WORD N+2 }{ N+1 =>
C OCT: 3 7 7 7 7 7 7 7}{7 7 6
C DEC: <= 5528092671 }{ =>
C
C -----------------------------------------------------------------------------
C
C DEC: { 16384 }{ 265961801 }
C OCT: {0 0 0 0 0 0 4 0 0 0 0}{0 1 7 6 6 4 4 0 5 1 1}
C VAX: { VAX WORD N+16 }{ VAX WORD N+12 }
C INT: { 3.1415926E00 }
C BIT: 0000000000000000010000000000000000001111110110100100000101001001
C 20: <= 20 WORD N+4}{ 20 WORD N+3 }{ N+2 =>
C OCT: 0 0 0 0 0}{2 0 0 0 0 0 1 7 6 6 4 4}{0 5 1 1
C DEC: <= }{ 17179934116 }{ =>
C
C -----------------------------------------------------------------------------
C
C DEC: { 10307347 }{ 959919154 }
C OCT: {0 0 0 4 7 2 4 3 4 2 3}{0 7 1 1 5 6 3 2 0 6 2}
C VAX: { VAX WORD N+24 }{ VAX WORD N+20 }
C INT: { PD8 -134.79 }{ DN8LO "2479" }
C BIT: 0000000010011101010001110001001100111001001101110011010000110010
C 20: <= N+6 }{ 20 WORD N+5 }{ 20 WORD N+4 =>
C OCT: 0 0 0}{4 7 2 4 3 4 2 3 1 6 2 3}{3 4 6 4 1 4 4
C DEC: <= 0 }{ -26500582509 }{ 30940463104 =>
C
C -----------------------------------------------------------------------------
C
C BIT: {0000000000000000000000000000
C 20: { =>
C OCT: { 0 0 0 0 0 0 0 0 0=>
C DEC: { =>
C
C Include the DIL interface files
INCLUDE 'SYS:DILV7'
INCLUDE 'SYS:DIXV7'
C Foreign field descriptors
INTEGER STR20 (3), SBF20 (3), FLT20 (3), DN20 (3), PD20 (3)
INTEGER STRVAX (3), SBFVAX (3), FLTVAX (3), DNVAX (3), PDVAX (3)
C BUFFERS
INTEGER SRCDAT (6)
INTEGER DSTDAT (7)
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 (DN20, SRCDAT, SYS36, 6, 24, 0, DN6TS, 5, 3)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 5
STAT = XDESCR (PD20, SRCDAT, SYS36, 9, 20, 0, PD9, 5, 2)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 6
STAT = XDESCR (STRVAX, DSTDAT, SYSVAX, 8, 0, 0, ASCII8, 7, 0)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 7
STAT = XDESCR (SBFVAX, DSTDAT, SYSVAX, 8, 8, 0, SBF32, 0, 2)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 8
STAT = XDESCR (FLTVAX, DSTDAT, SYSVAX, 8, 12, 0, DFLOAT, 0, 0)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 9
STAT = XDESCR (DNVAX, DSTDAT, SYSVAX, 8, 20, 0, DN8LO, 4, 3)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 10
STAT = XDESCR (PDVAX, DSTDAT, SYSVAX, 8, 24, 0, PD8, 5, 2)
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
SRCDAT (5) = 19669029568
SRCDAT (6) = 2568829440
C INITIALIZE DESTINATION BUFFER TO ZEROS
DO 10 I = 1, 7
10 DSTDAT (I) = 0
C DO CONVERSIONS
WRITE (5, 1001)
1001 FORMAT (' Doing conversions')
C
TEST = 11
STAT = XCVST (STR20, STRVAX)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 12
STAT = XCVFB (SBF20, SBFVAX)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 13
STAT = XCGEN (FLT20, FLTVAX)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 14
STAT = XCVDN (DN20, DNVAX)
IF (STAT.NE.NORMAL) GOTO 777
TEST = 15
STAT = XCVPD (PD20, PDVAX)
IF (STAT.NE.NORMAL) GOTO 777
WRITE (5, 781)
781 FORMAT (' Tests through 15 completed successfully')
C GO TO 100 [%O'26']
GO TO 101
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.
C this is now debug only [%O'26']
C 100 DO 20 I = 1, 7 [%O'26']
C 20 WRITE (5, 779) I, DSTDAT (I) [%O'26']
C 779 FORMAT (' DSTDAT sub ', I3, ' = ', I12) [%O'26']
101 TEST = 16
IF (DSTDAT (1) .NEQ. 4972569153) GO TO 777
TEST = 17
IF (DSTDAT (2) .NEQ. -268266717) GO TO 777
TEST = 18
IF (DSTDAT (3) .NEQ. 5528092671) GO TO 777
TEST = 19
C Since the initial precision is only float-36, the full D_float
C precision will not be produced in the answer.
C D_Float is exactly like F_Float for the first word. The second
C word consists entirely of lower-order mantissa bits. In our
C example, however, mantissa bits cannot be manufactured from nowhere.
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 = 20
IF (DSTDAT (5) .NEQ. 30940463104) GO TO 777
TEST = 21
IF (DSTDAT (6) .NEQ. -26500582509) GO TO 777
TEST = 22
IF (DSTDAT (7) .NEQ. 0) GO TO 777
WRITE (5, 780)
780 FORMAT (' Tests through 22 successfully completed')
C TRY A COUPLE OF ERROR CASES
C GET AN UNKNOWN SYSTEM OF ORIGIN ERROR AND VERIFY USE OF UNKSYS
TEST = 23
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 = 24
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 24 successfully completed')
WRITE (5, 783)
783 FORMAT (' F7T2 successfully completed')
END