home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
gould3.zip
/
kermit2
< prev
next >
Wrap
Text File
|
2011-08-09
|
70KB
|
858 lines
* BASE -ULTLY-KERM -SFM-A2703 - 08/01/90 WJH HEADER SFMKERM 0001.000
INTEGER FUNCTION RECEIVE(ISTATE) 0001.100
IMPLICIT NONE 0002.000
INTEGER ISTATE !state to start at 0003.000
C 0004.000
C= Receive a file state switching routine. 0005.000
C 0006.000
INCLUDE K.KERMD 0007.000
INCLUDE K.DBUGC 0008.000
INCLUDE K.PROTC 0009.000
INCLUDE K.PACKC 0010.000
INCLUDE K.MSGCOM 0011.000
C 0012.000
INTEGER MM,DD,YY, HR, MIN, SEC 0013.000
INTEGER MSG(MAXPACK) 0014.000
INTEGER I 0015.000
C 0016.000
INTEGER RINIT 0017.000
INTEGER RDATA 0018.000
INTEGER RFILE 0019.000
INTEGER SLEN !length of string 0020.000
INTRINSIC ICHAR 0021.100
C INTEGER ICHAR !character to integer 0021.200
C 0022.000
CHARACTER*72 RCVMES (4 ) 0023.000
$ /'[Kermit RECEIVE running on Gould host. Please type your', 0024.000
$ 'escape sequence ( altK ) to return to your local machine', 0025.000
$ 'Use SEND to send a file to the GOULD host. ', 0026.000
$ 'NOTE: The file must already exist on the GOULD host.'/ 0027.000
C 0028.000
C initialize statistics variables 0029.000
C 0030.000
CALL GETNOW(MM, DD, YY, HR, MIN, SEC) 0031.000
STARTIM = HR*3600 + MIN*60 + SEC 0032.000
SCHCNT = 0 0033.000
RCHCNT = 0 0034.000
SCHOVRH = 0 0035.000
RCHOVRH = 0 0036.000
TOTSDRC = 0 0037.000
TOTRTRY = 0 0038.000
CLT 2.3 ZERO ALL PREVIOUS ABORTS 0039.000
ABORTYP = .FALSE. 0040.000
CALL OUTTBL(RCVMES, 1, 4) 0041.000
IF (IFD .NE. STDIN) CALL PUTC(STDOUT, NEL) 0042.000
C 0043.000
C set packet retry count ácurrent state 0044.000
C 0045.000
NUMTRY = 0 0046.000
STATE = ISTATE 0047.000
C 0048.000
C take appropriate action for the current state 0049.000
C 0050.000
CALL MONSDRC(STATE) 0051.000
10 CONTINUE 0052.000
IF (STATE .EQ. D) THEN 0053.000
STATE = RDATA() 0054.000
ELSE IF (STATE .EQ. F) THEN 0055.000
STATE = RFILE() 0056.000
ELSE IF (STATE .EQ. R) THEN 0057.000
STATE = RINIT() 0058.000
ELSE IF (STATE .EQ. C) THEN 0059.000
CALL GETNOW(MM, DD, YY, HR, MIN, SEC) 0060.000
ENDTIM = HR * 3600 + MIN * 60 + SEC 0061.000
RECEIVE = OK 0062.000
GOTO 90 0063.000
ELSE IF (STATE .EQ. A) THEN 0064.000
CALL GETNOW(MM, DD, YY, HR, MIN, SEC) 0065.000
ENDTIM = HR * 3600 + MIN * 60 + SEC 0066.000
RECEIVE = ERROR 0067.000
IF (FFD .NE. 0) CALL CLOSE(FFD) 0068.000
CLT 2.3 SHORTEN MESSAGE 0069.000
CALL GETEMSG(MSG) 0070.000
CALL SNDPACK(E, PACKNUM, SLEN(MSG), MSG) 0071.000
GOTO 90 0072.000
ELSE 0073.000
CALL PRTMSG(' Receive - state error = ',STATE) 0074.000
IF (FFD .NE. 0) CALL CLOSE(FFD) 0075.000
RECEIVE = ERROR 0076.000
GOTO 90 0077.000
ENDIF 0078.000
IF (DEBUG(DBGSTAT)) THEN 0079.000
CALL PUTC(DBGFD, STATE) 0080.000
CALL PUTINT(DBGFD, PACKNUM, 1) 0081.000
CALL PUTC(DBGFD, BLANK) 0082.000
IF (MOD(PACKNUM+1, 16) .EQ. 0) CALL PUTC(DBGFD, NEL) 0083.000
ENDIF 0084.000
GOTO 10 0085.000
90 CONTINUE !return 0086.000
CALL MONSDRC(STATE) 0087.000
RETURN 0088.000
END 0089.000
INTEGER FUNCTION RINIT() 0090.000
IMPLICIT NONE 0091.000
C 0092.000
C= Receive a send-init packet 0093.000
C 0094.000
INCLUDE K.KERMD 0095.000
INCLUDE K.DBUGC 0096.000
INCLUDE K.PROTC 0097.000
C 0098.000
INTEGER PTYP 0099.000
INTEGER NUM 0100.000
C 0101.000
INTEGER RDPACK 0102.000
INTEGER SNDPAR 0103.000
C 0104.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0105.000
NUMTRY = NUMTRY + 1 0106.000
IF (NUMTRY .GT. MAXRINI) THEN 0107.000
RINIT = A 0108.000
ABORTYP(TOOMANY) = .TRUE. 0109.000
ABORTYP(READING) = .TRUE. 0110.000
ABORTYP(INITERR) = .TRUE. 0111.000
RETURN 0112.000
ENDIF 0113.000
C 0114.000
C read a packet and hope for best 0115.000
C 0116.000
PTYP = RDPACK(LEN, NUM, PACKET) 0117.000
C 0118.000
C is it a valid packet type 0119.000
C 0120.000
IF (PTYP .EQ. S) THEN 0121.000
TOTSDRC = TOTSDRC + 1 0122.000
NUMTRY = 0 0123.000
CALL MONSDRC(F) 0124.000
PACKNUM = NUM 0125.000
CALL RDPARAM(PACKET) 0126.000
LEN = SNDPAR(PACKET) 0127.000
CALL SNDPACK(Y, NUM, LEN, PACKET) 0128.000
PACKNUM = MOD(PACKNUM+1, 64) 0129.000
RINIT = F 0130.000
C 0131.000
C did we get a checksum error 0132.000
C 0133.000
ELSE IF (PTYP .EQ. ERROR) THEN 0134.000
RINIT = STATE 0135.000
CALL MONSDRC(STATE) 0136.000
CALL SNDPACK(N, NUM, 0, 0) 0137.000
ELSE 0138.000
RINIT = A 0139.000
ABORTYP(INVALID) = .TRUE. 0140.000
ABORTYP(READING) = .TRUE. 0141.000
ABORTYP(INITERR) = .TRUE. 0142.000
ENDIF 0143.000
RETURN 0144.000
END 0145.000
INTEGER FUNCTION RFILE() 0146.000
IMPLICIT NONE 0147.000
C 0148.000
C= Read a filename packet 0149.000
C 0150.000
C Rfile expects to see a filename (type f) packet. However it may 0151.000
C find a send-init retry, end-of-file retry or break packet. 0152.000
C 0153.000
INCLUDE K.KERMD 0154.000
INCLUDE K.DBUGC 0155.000
INCLUDE K.PROTC 0156.000
C 0157.000
INTEGER PTYP 0158.000
INTEGER NUM 0159.000
C 0160.000
INTEGER RDPACK 0161.000
INTEGER SNDPAR 0162.000
INTEGER GETFILE 0163.000
C 0164.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0165.000
NUMTRY = NUMTRY + 1 0166.000
IF (NUMTRY .GT. MAXRTRY) THEN 0167.000
RFILE = A 0168.000
ABORTYP(TOOMANY) = .TRUE. 0169.000
ABORTYP(READING) = .TRUE. 0170.000
ABORTYP(FILERR) = .TRUE. 0171.000
RETURN 0172.000
ENDIF 0173.000
C 0174.000
C read a packet 0175.000
C 0176.000
PTYP = RDPACK(LEN, NUM, PACKET) 0177.000
X WRITE(19,1000)LEN,NUM,PACKNUM 0177.100
X1000 FORMAT(1X,'1772 ** ',7(1X,1Z8)) 0177.200
C 0178.000
C is it a filename packet? 0179.000
C 0180.000
IF (PTYP .EQ. F) THEN 0181.000
IF (NUM .NE. PACKNUM) THEN 0182.000
RFILE = A 0183.000
ABORTYP(SEQERR) = .TRUE. 0184.000
ABORTYP(READING) = .TRUE. 0185.000
ABORTYP(FILERR) = .TRUE. 0186.000
RETURN 0187.000
ENDIF 0188.000
IF (DEBUG(DBGON)) THEN 0189.000
CALL PRINTL(DBGFD, 'Receiving file ') 0190.000
CALL PUTSTR(DBGFD, PACKET) 0191.000
CALL FLUSH(DBGFD) 0192.000
ENDIF 0193.000
FFD = GETFILE(PACKET) 0194.000
X WRITE(19,1001)FFD,NUM,LEN 0194.100
X1001 FORMAT(' 194.2** ',3(1X,1Z8)) 0194.200
IF (FFD .LE. 0) THEN 0195.000
FFD = 0 0196.000
RFILE = A 0197.000
ABORTYP(LCLFILE) = .TRUE. 0198.000
ABORTYP(READING) = .TRUE. 0199.000
ABORTYP(FILERR) = .TRUE. 0200.000
ELSE 0201.000
NUMTRY = 0 0202.000
TOTSDRC = TOTSDRC + 1 0203.000
CALL MONSDRC(D) 0204.000
CALL STRCPY(PACKET, FILESTR) 0205.000
CALL SNDPACK(Y, NUM, 0, 0) 0206.000
PACKNUM = MOD(PACKNUM+1, 64) 0207.000
RFILE = D 0208.000
ENDIF 0209.000
C 0210.000
C is it an old send-init packet? 0211.000
C 0212.000
ELSE IF (PTYP .EQ. S) THEN 0213.000
X WRITE(19,1002)PTYP,NUM,PACKNUM,LEN 0213.100
X1002 FORMAT(1X,' 2132 **',4(1X,1Z8)) 0213.200
IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN 0214.000
NUMTRY = 0 0215.000
TOTSDRC = TOTSDRC + 1 0216.000
CALL MONSDRC(STATE) 0217.000
LEN = SNDPAR(PACKET) 0218.000
CALL SNDPACK(Y, NUM, LEN, PACKET) 0219.000
RFILE = STATE 0220.000
ELSE 0221.000
RFILE = A 0222.000
ABORTYP(SEQERR) = .TRUE. 0223.000
ABORTYP(READING) = .TRUE. 0224.000
ABORTYP(INITERR) = .TRUE. 0225.000
ENDIF 0226.000
C 0227.000
C is it an old eof packet 0228.000
C 0229.000
ELSE IF (PTYP .EQ. Z) THEN 0230.000
IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN 0231.000
NUMTRY = 0 0232.000
TOTSDRC = TOTSDRC + 1 0233.000
CALL MONSDRC(STATE) 0234.000
CALL SNDPACK(Y, NUM, 0, 0) 0235.000
RFILE = STATE 0236.000
ELSE 0237.000
RFILE = A 0238.000
ABORTYP(SEQERR) = .TRUE. 0239.000
ABORTYP(READING) = .TRUE. 0240.000
ABORTYP(INITERR) = .TRUE. 0241.000
ENDIF 0242.000
C 0243.000
C is it a break packet? 0244.000
C 0245.000
ELSE IF (PTYP .EQ. B) THEN 0246.000
IF (NUM .NE. PACKNUM) THEN 0247.000
RFILE = A 0248.000
ABORTYP(SEQERR) = .TRUE. 0249.000
ABORTYP(READING) = .TRUE. 0250.000
ABORTYP(BRKERR) = .TRUE. 0251.000
ELSE 0252.000
NUMTRY = 0 0253.000
TOTSDRC = TOTSDRC + 1 0254.000
CALL MONSDRC(C) 0255.000
CALL SNDPACK(Y, PACKNUM, 0, 0) 0256.000
RFILE = C 0257.000
ENDIF 0258.000
C 0259.000
C did we get a checksum error 0260.000
C 0261.000
ELSE IF (PTYP .EQ. ERROR) THEN 0262.000
RFILE = STATE 0263.000
CALL MONSDRC(STATE) 0264.000
CALL SNDPACK(N, NUM, 0, 0) 0265.000
C 0266.000
C invalid packet type 0267.000
C 0268.000
ELSE 0269.000
RFILE = A 0270.000
ABORTYP(INVALID) = .TRUE. 0271.000
ABORTYP(READING) = .TRUE. 0272.000
ABORTYP(FILERR) = .TRUE. 0273.000
ENDIF 0274.000
RETURN 0275.000
END 0276.000
INTEGER FUNCTION RDATA() 0277.000
IMPLICIT NONE 0278.000
C 0279.000
C= Read a data packet 0280.000
C 0281.000
INCLUDE K.KERMD 0282.000
INCLUDE K.DBUGC 0283.000
INCLUDE K.PROTC 0284.000
C 0285.000
C 0286.000
C check retry count 0287.000
C 0288.000
INTEGER PTYP 0289.000
INTEGER NUM 0290.000
C 0291.000
INTEGER RDPACK 0292.000
C 0293.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0294.000
NUMTRY = NUMTRY + 1 0295.000
IF (NUMTRY .GT. MAXRTRY) THEN 0296.000
RDATA = A 0297.000
ABORTYP(TOOMANY) = .TRUE. 0298.000
ABORTYP(READING) = .TRUE. 0299.000
ABORTYP(DATAERR) = .TRUE. 0300.000
RETURN 0301.000
ENDIF 0302.000
C 0303.000
C read a packet 0304.000
C 0305.000
10 PTYP = RDPACK(LEN, NUM, PACKET) 0306.000
X WRITE(19,1000)LEN,NUM,PACKNUM ,PTYP 0306.100
X1000 FORMAT(1X,'3062 ** ',7(1X,1Z8)) 0306.200
C 0307.000
C did we get a data packet 0308.000
C 0309.000
IF (PTYP .EQ. D) THEN 0310.000
IF (NUM .NE. PACKNUM) THEN 0311.000
IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN 0312.000
CALL MONSDRC(STATE) 0313.000
CALL SNDPACK(Y, NUM, 0, 0) 0314.000
RDATA = STATE 0315.000
ELSE 0316.000
RDATA = A 0317.000
ABORTYP(SEQERR) = .TRUE. 0318.000
ABORTYP(READING) = .TRUE. 0319.000
ABORTYP(DATAERR) = .TRUE. 0320.000
ENDIF 0321.000
ELSE 0322.000
TOTSDRC = TOTSDRC + 1 0323.000
CALL MONSDRC(STATE) 0324.000
CALL BUFEMP(PACKET, FFD, LEN) 0325.000
CALL SNDPACK(Y, PACKNUM, 0, 0) 0326.000
NUMTRY = 0 0327.000
PACKNUM = MOD(PACKNUM+1, 64) 0328.000
RDATA = STATE 0329.000
GO TO 10 0329.100
ENDIF 0330.000
C 0331.000
C is it an old filename packet 0332.000
C 0333.000
ELSE IF (PTYP .EQ. F) THEN 0334.000
IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN 0335.000
TOTSDRC = TOTSDRC + 1 0336.000
CALL MONSDRC(STATE) 0337.000
CALL SNDPACK(Y, NUM, 0, 0) 0338.000
NUMTRY = 0 0339.000
RDATA = STATE 0340.000
ELSE 0341.000
RDATA = A 0342.000
ABORTYP(SEQERR) = .TRUE. 0343.000
ABORTYP(READING) = .TRUE. 0344.000
ABORTYP(FILERR ) = .TRUE. 0345.000
ENDIF 0346.000
C 0347.000
C is it an eof packet 0348.000
C 0349.000
ELSE IF (PTYP .EQ. Z) THEN 0350.000
IF (NUM .NE. PACKNUM) THEN 0351.000
RDATA = A 0352.000
ABORTYP(SEQERR) = .TRUE. 0353.000
ABORTYP(READING) = .TRUE. 0354.000
ABORTYP(EOFERR ) = .TRUE. 0355.000
ELSE 0356.000
TOTSDRC = TOTSDRC + 1 0357.000
CALL MONSDRC(F) 0358.000
CALL SNDPACK(Y, PACKNUM, 0, 0) 0359.000
CALL CLOSE(FFD) 0360.000
FFD = 0 0361.000
PACKNUM = MOD(PACKNUM+1,64) 0362.000
NUMTRY = 0 0363.000
RDATA = F 0364.000
ENDIF 0365.000
ELSE IF (PTYP .EQ. ERROR) THEN 0366.000
CALL SNDPACK(N, NUM, 0, 0) 0367.000
CALL MONSDRC(STATE) 0368.000
RDATA = STATE 0369.000
ELSE IF (PTYP .EQ. A) THEN 0369.100
CALL MONSDRC(STATE) 0369.400
CALL SNDPACK(Y, NUM, 0, 0) 0369.500
RDATA = STATE 0369.600
NUMTRY = 0 0369.610
PACKNUM = MOD(NUM+1, 64) 0369.620
GOTO 10 0369.700
ELSE IF(PTYP .EQ. E) THEN 0369.710
CALL SNDPACK(N, NUM, 0, 0) 0369.720
CALL MONSDRC(STATE) 0369.730
RDATA = STATE 0369.740
ELSE 0370.000
RDATA = A 0371.000
ABORTYP(INVALID) = .TRUE. 0372.000
ABORTYP(READING) = .TRUE. 0373.000
ABORTYP(DATAERR) = .TRUE. 0374.000
ENDIF 0375.000
RETURN 0376.000
END 0377.000
INTEGER FUNCTION SEND() 0378.000
IMPLICIT NONE 0379.000
C 0380.000
C= Send file state swithcing routine 0381.000
C 0382.000
INCLUDE K.KERMD 0383.000
INCLUDE K.DBUGC 0384.000
INCLUDE K.PROTC 0385.000
INCLUDE K.PACKC 0386.000
INCLUDE K.MSGCOM 0387.000
C 0388.000
INTEGER MM,DD,YY, HR, MIN, SEC 0389.000
INTEGER I 0390.000
INTEGER MSG(MAXPACK) 0391.000
C 0392.000
INTEGER SLEN 0393.000
INTEGER SDATA 0394.000
INTEGER SFILE 0395.000
INTEGER SEOF 0396.000
INTEGER SBREAK 0397.000
INTEGER SINIT 0398.000
INTRINSIC ICHAR 0399.100
C INTEGER ICHAR 0399.200
C 0400.000
C 0401.000
C initialize statics variables 0402.000
C 0403.000
CALL GETNOW(MM, DD, YY, HR, MIN, SEC) 0404.000
STARTIM = HR * 3600 + MIN * 60 + SEC 0405.000
SCHCNT = 0 0406.000
RCHCNT = 0 0407.000
SCHOVRH = 0 0408.000
RCHOVRH = 0 0409.000
STATE = S 0410.000
NUMTRY = 0 0411.000
TOTSDRC = 0 0412.000
TOTRTRY = 0 0413.000
CLT 2.3 CLEAR ALL PREVIOUS ABORT MESSAGES 0414.000
ABORTYP = .FALSE. 0415.000
IF (IFD .NE. STDIN) CALL PUTC(STDOUT, NEL) 0416.000
X WRITE(19,1000)IFD,STDIN,STDOUT 0416.100
X1000 FORMAT(' SEND** ',3(1X,1Z8)) 0416.200
C 0417.000
C take appropriate action for the current state 0418.000
C 0419.000
10 CONTINUE 0420.000
CALL MONSDRC(STATE) 0421.000
IF (STATE .EQ. D) THEN 0422.000
STATE = SDATA() 0423.000
ELSE IF (STATE .EQ. F) THEN 0424.000
STATE = SFILE() 0425.000
ELSE IF (STATE .EQ. Z) THEN 0426.000
STATE = SEOF() 0427.000
ELSE IF (STATE .EQ. S) THEN 0428.000
STATE = SINIT() 0429.000
ELSE IF (STATE .EQ. B) THEN 0430.000
STATE = SBREAK() 0431.000
ELSE IF (STATE .EQ. C) THEN 0432.000
CALL GETNOW(MM, DD, YY, HR, MIN, SEC) 0433.000
ENDTIM = HR * 3600 + MIN * 60 + SEC 0434.000
SEND = OK 0435.000
GOTO 90 0436.000
ELSE IF (STATE .EQ. A) THEN 0437.000
CALL GETNOW(MM,DD,YY,HR,MIN,SEC) 0438.000
ENDTIM = HR * 3600 + MIN * 60 + SEC 0439.000
SEND = ERROR 0440.000
IF (FFD .NE. 0) CALL CLOSE(FFD) 0441.000
CLT 2.3 SHORTEN ABORT MESSAGE 0442.000
CALL GETEMSG(MSG) 0443.000
CALL SNDPACK(E, PACKNUM, SLEN(MSG), MSG) 0444.000
GOTO 90 0445.000
ELSE 0446.000
CALL PRTMSG('Send - state error = ',STATE) 0447.000
SEND = ERROR 0448.000
IF (FFD .NE. 0) CALL CLOSE(FFD) 0449.000
GOTO 90 0450.000
ENDIF 0451.000
IF (DEBUG(DBGSTAT)) THEN 0452.000
CALL PUTC(DBGFD, STATE) 0453.000
CALL PUTINT(DBGFD, PACKNUM, 1) 0454.000
CALL PUTC(DBGFD, BLANK) 0455.000
IF (MOD(PACKNUM+1, 16) .EQ. 0) CALL PUTC(DBGFD, NEL) 0456.000
ENDIF 0457.000
GOTO 10 0458.000
90 CONTINUE 0459.000
CALL MONSDRC(STATE) 0460.000
RETURN 0461.000
END 0462.000
INTEGER FUNCTION SINIT() 0463.000
IMPLICIT NONE 0464.000
C 0465.000
C= send the send-init packet and wait for reply 0466.000
C 0467.000
INCLUDE K.KERMD 0468.000
INCLUDE K.DBUGC 0469.000
INCLUDE K.PROTC 0470.000
C 0471.000
INTEGER PTYP 0472.000
INTEGER NUM 0473.000
INTEGER LEN 0474.000
CHARACTER*8 FILENAM 0475.000
C 0476.000
INTEGER OPEN 0477.000
INTEGER RDPACK 0478.000
INTEGER SNDPAR 0479.000
C 0480.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0481.000
NUMTRY = NUMTRY + 1 0482.000
IF (NUMTRY .GT. MAXRINI) THEN 0483.000
SINIT = A 0484.000
ABORTYP(TOOMANY) = .TRUE. 0485.000
ABORTYP(SENDING) = .TRUE. 0486.000
ABORTYP(INITERR) = .TRUE. 0487.000
RETURN 0488.000
ENDIF 0489.000
C 0490.000
C send the send-init packet with the right info 0491.000
C 0492.000
LEN = SNDPAR(PACKET) 0493.000
CALL SNDPACK(S, PACKNUM, LEN, PACKET) 0494.000
X WRITE(19,1000)PACKNUM,LEN,PACKET 0494.100
X1000 FORMAT(' SINIT** ',(3(1X,1Z8))) 0494.200
C 0495.000
C pick up and process reply 0496.000
C 0497.000
PTYP = RDPACK(LEN, NUM, RECPACK) 0498.000
IF (PTYP .EQ. N) THEN 0499.000
SINIT = STATE 0500.000
RETURN 0501.000
ELSE IF (PTYP .EQ. Y) THEN 0502.000
IF (PACKNUM .NE. NUM) THEN 0503.000
SINIT = STATE 0504.000
RETURN 0505.000
ENDIF 0506.000
CALL RDPARAM(RECPACK) 0507.000
TOTSDRC = TOTSDRC + 1 0508.000
NUMTRY = 0 0509.000
PACKNUM = MOD(PACKNUM+1,64) 0510.000
CALL AS2DPC (FILESTR, FILENAM) 0511.000
CALL FILCHK(FILENAM) 0512.000
FFD = OPEN(FILENAM, 'R') 0513.000
CLT 2.3 FLAG UNABLE TO OPEN FILE 0514.000
IF (FFD .LE. 0) THEN 0515.000
SINIT = A 0516.000
ABORTYP(LCLFILE) = .TRUE. 0517.000
ABORTYP(SENDING) = .TRUE. 0518.000
ABORTYP(FILERR) = .TRUE. 0519.000
ELSE 0520.000
SINIT = F 0521.000
ENDIF 0522.000
ELSE IF (PTYP .EQ. ERROR) THEN 0523.000
SINIT = STATE 0524.000
ELSE 0525.000
SINIT = A 0526.000
ABORTYP(INVALID) = .TRUE. 0527.000
ABORTYP(SENDING) = .TRUE. 0528.000
ABORTYP(INITERR) = .TRUE. 0529.000
ENDIF 0530.000
RETURN 0531.000
END 0532.000
INTEGER FUNCTION SFILE() 0533.000
IMPLICIT NONE 0534.000
C 0535.000
C= Send a filename packet and wait for reply 0536.000
C 0537.000
INCLUDE K.KERMD 0538.000
INCLUDE K.DBUGC 0539.000
INCLUDE K.PROTC 0540.000
C 0541.000
INTEGER PTYP 0542.000
INTEGER NUM 0543.000
C 0544.000
INTEGER RDPACK 0545.000
INTEGER BUFFIL 0546.000
INTEGER SLEN 0547.000
C 0548.000
C 0549.000
C have we tried this too many times? 0550.000
C 0551.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0552.000
NUMTRY = NUMTRY + 1 0553.000
IF (NUMTRY .GT. MAXRTRY) THEN 0554.000
SFILE = A 0555.000
ABORTYP (TOOMANY) = .TRUE. 0556.000
ABORTYP(SENDING) = .TRUE. 0557.000
ABORTYP(FILERR) = .TRUE. 0558.000
RETURN 0559.000
ENDIF 0560.000
C 0561.000
C send a filename packet 0562.000
C 0563.000
CALL SNDPACK(F, PACKNUM, SLEN(FILESTR), FILESTR) 0564.000
C 0565.000
C check on the reply 0566.000
C 0567.000
PTYP = RDPACK(LEN, NUM, RECPACK) 0568.000
X WRITE(19,1000)LEN,NUM,PTYP 0568.100
X1000 FORMAT(' 568.2** ',3(1X,1Z8)) 0568.200
IF (PTYP .EQ. N) THEN 0569.000
IF (MOD(PACKNUM+1,64) .NE. NUM) THEN 0570.000
SFILE = STATE 0571.000
RETURN 0572.000
ELSE 0573.000
PTYP = Y 0574.000
NUM = NUM - 1 0575.000
ENDIF 0576.000
ENDIF 0577.000
IF (PTYP .EQ. Y) THEN 0578.000
IF (PACKNUM .NE. NUM) THEN 0579.000
SFILE = STATE 0580.000
RETURN 0581.000
ENDIF 0582.000
TOTSDRC = TOTSDRC + 1 0583.000
NUMTRY = 0 0584.000
PACKNUM = MOD(PACKNUM+1,64) 0585.000
C 0586.000
C get first packet of data from the file 0587.000
C 0588.000
PSIZE = BUFFIL(FFD, PACKET) 0589.000
SFILE = D 0590.000
ELSE IF (PTYP .EQ. ERROR) THEN 0591.000
SFILE = STATE 0592.000
ELSE 0593.000
SFILE = A 0594.000
ABORTYP(INVALID) = .TRUE. 0595.000
ABORTYP(SENDING) = .TRUE. 0596.000
ABORTYP(FILERR) = .TRUE. 0597.000
ENDIF 0598.000
RETURN 0599.000
END 0600.000
INTEGER FUNCTION SDATA() 0601.000
IMPLICIT NONE 0602.000
C 0603.000
C= Send a data packet and wait for reply 0604.000
C 0605.000
INCLUDE K.KERMD 0606.000
INCLUDE K.DBUGC 0607.000
INCLUDE K.PROTC 0608.000
C 0609.000
INTEGER PTYP 0610.000
INTEGER NUM 0611.000
INTEGER LEN 0612.000
C 0613.000
INTEGER RDPACK 0614.000
INTEGER BUFFIL 0615.000
C 0616.000
C 0617.000
C have we tried this too many times 0618.000
C 0619.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0620.000
NUMTRY = NUMTRY + 1 0621.000
IF (NUMTRY .GT. MAXRTRY) THEN 0622.000
SDATA = A 0623.000
ABORTYP (TOOMANY) = .TRUE. 0624.000
ABORTYP(SENDING) = .TRUE. 0625.000
ABORTYP(DATAERR) = .TRUE. 0626.000
RETURN 0627.000
ENDIF 0628.000
C 0629.000
C send the current data buffer 0630.000
C 0631.000
IF (PSIZE .EQ. EOF) THEN 0632.000
SDATA = Z 0633.000
RETURN 0634.000
ENDIF 0635.000
X WRITE(19,1000)PACKNUM,PSIZE,LEN,PACKET 0635.100
X1000 FORMAT(' 635.2**',8(1X,1Z8)) 0635.200
CALL SNDPACK(D, PACKNUM, PSIZE, PACKET) 0636.000
C 0637.000
C check on the reply 0638.000
C 0639.000
PTYP = RDPACK(LEN, NUM, RECPACK) 0640.000
X WRITE(19,1001)LEN,NUM,PTYP 0640.100
X1001 FORMAT(' 640.2** ',3(1X,1Z8)) 0640.200
IF (PTYP .EQ. N) THEN 0641.000
IF (MOD(PACKNUM+1,64) .NE. NUM) THEN 0642.000
SDATA = STATE 0643.000
RETURN 0644.000
ELSE 0645.000
PTYP = Y 0646.000
NUM = NUM - 1 0647.000
ENDIF 0648.000
ENDIF 0649.000
IF (PTYP .EQ. Y) THEN 0650.000
IF (PACKNUM .NE. NUM) THEN 0651.000
SDATA = STATE 0652.000
RETURN 0653.000
ENDIF 0654.000
TOTSDRC = TOTSDRC + 1 0655.000
NUMTRY = 0 0656.000
PACKNUM = MOD (PACKNUM+1,64) 0657.000
PSIZE = BUFFIL(FFD, PACKET) 0658.000
IF (PSIZE .EQ. EOF) THEN 0659.000
SDATA = Z 0660.000
ELSE 0661.000
SDATA = STATE 0662.000
ENDIF 0663.000
ELSE IF (PTYP .EQ. ERROR) THEN 0664.000
SDATA = STATE 0665.000
ELSE 0666.000
SDATA = A 0667.000
ABORTYP(INVALID) = .TRUE. 0668.000
ABORTYP(SENDING) = .TRUE. 0669.000
ABORTYP(DATAERR) = .TRUE. 0670.000
ENDIF 0671.000
RETURN 0672.000
END 0673.000
INTEGER FUNCTION SEOF() 0674.000
IMPLICIT NONE 0675.000
C 0676.000
C= Send an eof packet and wait for reply 0677.000
C 0678.000
INCLUDE K.KERMD 0679.000
INCLUDE K.DBUGC 0680.000
INCLUDE K.PROTC 0681.000
C 0682.000
INTEGER PTYP 0683.000
INTEGER NUM 0684.000
INTEGER LEN 0685.000
C 0686.000
INTEGER RDPACK 0687.000
C 0688.000
C 0689.000
C have we tried this too many times 0690.000
C 0691.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0692.000
NUMTRY = NUMTRY + 1 0693.000
IF (NUMTRY .GT. MAXRTRY) THEN 0694.000
SEOF = A 0695.000
ABORTYP (TOOMANY) = .TRUE. 0696.000
ABORTYP(SENDING) = .TRUE. 0697.000
ABORTYP(EOFERR) = .TRUE. 0698.000
RETURN 0699.000
ENDIF 0700.000
C 0701.000
C send the eof packet 0702.000
C 0703.000
CALL SNDPACK(Z, PACKNUM, 0, 0) 0704.000
C 0705.000
C check the reply 0706.000
C 0707.000
PTYP = RDPACK(LEN, NUM, RECPACK) 0708.000
IF (PTYP .EQ. N) THEN 0709.000
IF (MOD(PACKNUM+1,64) .NE. NUM) THEN 0710.000
SEOF = STATE 0711.000
RETURN 0712.000
ELSE 0713.000
PTYP = Y 0714.000
NUM = NUM -1 0715.000
ENDIF 0716.000
ENDIF 0717.000
IF (PTYP .EQ. Y) THEN 0718.000
IF (PACKNUM .NE. NUM) THEN 0719.000
SEOF = STATE 0720.000
RETURN 0721.000
ENDIF 0722.000
TOTSDRC = TOTSDRC + 1 0723.000
NUMTRY = 0 0724.000
PACKNUM = MOD(PACKNUM+1,64) 0725.000
CALL CLOSE(FFD) 0726.000
SEOF = B 0727.000
ELSE IF (PTYP .EQ. ERROR) THEN 0728.000
SEOF = STATE 0729.000
ELSE 0730.000
SEOF = A 0731.000
ABORTYP(INVALID) = .TRUE. 0732.000
ABORTYP(SENDING) = .TRUE. 0733.000
ABORTYP(EOFERR) = .TRUE. 0734.000
ENDIF 0735.000
RETURN 0736.000
END 0737.000
INTEGER FUNCTION SBREAK() 0738.000
IMPLICIT NONE 0739.000
C 0740.000
C= Send the break packet and wait for reply 0741.000
C 0742.000
INCLUDE K.KERMD 0743.000
INCLUDE K.DBUGC 0744.000
INCLUDE K.PROTC 0745.000
C 0746.000
INTEGER PTYP 0747.000
INTEGER NUM 0748.000
INTEGER LEN 0749.000
C 0750.000
INTEGER RDPACK 0751.000
C 0752.000
C 0753.000
C have we tried this too many times 0754.000
C 0755.000
IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1 0756.000
NUMTRY = NUMTRY + 1 0757.000
IF (NUMTRY .GT. MAXRTRY) THEN 0758.000
SBREAK = A 0759.000
ABORTYP (TOOMANY) = .TRUE. 0760.000
ABORTYP(SENDING) = .TRUE. 0761.000
ABORTYP(BRKERR) = .TRUE. 0762.000
RETURN 0763.000
ENDIF 0764.000
C 0765.000
C send the break packet 0766.000
C 0767.000
CALL SNDPACK(B, PACKNUM, 0, 0) 0768.000
C 0769.000
C check on the reply 0770.000
C 0771.000
PTYP = RDPACK(LEN, NUM, RECPACK) 0772.000
IF (PTYP .EQ. N) THEN 0773.000
IF (MOD(PACKNUM+1,64) .NE. NUM) THEN 0774.000
SBREAK = STATE 0775.000
RETURN 0776.000
ELSE 0777.000
PTYP = Y 0778.000
NUM = NUM - 1 0779.000
ENDIF 0780.000
ENDIF 0781.000
IF (PTYP .EQ. Y) THEN 0782.000
IF (PACKNUM .NE. NUM) THEN 0783.000
SBREAK = STATE 0784.000
RETURN 0785.000
ENDIF 0786.000
TOTSDRC = TOTSDRC + 1 0787.000
NUMTRY = 0 0788.000
PACKNUM = MOD(PACKNUM+1,64) 0789.000
SBREAK = C 0790.000
ELSE IF (PTYP .EQ. ERROR) THEN 0791.000
SBREAK = STATE 0792.000
ELSE 0793.000
SBREAK = A 0794.000
ABORTYP(INVALID) = .TRUE. 0795.000
ABORTYP(SENDING) = .TRUE. 0796.000
ABORTYP(BRKERR) = .TRUE. 0797.000
ENDIF 0798.000
RETURN 0799.000
END 0800.000
SUBROUTINE MONSDRC(ISTATE) 0801.000
IMPLICIT NONE 0802.000
INTEGER ISTATE 0803.000
C 0804.000
C= Monitor send or receive transaction 0805.000
C 0806.000
INCLUDE K.KERMD 0807.000
INCLUDE K.PROTC 0808.000
INCLUDE K.DBUGC 0809.000
C 0810.000
IF (STDIN .NE. IFD) THEN 0811.000
CALL PUTC(STDOUT, CR) 0812.000
IF (DEBUG(DBGSTAT)) THEN 0813.000
CALL PRINT(STDOUT, 'State ') 0814.000
CALL PUTC(STDOUT, ISTATE) 0815.000
ENDIF 0816.000
CALL PRINT(STDOUT, ' Receive ') 0817.000
CALL PUTINT(STDOUT, TOTSDRC, 3) 0818.000
CALL PRINT(STDOUT, ' Retry ') 0819.000
CALL PUTINT(STDOUT, TOTRTRY, 3) 0820.000
CALL FLUSH(STDOUT) 0821.000
ENDIF 0822.000
RETURN 0823.000
END 0824.000