* 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