Trailing-Edge
-
PDP-10 Archives
-
BB-AE97A-BM
-
sources/ft32t1.vax-for
There are 2 other files named ft32t1.vax-for in the archive. Click here to see a list.
C FT32T1
C Test program for the DIT. It opens a passive link and then
C connects to itself creating an active link. User specified
C messages are sent both directions across the link, and then
C the link is closed.
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
C Facility: DIT-TEST
C
C Edit History:
C
C new_version (1, 0)
C
C Edit (%O'1', '15-Dec-82', 'Sandy Clemens')
C %( Add the DIT (Dap and Task-to-task) Installation Verification tests
C for the VAX and DECSYSTEM-20 to the library.
C Files: DITTHST.TXT (NEW), CD32T1.VAX-COB (NEW),
C CT32T1.VAX-COB (NEW), FD32T1.VAX-FOR (NEW),
C FT32T1.VAX-FOR (NEW), CD36T1.CBL (NEW), CT36T1.CBL (NEW),
C FD6T1.FOR (NEW), FD7T1.FOR (NEW), FT6T1.FOR (NEW),
C FT7T1.FOR (NEW) )%
C
C Edit (%O'2', '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. Remove node names from all DIT programs so that local
C node is used. Change directory used by 20 DAP programs to be
C PS:<DIL-TEST> with password DIL-TEST. Remove all directory
C specifications from VMS programs so they use the default
C connected directory. Add Lib$Match_Cond to VMS programs for
C status 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
C Files: CD32T1.VAX-COB, CD36T1.CBL, CT32T1.VAX-COB, CT36T1.CBL,
C FD32T1.VAX-FOR, FD6T1.FOR, FD7T1.FOR, FT32T1.VAX-FOR, FT6T1.FOR,
C FT7T1.FOR, DITTHST.TXT )%
C
C Edit (%O'6', '25-Jan-83', 'Sandy Clemens')
C %( Add copyright and liability waiver to whatever needs it.
C FILES: CD32T1.VAX-COB, CD36T1.CBL, CT32T1.VAX-COB, CT36T1.CBL,
C FD32T1.VAX-FOR, FD6T1.FOR, FD7T1.FOR, FT32T1.VAX-FOR, FT6T1.FOR,
C FT7T1.FOR, SUB6D1.FOR, SUB6T1.FOR, SUB7D1.FOR, SUB7T1.FOR )%
C include DIL interface files
INCLUDE 'DIL (DIT$FORTRAN)'
INCLUDE 'DIL (DIL$FORTRAN)'
C data fields
DIMENSION SENDDP (20), RECDP (20), SENDDA (20), RECDA (20)
C dit parameters
DIMENSION HOSTN (4), OPTDAT (4), OBJIDP (4), OBJIDA (4)
DIMENSION DESCRP (4), DESCRA (4), TASKNP (4), TASKNA (4)
DIMENSION PASSWD (10), ACCT (10), USERID (10)
INTEGER STAT, MSGSIZ, MUNTSZ, CNTOPD, SYNCDS
C network logical names for each end of the link
INTEGER PNETLN
INTEGER ANETLN
DATA OPTDAT /' ', ' ', ' ', ' '/
DATA OBJIDP /' ', ' ', ' ', ' '/
DATA DESCRP /' ', ' ', ' ', ' '/
DATA TASKNP /'SERV', 'ER ', ' ', ' '/
DATA HOSTN /' ', ' ', ' ', ' '/
DATA OBJIDA /'TASK', ' ', ' ', ' '/
DATA DESCRA /'SERV', 'ER ', ' ', ' '/
DATA TASKNA /' ', ' ', ' ', ' '/
DATA PASSWD /0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
DATA USERID /0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
DATA ACCT /0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
C initialize sending and receiveing message data fields
DO 200 I = 1, 20
SENDDP (I) = 0
SENDDA (I) = 0
RECDP (I) = 0
200 RECDA (I) = 0
C Open a passive link
PNETLN = DIT$K_PAS_NFIREUP
STAT = DIT$NFOPP (PNETLN, OBJIDP, DESCRP, TASKNP, DIT$K_WAIT_NO)
150 FORMAT (' NFOPP Status return: ', I12)
WRITE (6,150) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 102
901 FORMAT ('? Error status returned from NFOPP: ', I12)
WRITE (6, 901) STAT
STOP
C Ask for a connection to the passive link
102 STAT = DIT$NFOPA (ANETLN, HOSTN, OBJIDA, DESCRA, TASKNA,
1 USERID, PASSWD, ACCT, OPTDAT, DIT$K_WAIT_NO)
103 FORMAT (' NFOPA Status return: ', I12)
WRITE (6,103) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 104
902 FORMAT ('? Error status returned from NFOPA: ', I12)
WRITE (6, 902) STAT
STOP
C Wait for confirmation of the link request
104 STAT = DIT$NFGND (PNETLN, DIT$K_WAIT_YES)
105 FORMAT (' NFGND Status return: ', I12)
WRITE (6,105) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 106
IF (STAT .EQ. DIT$_CONNECTEVENT) GO TO 106
903 FORMAT ('? Error status returned from NFGND: ', I12)
WRITE (6, 903) STAT
STOP
C Accept link from self
106 CNTOPD = 0
STAT = DIT$NFACC (PNETLN, DIT$K_LTYPE_ASCII, CNTOPD, OPTDAT)
107 FORMAT (' NFACC Status return: ', I12)
WRITE (6,107) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 109
904 FORMAT ('? Error status returned from NFACC: ', I12)
WRITE (6, 904) STAT
STOP
C Read and send some data over the link to self
108 FORMAT (' Enter some data to be sent over the link: ')
109 WRITE (6, 108)
110 FORMAT (20A4)
ACCEPT 110, SENDDP
C Initialize number of bytes
MSGSIZ = 80
MUNTSZ = 8
STAT = DIT$NFSND (ANETLN, MUNTSZ, MSGSIZ, SENDDP, DIT$K_MSG_MSG)
111 FORMAT (' NFSND Status return: ', I12)
WRITE (6,111) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 112
905 FORMAT ('? Error status returned from NFSND: ', I12)
WRITE (6, 905) STAT
STOP
C Read the data sent over the link
112 STAT = DIT$NFRCV (PNETLN, MUNTSZ, MSGSIZ, RECDA, DIT$K_MSG_MSG,
1 DIT$K_WAIT_YES)
113 FORMAT (' NFRCV Status return: ', I12)
WRITE (6,113) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 115
906 FORMAT ('? Error status returned from NFRCV: ', I12)
WRITE (6, 906) STAT
STOP
114 FORMAT (' Data received: ')
115 WRITE (6,114)
222 FORMAT (' ' 20A4)
WRITE (6,222) RECDA
C Send some data over the link in the opposite direction
116 FORMAT (' Enter some data to be sent over the link: ')
117 WRITE (6, 116)
118 FORMAT (20A4)
ACCEPT 118, SENDDA
C Reinitialize message size
MSGSIZ = 80
STAT = DIT$NFSND (PNETLN, MUNTSZ, MSGSIZ, SENDDA, DIT$K_MSG_MSG)
119 FORMAT (' NFSND Status return: ', I12)
WRITE (6,119) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 120
907 FORMAT ('? Error status returned from NFSND: ', I12)
WRITE (6, 907) STAT
STOP
C Read the data sent over the link the second time
120 STAT = DIT$NFRCV (ANETLN, MUNTSZ, MSGSIZ, RECDP, DIT$K_MSG_MSG,
1 DIT$K_WAIT_YES)
121 FORMAT (' NFRCV Status return: ', I12)
WRITE (6,121) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 123
908 FORMAT ('? Error status returned from NFRCV: ', I12)
WRITE (6, 908) STAT
STOP
122 FORMAT (' Data received: ')
123 WRITE (6,122)
223 FORMAT (' ' 20A4)
WRITE (6,223) RECDP
C Close the link to self
SYNCDS = 0
STAT = DIT$NFCLS (ANETLN, SYNCDS, CNTOPD, OPTDAT)
124 FORMAT (' NFCLS Status return: ', I12)
WRITE (6,124) STAT
IF (STAT .EQ. SS$_NORMAL) GO TO 125
909 FORMAT ('? Error status returned from NFCLS: ', I12)
WRITE (6, 909) STAT
STOP
125 STAT = DIT$NFGND (PNETLN, DIT$K_WAIT_YES)
IF (STAT .EQ. DIT$_ABREJEVENT) GO TO 126
IF (STAT .EQ. DIT$_DISCONNECTEVENT) GO TO 126
IF (STAT .EQ. SS$_NORMAL) GO TO 126
910 FORMAT ('? Error status returned from NFGND: ', I12)
WRITE (6, 910) STAT
STOP
127 FORMAT (' FT32T1 test successful. ')
126 WRITE (6,127)
STOP
END