home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / gould3 / kermit2 < prev    next >
Text File  |  2020-01-01  |  69KB  |  858 lines
  1. *     BASE -ULTLY-KERM -SFM-A2703 - 08/01/90  WJH     HEADER  SFMKERM   0001.000
  2.       INTEGER FUNCTION RECEIVE(ISTATE)                                  0001.100
  3.             IMPLICIT NONE                                               0002.000
  4.             INTEGER    ISTATE      !state to start at                   0003.000
  5. C                                                                       0004.000
  6. C= Receive a file state switching routine.                              0005.000
  7. C                                                                       0006.000
  8.       INCLUDE      K.KERMD                                              0007.000
  9.       INCLUDE      K.DBUGC                                              0008.000
  10.       INCLUDE      K.PROTC                                              0009.000
  11.       INCLUDE      K.PACKC                                              0010.000
  12.       INCLUDE      K.MSGCOM                                             0011.000
  13. C                                                                       0012.000
  14.       INTEGER      MM,DD,YY, HR, MIN, SEC                               0013.000
  15.       INTEGER      MSG(MAXPACK)                                         0014.000
  16.       INTEGER      I                                                    0015.000
  17. C                                                                       0016.000
  18.       INTEGER      RINIT                                                0017.000
  19.       INTEGER      RDATA                                                0018.000
  20.       INTEGER      RFILE                                                0019.000
  21.       INTEGER      SLEN            !length of string                    0020.000
  22.       INTRINSIC    ICHAR                                                0021.100
  23. C     INTEGER      ICHAR           !character to integer                0021.200
  24. C                                                                       0022.000
  25.       CHARACTER*72 RCVMES (4 )                                          0023.000
  26.      $ /'[Kermit RECEIVE running on Gould host.  Please type your',     0024.000
  27.      $  'escape sequence ( altK ) to return to your local machine',     0025.000
  28.      $  'Use SEND to send a file to the GOULD host.          ',         0026.000
  29.      $  'NOTE: The file must already exist on the GOULD host.'/         0027.000
  30. C                                                                       0028.000
  31. C initialize statistics variables                                       0029.000
  32. C                                                                       0030.000
  33.       CALL GETNOW(MM, DD, YY, HR, MIN, SEC)                             0031.000
  34.       STARTIM = HR*3600 + MIN*60 + SEC                                  0032.000
  35.       SCHCNT = 0                                                        0033.000
  36.       RCHCNT = 0                                                        0034.000
  37.       SCHOVRH = 0                                                       0035.000
  38.       RCHOVRH = 0                                                       0036.000
  39.       TOTSDRC = 0                                                       0037.000
  40.       TOTRTRY = 0                                                       0038.000
  41. CLT 2.3 ZERO ALL PREVIOUS ABORTS                                        0039.000
  42.       ABORTYP = .FALSE.                                                 0040.000
  43.       CALL OUTTBL(RCVMES, 1, 4)                                         0041.000
  44.       IF (IFD .NE. STDIN) CALL PUTC(STDOUT, NEL)                        0042.000
  45. C                                                                       0043.000
  46. C set packet retry count ácurrent state                                0044.000
  47. C                                                                       0045.000
  48.       NUMTRY = 0                                                        0046.000
  49.       STATE = ISTATE                                                    0047.000
  50. C                                                                       0048.000
  51. C take appropriate action for the current state                         0049.000
  52. C                                                                       0050.000
  53.       CALL MONSDRC(STATE)                                               0051.000
  54.  10   CONTINUE                                                          0052.000
  55.       IF (STATE .EQ. D) THEN                                            0053.000
  56.         STATE = RDATA()                                                 0054.000
  57.       ELSE IF (STATE .EQ. F) THEN                                       0055.000
  58.         STATE = RFILE()                                                 0056.000
  59.       ELSE IF (STATE .EQ. R) THEN                                       0057.000
  60.         STATE = RINIT()                                                 0058.000
  61.       ELSE IF (STATE .EQ. C) THEN                                       0059.000
  62.         CALL GETNOW(MM, DD, YY, HR, MIN, SEC)                           0060.000
  63.         ENDTIM = HR * 3600 + MIN * 60 + SEC                             0061.000
  64.         RECEIVE = OK                                                    0062.000
  65.         GOTO 90                                                         0063.000
  66.       ELSE IF (STATE .EQ. A) THEN                                       0064.000
  67.         CALL GETNOW(MM, DD, YY, HR, MIN, SEC)                           0065.000
  68.         ENDTIM = HR * 3600 + MIN * 60 + SEC                             0066.000
  69.         RECEIVE = ERROR                                                 0067.000
  70.         IF (FFD .NE. 0) CALL CLOSE(FFD)                                 0068.000
  71. CLT 2.3 SHORTEN MESSAGE                                                 0069.000
  72.         CALL GETEMSG(MSG)                                               0070.000
  73.         CALL SNDPACK(E, PACKNUM, SLEN(MSG), MSG)                        0071.000
  74.         GOTO 90                                                         0072.000
  75.       ELSE                                                              0073.000
  76.         CALL PRTMSG(' Receive - state error = ',STATE)                  0074.000
  77.         IF (FFD .NE. 0) CALL CLOSE(FFD)                                 0075.000
  78.         RECEIVE = ERROR                                                 0076.000
  79.         GOTO 90                                                         0077.000
  80.       ENDIF                                                             0078.000
  81.       IF (DEBUG(DBGSTAT)) THEN                                          0079.000
  82.         CALL PUTC(DBGFD, STATE)                                         0080.000
  83.         CALL PUTINT(DBGFD, PACKNUM, 1)                                  0081.000
  84.         CALL PUTC(DBGFD, BLANK)                                         0082.000
  85.         IF (MOD(PACKNUM+1, 16) .EQ. 0) CALL PUTC(DBGFD, NEL)            0083.000
  86.       ENDIF                                                             0084.000
  87.       GOTO 10                                                           0085.000
  88.  90   CONTINUE                     !return                              0086.000
  89.       CALL MONSDRC(STATE)                                               0087.000
  90.       RETURN                                                            0088.000
  91.       END                                                               0089.000
  92.       INTEGER FUNCTION RINIT()                                          0090.000
  93.            IMPLICIT NONE                                                0091.000
  94. C                                                                       0092.000
  95. C= Receive a send-init packet                                           0093.000
  96. C                                                                       0094.000
  97.       INCLUDE      K.KERMD                                              0095.000
  98.       INCLUDE      K.DBUGC                                              0096.000
  99.       INCLUDE      K.PROTC                                              0097.000
  100. C                                                                       0098.000
  101.       INTEGER      PTYP                                                 0099.000
  102.       INTEGER      NUM                                                  0100.000
  103. C                                                                       0101.000
  104.       INTEGER      RDPACK                                               0102.000
  105.       INTEGER      SNDPAR                                               0103.000
  106. C                                                                       0104.000
  107.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0105.000
  108.       NUMTRY = NUMTRY + 1                                               0106.000
  109.       IF (NUMTRY .GT. MAXRINI) THEN                                     0107.000
  110.         RINIT = A                                                       0108.000
  111.         ABORTYP(TOOMANY) = .TRUE.                                       0109.000
  112.         ABORTYP(READING) = .TRUE.                                       0110.000
  113.         ABORTYP(INITERR) = .TRUE.                                       0111.000
  114.         RETURN                                                          0112.000
  115.       ENDIF                                                             0113.000
  116. C                                                                       0114.000
  117. C read a packet and hope for best                                       0115.000
  118. C                                                                       0116.000
  119.       PTYP = RDPACK(LEN, NUM, PACKET)                                   0117.000
  120. C                                                                       0118.000
  121. C is it a valid packet type                                             0119.000
  122. C                                                                       0120.000
  123.       IF (PTYP .EQ. S) THEN                                             0121.000
  124.         TOTSDRC = TOTSDRC + 1                                           0122.000
  125.         NUMTRY = 0                                                      0123.000
  126.         CALL MONSDRC(F)                                                 0124.000
  127.         PACKNUM = NUM                                                   0125.000
  128.         CALL RDPARAM(PACKET)                                            0126.000
  129.         LEN = SNDPAR(PACKET)                                            0127.000
  130.         CALL SNDPACK(Y, NUM, LEN, PACKET)                               0128.000
  131.         PACKNUM = MOD(PACKNUM+1, 64)                                    0129.000
  132.         RINIT = F                                                       0130.000
  133. C                                                                       0131.000
  134. C did we get a checksum error                                           0132.000
  135. C                                                                       0133.000
  136.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0134.000
  137.         RINIT = STATE                                                   0135.000
  138.         CALL MONSDRC(STATE)                                             0136.000
  139.         CALL SNDPACK(N, NUM, 0, 0)                                      0137.000
  140.       ELSE                                                              0138.000
  141.         RINIT = A                                                       0139.000
  142.         ABORTYP(INVALID) = .TRUE.                                       0140.000
  143.         ABORTYP(READING) = .TRUE.                                       0141.000
  144.         ABORTYP(INITERR) = .TRUE.                                       0142.000
  145.       ENDIF                                                             0143.000
  146.       RETURN                                                            0144.000
  147.       END                                                               0145.000
  148.       INTEGER FUNCTION RFILE()                                          0146.000
  149.             IMPLICIT NONE                                               0147.000
  150. C                                                                       0148.000
  151. C= Read a filename packet                                               0149.000
  152. C                                                                       0150.000
  153. C  Rfile expects to see a filename (type f) packet.  However it may     0151.000
  154. C  find a send-init retry, end-of-file retry or break packet.           0152.000
  155. C                                                                       0153.000
  156.       INCLUDE      K.KERMD                                              0154.000
  157.       INCLUDE      K.DBUGC                                              0155.000
  158.       INCLUDE      K.PROTC                                              0156.000
  159. C                                                                       0157.000
  160.       INTEGER      PTYP                                                 0158.000
  161.       INTEGER      NUM                                                  0159.000
  162. C                                                                       0160.000
  163.       INTEGER      RDPACK                                               0161.000
  164.       INTEGER      SNDPAR                                               0162.000
  165.       INTEGER      GETFILE                                              0163.000
  166. C                                                                       0164.000
  167.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0165.000
  168.       NUMTRY = NUMTRY + 1                                               0166.000
  169.       IF (NUMTRY .GT. MAXRTRY) THEN                                     0167.000
  170.         RFILE = A                                                       0168.000
  171.         ABORTYP(TOOMANY) = .TRUE.                                       0169.000
  172.         ABORTYP(READING) = .TRUE.                                       0170.000
  173.         ABORTYP(FILERR) = .TRUE.                                        0171.000
  174.         RETURN                                                          0172.000
  175.       ENDIF                                                             0173.000
  176. C                                                                       0174.000
  177. C read a packet                                                         0175.000
  178. C                                                                       0176.000
  179.       PTYP = RDPACK(LEN, NUM, PACKET)                                   0177.000
  180. X     WRITE(19,1000)LEN,NUM,PACKNUM                                     0177.100
  181. X1000 FORMAT(1X,'1772 ** ',7(1X,1Z8))                                   0177.200
  182. C                                                                       0178.000
  183. C is it a filename packet?                                              0179.000
  184. C                                                                       0180.000
  185.       IF (PTYP .EQ. F) THEN                                             0181.000
  186.         IF (NUM .NE. PACKNUM) THEN                                      0182.000
  187.           RFILE = A                                                     0183.000
  188.           ABORTYP(SEQERR) = .TRUE.                                      0184.000
  189.           ABORTYP(READING) = .TRUE.                                     0185.000
  190.           ABORTYP(FILERR) = .TRUE.                                      0186.000
  191.           RETURN                                                        0187.000
  192.         ENDIF                                                           0188.000
  193.         IF (DEBUG(DBGON)) THEN                                          0189.000
  194.           CALL PRINTL(DBGFD, 'Receiving file ')                         0190.000
  195.           CALL PUTSTR(DBGFD, PACKET)                                    0191.000
  196.           CALL FLUSH(DBGFD)                                             0192.000
  197.         ENDIF                                                           0193.000
  198.         FFD = GETFILE(PACKET)                                           0194.000
  199. X       WRITE(19,1001)FFD,NUM,LEN                                       0194.100
  200. X1001   FORMAT(' 194.2** ',3(1X,1Z8))                                   0194.200
  201.         IF (FFD .LE. 0) THEN                                            0195.000
  202.           FFD = 0                                                       0196.000
  203.           RFILE = A                                                     0197.000
  204.           ABORTYP(LCLFILE) = .TRUE.                                     0198.000
  205.           ABORTYP(READING) = .TRUE.                                     0199.000
  206.           ABORTYP(FILERR) = .TRUE.                                      0200.000
  207.         ELSE                                                            0201.000
  208.           NUMTRY = 0                                                    0202.000
  209.           TOTSDRC = TOTSDRC + 1                                         0203.000
  210.           CALL MONSDRC(D)                                               0204.000
  211.           CALL STRCPY(PACKET, FILESTR)                                  0205.000
  212.           CALL SNDPACK(Y, NUM, 0, 0)                                    0206.000
  213.           PACKNUM = MOD(PACKNUM+1, 64)                                  0207.000
  214.           RFILE = D                                                     0208.000
  215.         ENDIF                                                           0209.000
  216. C                                                                       0210.000
  217. C is it an old send-init packet?                                        0211.000
  218. C                                                                       0212.000
  219.       ELSE IF (PTYP .EQ. S) THEN                                        0213.000
  220. X        WRITE(19,1002)PTYP,NUM,PACKNUM,LEN                             0213.100
  221. X1002     FORMAT(1X,' 2132 **',4(1X,1Z8))                               0213.200
  222.         IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN                           0214.000
  223.           NUMTRY = 0                                                    0215.000
  224.           TOTSDRC = TOTSDRC + 1                                         0216.000
  225.           CALL MONSDRC(STATE)                                           0217.000
  226.           LEN = SNDPAR(PACKET)                                          0218.000
  227.           CALL SNDPACK(Y, NUM, LEN, PACKET)                             0219.000
  228.           RFILE = STATE                                                 0220.000
  229.         ELSE                                                            0221.000
  230.           RFILE = A                                                     0222.000
  231.           ABORTYP(SEQERR) = .TRUE.                                      0223.000
  232.           ABORTYP(READING) = .TRUE.                                     0224.000
  233.           ABORTYP(INITERR) = .TRUE.                                     0225.000
  234.         ENDIF                                                           0226.000
  235. C                                                                       0227.000
  236. C is it an old eof packet                                               0228.000
  237. C                                                                       0229.000
  238.       ELSE IF (PTYP .EQ. Z) THEN                                        0230.000
  239.         IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN                           0231.000
  240.           NUMTRY = 0                                                    0232.000
  241.           TOTSDRC = TOTSDRC + 1                                         0233.000
  242.           CALL MONSDRC(STATE)                                           0234.000
  243.           CALL SNDPACK(Y, NUM, 0, 0)                                    0235.000
  244.           RFILE = STATE                                                 0236.000
  245.         ELSE                                                            0237.000
  246.           RFILE = A                                                     0238.000
  247.           ABORTYP(SEQERR) = .TRUE.                                      0239.000
  248.           ABORTYP(READING) = .TRUE.                                     0240.000
  249.           ABORTYP(INITERR) = .TRUE.                                     0241.000
  250.         ENDIF                                                           0242.000
  251. C                                                                       0243.000
  252. C is it a break packet?                                                 0244.000
  253. C                                                                       0245.000
  254.       ELSE IF (PTYP .EQ. B) THEN                                        0246.000
  255.         IF (NUM .NE. PACKNUM) THEN                                      0247.000
  256.           RFILE = A                                                     0248.000
  257.           ABORTYP(SEQERR) = .TRUE.                                      0249.000
  258.           ABORTYP(READING) = .TRUE.                                     0250.000
  259.           ABORTYP(BRKERR) = .TRUE.                                      0251.000
  260.         ELSE                                                            0252.000
  261.           NUMTRY = 0                                                    0253.000
  262.           TOTSDRC = TOTSDRC + 1                                         0254.000
  263.           CALL MONSDRC(C)                                               0255.000
  264.           CALL SNDPACK(Y, PACKNUM, 0, 0)                                0256.000
  265.           RFILE = C                                                     0257.000
  266.         ENDIF                                                           0258.000
  267. C                                                                       0259.000
  268. C did we get a checksum error                                           0260.000
  269. C                                                                       0261.000
  270.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0262.000
  271.         RFILE = STATE                                                   0263.000
  272.         CALL MONSDRC(STATE)                                             0264.000
  273.         CALL SNDPACK(N, NUM, 0, 0)                                      0265.000
  274. C                                                                       0266.000
  275. C invalid packet type                                                   0267.000
  276. C                                                                       0268.000
  277.       ELSE                                                              0269.000
  278.         RFILE = A                                                       0270.000
  279.         ABORTYP(INVALID) = .TRUE.                                       0271.000
  280.         ABORTYP(READING) = .TRUE.                                       0272.000
  281.         ABORTYP(FILERR) = .TRUE.                                        0273.000
  282.       ENDIF                                                             0274.000
  283.       RETURN                                                            0275.000
  284.       END                                                               0276.000
  285.       INTEGER FUNCTION RDATA()                                          0277.000
  286.            IMPLICIT NONE                                                0278.000
  287. C                                                                       0279.000
  288. C= Read a data packet                                                   0280.000
  289. C                                                                       0281.000
  290.       INCLUDE      K.KERMD                                              0282.000
  291.       INCLUDE      K.DBUGC                                              0283.000
  292.       INCLUDE      K.PROTC                                              0284.000
  293. C                                                                       0285.000
  294. C                                                                       0286.000
  295. C check retry count                                                     0287.000
  296. C                                                                       0288.000
  297.       INTEGER      PTYP                                                 0289.000
  298.       INTEGER      NUM                                                  0290.000
  299. C                                                                       0291.000
  300.       INTEGER      RDPACK                                               0292.000
  301. C                                                                       0293.000
  302.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0294.000
  303.       NUMTRY = NUMTRY + 1                                               0295.000
  304.       IF (NUMTRY .GT. MAXRTRY) THEN                                     0296.000
  305.         RDATA = A                                                       0297.000
  306.         ABORTYP(TOOMANY) = .TRUE.                                       0298.000
  307.         ABORTYP(READING) = .TRUE.                                       0299.000
  308.         ABORTYP(DATAERR) = .TRUE.                                       0300.000
  309.         RETURN                                                          0301.000
  310.       ENDIF                                                             0302.000
  311. C                                                                       0303.000
  312. C read a packet                                                         0304.000
  313. C                                                                       0305.000
  314. 10    PTYP = RDPACK(LEN, NUM, PACKET)                                   0306.000
  315. X     WRITE(19,1000)LEN,NUM,PACKNUM ,PTYP                               0306.100
  316. X1000 FORMAT(1X,'3062 ** ',7(1X,1Z8))                                   0306.200
  317. C                                                                       0307.000
  318. C did we get a data packet                                              0308.000
  319. C                                                                       0309.000
  320.       IF (PTYP .EQ. D) THEN                                             0310.000
  321.         IF (NUM .NE. PACKNUM) THEN                                      0311.000
  322.           IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN                         0312.000
  323.             CALL MONSDRC(STATE)                                         0313.000
  324.             CALL SNDPACK(Y, NUM, 0, 0)                                  0314.000
  325.             RDATA = STATE                                               0315.000
  326.           ELSE                                                          0316.000
  327.             RDATA = A                                                   0317.000
  328.             ABORTYP(SEQERR) = .TRUE.                                    0318.000
  329.             ABORTYP(READING) = .TRUE.                                   0319.000
  330.             ABORTYP(DATAERR) = .TRUE.                                   0320.000
  331.           ENDIF                                                         0321.000
  332.         ELSE                                                            0322.000
  333.           TOTSDRC = TOTSDRC + 1                                         0323.000
  334.           CALL MONSDRC(STATE)                                           0324.000
  335.           CALL BUFEMP(PACKET, FFD, LEN)                                 0325.000
  336.           CALL SNDPACK(Y, PACKNUM, 0, 0)                                0326.000
  337.           NUMTRY = 0                                                    0327.000
  338.           PACKNUM = MOD(PACKNUM+1, 64)                                  0328.000
  339.           RDATA = STATE                                                 0329.000
  340.           GO TO 10                                                      0329.100
  341.         ENDIF                                                           0330.000
  342. C                                                                       0331.000
  343. C is it an old filename packet                                          0332.000
  344. C                                                                       0333.000
  345.       ELSE IF (PTYP .EQ. F) THEN                                        0334.000
  346.         IF (MOD(NUM+1, 64) .EQ. PACKNUM) THEN                           0335.000
  347.           TOTSDRC = TOTSDRC + 1                                         0336.000
  348.           CALL MONSDRC(STATE)                                           0337.000
  349.           CALL SNDPACK(Y, NUM, 0, 0)                                    0338.000
  350.           NUMTRY = 0                                                    0339.000
  351.           RDATA = STATE                                                 0340.000
  352.         ELSE                                                            0341.000
  353.           RDATA = A                                                     0342.000
  354.           ABORTYP(SEQERR) = .TRUE.                                      0343.000
  355.           ABORTYP(READING) = .TRUE.                                     0344.000
  356.           ABORTYP(FILERR ) = .TRUE.                                     0345.000
  357.         ENDIF                                                           0346.000
  358. C                                                                       0347.000
  359. C is it an eof packet                                                   0348.000
  360. C                                                                       0349.000
  361.       ELSE IF (PTYP .EQ. Z) THEN                                        0350.000
  362.         IF (NUM .NE. PACKNUM) THEN                                      0351.000
  363.           RDATA = A                                                     0352.000
  364.           ABORTYP(SEQERR) = .TRUE.                                      0353.000
  365.           ABORTYP(READING) = .TRUE.                                     0354.000
  366.           ABORTYP(EOFERR ) = .TRUE.                                     0355.000
  367.         ELSE                                                            0356.000
  368.           TOTSDRC = TOTSDRC + 1                                         0357.000
  369.           CALL MONSDRC(F)                                               0358.000
  370.           CALL SNDPACK(Y, PACKNUM, 0, 0)                                0359.000
  371.           CALL CLOSE(FFD)                                               0360.000
  372.           FFD =  0                                                      0361.000
  373.           PACKNUM = MOD(PACKNUM+1,64)                                   0362.000
  374.           NUMTRY = 0                                                    0363.000
  375.           RDATA = F                                                     0364.000
  376.         ENDIF                                                           0365.000
  377.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0366.000
  378.         CALL SNDPACK(N, NUM, 0, 0)                                      0367.000
  379.         CALL MONSDRC(STATE)                                             0368.000
  380.         RDATA = STATE                                                   0369.000
  381.       ELSE IF (PTYP .EQ. A) THEN                                        0369.100
  382.             CALL MONSDRC(STATE)                                         0369.400
  383.             CALL SNDPACK(Y, NUM, 0, 0)                                  0369.500
  384.             RDATA = STATE                                               0369.600
  385.             NUMTRY = 0                                                  0369.610
  386.             PACKNUM = MOD(NUM+1, 64)                                    0369.620
  387.             GOTO 10                                                     0369.700
  388.       ELSE IF(PTYP .EQ. E) THEN                                         0369.710
  389.         CALL SNDPACK(N, NUM, 0, 0)                                      0369.720
  390.         CALL MONSDRC(STATE)                                             0369.730
  391.         RDATA = STATE                                                   0369.740
  392.       ELSE                                                              0370.000
  393.         RDATA = A                                                       0371.000
  394.         ABORTYP(INVALID) = .TRUE.                                       0372.000
  395.         ABORTYP(READING) = .TRUE.                                       0373.000
  396.         ABORTYP(DATAERR) = .TRUE.                                       0374.000
  397.       ENDIF                                                             0375.000
  398.       RETURN                                                            0376.000
  399.       END                                                               0377.000
  400.       INTEGER FUNCTION SEND()                                           0378.000
  401.            IMPLICIT NONE                                                0379.000
  402. C                                                                       0380.000
  403. C= Send file state swithcing routine                                    0381.000
  404. C                                                                       0382.000
  405.       INCLUDE      K.KERMD                                              0383.000
  406.       INCLUDE      K.DBUGC                                              0384.000
  407.       INCLUDE      K.PROTC                                              0385.000
  408.       INCLUDE      K.PACKC                                              0386.000
  409.       INCLUDE      K.MSGCOM                                             0387.000
  410. C                                                                       0388.000
  411.       INTEGER      MM,DD,YY, HR, MIN, SEC                               0389.000
  412.       INTEGER      I                                                    0390.000
  413.       INTEGER      MSG(MAXPACK)                                         0391.000
  414. C                                                                       0392.000
  415.       INTEGER      SLEN                                                 0393.000
  416.       INTEGER      SDATA                                                0394.000
  417.       INTEGER      SFILE                                                0395.000
  418.       INTEGER      SEOF                                                 0396.000
  419.       INTEGER      SBREAK                                               0397.000
  420.       INTEGER      SINIT                                                0398.000
  421.       INTRINSIC    ICHAR                                                0399.100
  422. C     INTEGER      ICHAR                                                0399.200
  423. C                                                                       0400.000
  424. C                                                                       0401.000
  425. C initialize statics variables                                          0402.000
  426. C                                                                       0403.000
  427.       CALL GETNOW(MM, DD, YY, HR, MIN, SEC)                             0404.000
  428.       STARTIM = HR * 3600 + MIN * 60 + SEC                              0405.000
  429.       SCHCNT = 0                                                        0406.000
  430.       RCHCNT = 0                                                        0407.000
  431.       SCHOVRH = 0                                                       0408.000
  432.       RCHOVRH = 0                                                       0409.000
  433.       STATE = S                                                         0410.000
  434.       NUMTRY = 0                                                        0411.000
  435.       TOTSDRC = 0                                                       0412.000
  436.       TOTRTRY = 0                                                       0413.000
  437. CLT 2.3 CLEAR ALL PREVIOUS ABORT MESSAGES                               0414.000
  438.       ABORTYP = .FALSE.                                                 0415.000
  439.       IF (IFD .NE. STDIN) CALL PUTC(STDOUT, NEL)                        0416.000
  440. X     WRITE(19,1000)IFD,STDIN,STDOUT                                    0416.100
  441. X1000 FORMAT(' SEND** ',3(1X,1Z8))                                      0416.200
  442. C                                                                       0417.000
  443. C take appropriate action for the current state                         0418.000
  444. C                                                                       0419.000
  445.  10   CONTINUE                                                          0420.000
  446.       CALL MONSDRC(STATE)                                               0421.000
  447.       IF (STATE .EQ. D) THEN                                            0422.000
  448.         STATE = SDATA()                                                 0423.000
  449.       ELSE IF (STATE .EQ. F) THEN                                       0424.000
  450.         STATE = SFILE()                                                 0425.000
  451.       ELSE IF (STATE .EQ. Z) THEN                                       0426.000
  452.         STATE = SEOF()                                                  0427.000
  453.       ELSE IF (STATE .EQ. S) THEN                                       0428.000
  454.         STATE = SINIT()                                                 0429.000
  455.       ELSE IF (STATE .EQ. B) THEN                                       0430.000
  456.         STATE = SBREAK()                                                0431.000
  457.       ELSE IF (STATE .EQ. C) THEN                                       0432.000
  458.         CALL GETNOW(MM, DD, YY, HR, MIN, SEC)                           0433.000
  459.         ENDTIM = HR * 3600 + MIN * 60 + SEC                             0434.000
  460.         SEND = OK                                                       0435.000
  461.         GOTO 90                                                         0436.000
  462.       ELSE IF (STATE .EQ. A) THEN                                       0437.000
  463.         CALL GETNOW(MM,DD,YY,HR,MIN,SEC)                                0438.000
  464.         ENDTIM = HR * 3600 + MIN * 60 + SEC                             0439.000
  465.         SEND = ERROR                                                    0440.000
  466.         IF (FFD .NE. 0) CALL CLOSE(FFD)                                 0441.000
  467. CLT 2.3 SHORTEN ABORT MESSAGE                                           0442.000
  468.         CALL GETEMSG(MSG)                                               0443.000
  469.         CALL SNDPACK(E, PACKNUM, SLEN(MSG), MSG)                        0444.000
  470.         GOTO 90                                                         0445.000
  471.       ELSE                                                              0446.000
  472.         CALL PRTMSG('Send - state error = ',STATE)                      0447.000
  473.         SEND = ERROR                                                    0448.000
  474.         IF (FFD .NE. 0) CALL CLOSE(FFD)                                 0449.000
  475.         GOTO 90                                                         0450.000
  476.       ENDIF                                                             0451.000
  477.       IF (DEBUG(DBGSTAT)) THEN                                          0452.000
  478.         CALL PUTC(DBGFD, STATE)                                         0453.000
  479.         CALL PUTINT(DBGFD, PACKNUM, 1)                                  0454.000
  480.         CALL PUTC(DBGFD, BLANK)                                         0455.000
  481.         IF (MOD(PACKNUM+1, 16) .EQ. 0) CALL PUTC(DBGFD, NEL)            0456.000
  482.       ENDIF                                                             0457.000
  483.       GOTO 10                                                           0458.000
  484.  90   CONTINUE                                                          0459.000
  485.       CALL MONSDRC(STATE)                                               0460.000
  486.       RETURN                                                            0461.000
  487.       END                                                               0462.000
  488.       INTEGER FUNCTION SINIT()                                          0463.000
  489.            IMPLICIT NONE                                                0464.000
  490. C                                                                       0465.000
  491. C= send the send-init packet and wait for reply                         0466.000
  492. C                                                                       0467.000
  493.       INCLUDE      K.KERMD                                              0468.000
  494.       INCLUDE      K.DBUGC                                              0469.000
  495.       INCLUDE      K.PROTC                                              0470.000
  496. C                                                                       0471.000
  497.       INTEGER      PTYP                                                 0472.000
  498.       INTEGER      NUM                                                  0473.000
  499.       INTEGER      LEN                                                  0474.000
  500.       CHARACTER*8  FILENAM                                              0475.000
  501. C                                                                       0476.000
  502.       INTEGER      OPEN                                                 0477.000
  503.       INTEGER      RDPACK                                               0478.000
  504.       INTEGER      SNDPAR                                               0479.000
  505. C                                                                       0480.000
  506.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0481.000
  507.       NUMTRY = NUMTRY + 1                                               0482.000
  508.       IF (NUMTRY .GT. MAXRINI) THEN                                     0483.000
  509.         SINIT = A                                                       0484.000
  510.         ABORTYP(TOOMANY) = .TRUE.                                       0485.000
  511.         ABORTYP(SENDING) = .TRUE.                                       0486.000
  512.         ABORTYP(INITERR) = .TRUE.                                       0487.000
  513.         RETURN                                                          0488.000
  514.       ENDIF                                                             0489.000
  515. C                                                                       0490.000
  516. C send the send-init packet with the right info                         0491.000
  517. C                                                                       0492.000
  518.       LEN = SNDPAR(PACKET)                                              0493.000
  519.       CALL SNDPACK(S, PACKNUM, LEN, PACKET)                             0494.000
  520. X     WRITE(19,1000)PACKNUM,LEN,PACKET                                  0494.100
  521. X1000 FORMAT(' SINIT**  ',(3(1X,1Z8)))                                  0494.200
  522. C                                                                       0495.000
  523. C pick up and process reply                                             0496.000
  524. C                                                                       0497.000
  525.       PTYP = RDPACK(LEN, NUM, RECPACK)                                  0498.000
  526.       IF (PTYP .EQ. N) THEN                                             0499.000
  527.         SINIT = STATE                                                   0500.000
  528.         RETURN                                                          0501.000
  529.       ELSE IF (PTYP .EQ. Y) THEN                                        0502.000
  530.         IF (PACKNUM .NE. NUM) THEN                                      0503.000
  531.           SINIT = STATE                                                 0504.000
  532.           RETURN                                                        0505.000
  533.         ENDIF                                                           0506.000
  534.         CALL RDPARAM(RECPACK)                                           0507.000
  535.         TOTSDRC = TOTSDRC + 1                                           0508.000
  536.         NUMTRY = 0                                                      0509.000
  537.         PACKNUM = MOD(PACKNUM+1,64)                                     0510.000
  538.         CALL AS2DPC (FILESTR, FILENAM)                                  0511.000
  539.         CALL FILCHK(FILENAM)                                            0512.000
  540.         FFD = OPEN(FILENAM, 'R')                                        0513.000
  541. CLT 2.3 FLAG UNABLE TO OPEN FILE                                        0514.000
  542.         IF (FFD .LE. 0) THEN                                            0515.000
  543.           SINIT = A                                                     0516.000
  544.           ABORTYP(LCLFILE) = .TRUE.                                     0517.000
  545.           ABORTYP(SENDING) = .TRUE.                                     0518.000
  546.           ABORTYP(FILERR) = .TRUE.                                      0519.000
  547.         ELSE                                                            0520.000
  548.           SINIT = F                                                     0521.000
  549.         ENDIF                                                           0522.000
  550.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0523.000
  551.         SINIT = STATE                                                   0524.000
  552.       ELSE                                                              0525.000
  553.         SINIT = A                                                       0526.000
  554.         ABORTYP(INVALID) = .TRUE.                                       0527.000
  555.         ABORTYP(SENDING) = .TRUE.                                       0528.000
  556.         ABORTYP(INITERR) = .TRUE.                                       0529.000
  557.       ENDIF                                                             0530.000
  558.       RETURN                                                            0531.000
  559.       END                                                               0532.000
  560.       INTEGER FUNCTION SFILE()                                          0533.000
  561.            IMPLICIT NONE                                                0534.000
  562. C                                                                       0535.000
  563. C= Send a filename packet and wait for reply                            0536.000
  564. C                                                                       0537.000
  565.       INCLUDE      K.KERMD                                              0538.000
  566.       INCLUDE      K.DBUGC                                              0539.000
  567.       INCLUDE      K.PROTC                                              0540.000
  568. C                                                                       0541.000
  569.       INTEGER      PTYP                                                 0542.000
  570.       INTEGER      NUM                                                  0543.000
  571. C                                                                       0544.000
  572.       INTEGER      RDPACK                                               0545.000
  573.       INTEGER      BUFFIL                                               0546.000
  574.       INTEGER      SLEN                                                 0547.000
  575. C                                                                       0548.000
  576. C                                                                       0549.000
  577. C have we tried this too many times?                                    0550.000
  578. C                                                                       0551.000
  579.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0552.000
  580.       NUMTRY = NUMTRY + 1                                               0553.000
  581.       IF (NUMTRY .GT. MAXRTRY) THEN                                     0554.000
  582.         SFILE = A                                                       0555.000
  583.         ABORTYP (TOOMANY) = .TRUE.                                      0556.000
  584.         ABORTYP(SENDING) = .TRUE.                                       0557.000
  585.         ABORTYP(FILERR) = .TRUE.                                        0558.000
  586.         RETURN                                                          0559.000
  587.       ENDIF                                                             0560.000
  588. C                                                                       0561.000
  589. C send a filename packet                                                0562.000
  590. C                                                                       0563.000
  591.       CALL SNDPACK(F, PACKNUM, SLEN(FILESTR), FILESTR)                  0564.000
  592. C                                                                       0565.000
  593. C check on the reply                                                    0566.000
  594. C                                                                       0567.000
  595.       PTYP = RDPACK(LEN, NUM, RECPACK)                                  0568.000
  596. X     WRITE(19,1000)LEN,NUM,PTYP                                        0568.100
  597. X1000 FORMAT(' 568.2** ',3(1X,1Z8))                                     0568.200
  598.       IF (PTYP .EQ. N) THEN                                             0569.000
  599.         IF (MOD(PACKNUM+1,64) .NE. NUM) THEN                            0570.000
  600.           SFILE = STATE                                                 0571.000
  601.           RETURN                                                        0572.000
  602.          ELSE                                                           0573.000
  603.           PTYP = Y                                                      0574.000
  604.           NUM = NUM - 1                                                 0575.000
  605.         ENDIF                                                           0576.000
  606.       ENDIF                                                             0577.000
  607.       IF (PTYP .EQ. Y) THEN                                             0578.000
  608.         IF (PACKNUM .NE. NUM) THEN                                      0579.000
  609.           SFILE = STATE                                                 0580.000
  610.           RETURN                                                        0581.000
  611.         ENDIF                                                           0582.000
  612.         TOTSDRC = TOTSDRC + 1                                           0583.000
  613.         NUMTRY = 0                                                      0584.000
  614.         PACKNUM = MOD(PACKNUM+1,64)                                     0585.000
  615. C                                                                       0586.000
  616. C get first packet of data from the file                                0587.000
  617. C                                                                       0588.000
  618.         PSIZE = BUFFIL(FFD, PACKET)                                     0589.000
  619.         SFILE = D                                                       0590.000
  620.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0591.000
  621.         SFILE = STATE                                                   0592.000
  622.       ELSE                                                              0593.000
  623.         SFILE = A                                                       0594.000
  624.         ABORTYP(INVALID) = .TRUE.                                       0595.000
  625.         ABORTYP(SENDING) = .TRUE.                                       0596.000
  626.         ABORTYP(FILERR) = .TRUE.                                        0597.000
  627.       ENDIF                                                             0598.000
  628.       RETURN                                                            0599.000
  629.       END                                                               0600.000
  630.       INTEGER FUNCTION SDATA()                                          0601.000
  631.            IMPLICIT NONE                                                0602.000
  632. C                                                                       0603.000
  633. C= Send a data packet and wait for reply                                0604.000
  634. C                                                                       0605.000
  635.       INCLUDE      K.KERMD                                              0606.000
  636.       INCLUDE      K.DBUGC                                              0607.000
  637.       INCLUDE      K.PROTC                                              0608.000
  638. C                                                                       0609.000
  639.       INTEGER      PTYP                                                 0610.000
  640.       INTEGER      NUM                                                  0611.000
  641.       INTEGER      LEN                                                  0612.000
  642. C                                                                       0613.000
  643.       INTEGER      RDPACK                                               0614.000
  644.       INTEGER      BUFFIL                                               0615.000
  645. C                                                                       0616.000
  646. C                                                                       0617.000
  647. C have we tried this too many times                                     0618.000
  648. C                                                                       0619.000
  649.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0620.000
  650.       NUMTRY = NUMTRY + 1                                               0621.000
  651.       IF (NUMTRY .GT. MAXRTRY) THEN                                     0622.000
  652.         SDATA = A                                                       0623.000
  653.         ABORTYP (TOOMANY) = .TRUE.                                      0624.000
  654.         ABORTYP(SENDING) = .TRUE.                                       0625.000
  655.         ABORTYP(DATAERR) = .TRUE.                                       0626.000
  656.         RETURN                                                          0627.000
  657.       ENDIF                                                             0628.000
  658. C                                                                       0629.000
  659. C send the current data buffer                                          0630.000
  660. C                                                                       0631.000
  661.       IF (PSIZE .EQ. EOF) THEN                                          0632.000
  662.         SDATA = Z                                                       0633.000
  663.         RETURN                                                          0634.000
  664.       ENDIF                                                             0635.000
  665. X     WRITE(19,1000)PACKNUM,PSIZE,LEN,PACKET                            0635.100
  666. X1000 FORMAT(' 635.2**',8(1X,1Z8))                                      0635.200
  667.       CALL SNDPACK(D, PACKNUM, PSIZE, PACKET)                           0636.000
  668. C                                                                       0637.000
  669. C check on the reply                                                    0638.000
  670. C                                                                       0639.000
  671.       PTYP = RDPACK(LEN, NUM, RECPACK)                                  0640.000
  672. X     WRITE(19,1001)LEN,NUM,PTYP                                        0640.100
  673. X1001 FORMAT(' 640.2** ',3(1X,1Z8))                                     0640.200
  674.       IF (PTYP .EQ. N) THEN                                             0641.000
  675.         IF (MOD(PACKNUM+1,64) .NE. NUM) THEN                            0642.000
  676.           SDATA = STATE                                                 0643.000
  677.           RETURN                                                        0644.000
  678.         ELSE                                                            0645.000
  679.           PTYP = Y                                                      0646.000
  680.           NUM = NUM - 1                                                 0647.000
  681.         ENDIF                                                           0648.000
  682.       ENDIF                                                             0649.000
  683.       IF (PTYP .EQ. Y) THEN                                             0650.000
  684.         IF (PACKNUM .NE. NUM) THEN                                      0651.000
  685.           SDATA = STATE                                                 0652.000
  686.           RETURN                                                        0653.000
  687.         ENDIF                                                           0654.000
  688.         TOTSDRC = TOTSDRC + 1                                           0655.000
  689.         NUMTRY = 0                                                      0656.000
  690.         PACKNUM = MOD (PACKNUM+1,64)                                    0657.000
  691.         PSIZE = BUFFIL(FFD, PACKET)                                     0658.000
  692.         IF (PSIZE .EQ. EOF) THEN                                        0659.000
  693.           SDATA = Z                                                     0660.000
  694.         ELSE                                                            0661.000
  695.           SDATA = STATE                                                 0662.000
  696.         ENDIF                                                           0663.000
  697.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0664.000
  698.         SDATA = STATE                                                   0665.000
  699.       ELSE                                                              0666.000
  700.         SDATA = A                                                       0667.000
  701.         ABORTYP(INVALID) = .TRUE.                                       0668.000
  702.         ABORTYP(SENDING) = .TRUE.                                       0669.000
  703.         ABORTYP(DATAERR) = .TRUE.                                       0670.000
  704.       ENDIF                                                             0671.000
  705.       RETURN                                                            0672.000
  706.       END                                                               0673.000
  707.       INTEGER FUNCTION SEOF()                                           0674.000
  708.            IMPLICIT NONE                                                0675.000
  709. C                                                                       0676.000
  710. C= Send an eof packet and wait for reply                                0677.000
  711. C                                                                       0678.000
  712.       INCLUDE      K.KERMD                                              0679.000
  713.       INCLUDE      K.DBUGC                                              0680.000
  714.       INCLUDE      K.PROTC                                              0681.000
  715. C                                                                       0682.000
  716.       INTEGER      PTYP                                                 0683.000
  717.       INTEGER      NUM                                                  0684.000
  718.       INTEGER      LEN                                                  0685.000
  719. C                                                                       0686.000
  720.       INTEGER      RDPACK                                               0687.000
  721. C                                                                       0688.000
  722. C                                                                       0689.000
  723. C have we tried this too many times                                     0690.000
  724. C                                                                       0691.000
  725.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0692.000
  726.       NUMTRY = NUMTRY + 1                                               0693.000
  727.       IF (NUMTRY .GT. MAXRTRY) THEN                                     0694.000
  728.         SEOF  = A                                                       0695.000
  729.         ABORTYP (TOOMANY) = .TRUE.                                      0696.000
  730.         ABORTYP(SENDING) = .TRUE.                                       0697.000
  731.         ABORTYP(EOFERR) = .TRUE.                                        0698.000
  732.         RETURN                                                          0699.000
  733.       ENDIF                                                             0700.000
  734. C                                                                       0701.000
  735. C send the eof packet                                                   0702.000
  736. C                                                                       0703.000
  737.       CALL SNDPACK(Z, PACKNUM, 0, 0)                                    0704.000
  738. C                                                                       0705.000
  739. C check the reply                                                       0706.000
  740. C                                                                       0707.000
  741.       PTYP = RDPACK(LEN, NUM, RECPACK)                                  0708.000
  742.       IF (PTYP .EQ. N) THEN                                             0709.000
  743.         IF (MOD(PACKNUM+1,64) .NE. NUM) THEN                            0710.000
  744.           SEOF = STATE                                                  0711.000
  745.           RETURN                                                        0712.000
  746.         ELSE                                                            0713.000
  747.           PTYP = Y                                                      0714.000
  748.           NUM = NUM -1                                                  0715.000
  749.         ENDIF                                                           0716.000
  750.       ENDIF                                                             0717.000
  751.       IF (PTYP .EQ. Y) THEN                                             0718.000
  752.         IF (PACKNUM .NE. NUM) THEN                                      0719.000
  753.           SEOF = STATE                                                  0720.000
  754.           RETURN                                                        0721.000
  755.         ENDIF                                                           0722.000
  756.         TOTSDRC = TOTSDRC + 1                                           0723.000
  757.         NUMTRY = 0                                                      0724.000
  758.         PACKNUM = MOD(PACKNUM+1,64)                                     0725.000
  759.         CALL CLOSE(FFD)                                                 0726.000
  760.         SEOF = B                                                        0727.000
  761.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0728.000
  762.         SEOF = STATE                                                    0729.000
  763.       ELSE                                                              0730.000
  764.         SEOF = A                                                        0731.000
  765.         ABORTYP(INVALID) = .TRUE.                                       0732.000
  766.         ABORTYP(SENDING) = .TRUE.                                       0733.000
  767.         ABORTYP(EOFERR) = .TRUE.                                        0734.000
  768.       ENDIF                                                             0735.000
  769.       RETURN                                                            0736.000
  770.       END                                                               0737.000
  771.       INTEGER FUNCTION SBREAK()                                         0738.000
  772.           IMPLICIT NONE                                                 0739.000
  773. C                                                                       0740.000
  774. C= Send the break packet and wait for reply                             0741.000
  775. C                                                                       0742.000
  776.       INCLUDE      K.KERMD                                              0743.000
  777.       INCLUDE      K.DBUGC                                              0744.000
  778.       INCLUDE      K.PROTC                                              0745.000
  779. C                                                                       0746.000
  780.       INTEGER      PTYP                                                 0747.000
  781.       INTEGER      NUM                                                  0748.000
  782.       INTEGER      LEN                                                  0749.000
  783. C                                                                       0750.000
  784.       INTEGER      RDPACK                                               0751.000
  785. C                                                                       0752.000
  786. C                                                                       0753.000
  787. C have we tried this too many times                                     0754.000
  788. C                                                                       0755.000
  789.       IF (NUMTRY .GT. 0) TOTRTRY = TOTRTRY + 1                          0756.000
  790.       NUMTRY = NUMTRY + 1                                               0757.000
  791.       IF (NUMTRY .GT. MAXRTRY) THEN                                     0758.000
  792.         SBREAK = A                                                      0759.000
  793.         ABORTYP (TOOMANY) = .TRUE.                                      0760.000
  794.         ABORTYP(SENDING) = .TRUE.                                       0761.000
  795.         ABORTYP(BRKERR) = .TRUE.                                        0762.000
  796.         RETURN                                                          0763.000
  797.       ENDIF                                                             0764.000
  798. C                                                                       0765.000
  799. C send the break packet                                                 0766.000
  800. C                                                                       0767.000
  801.       CALL SNDPACK(B, PACKNUM, 0, 0)                                    0768.000
  802. C                                                                       0769.000
  803. C check on the reply                                                    0770.000
  804. C                                                                       0771.000
  805.       PTYP = RDPACK(LEN, NUM, RECPACK)                                  0772.000
  806.       IF (PTYP .EQ. N) THEN                                             0773.000
  807.         IF (MOD(PACKNUM+1,64) .NE. NUM) THEN                            0774.000
  808.           SBREAK = STATE                                                0775.000
  809.           RETURN                                                        0776.000
  810.         ELSE                                                            0777.000
  811.           PTYP = Y                                                      0778.000
  812.           NUM = NUM - 1                                                 0779.000
  813.         ENDIF                                                           0780.000
  814.       ENDIF                                                             0781.000
  815.       IF (PTYP .EQ. Y) THEN                                             0782.000
  816.         IF (PACKNUM .NE. NUM) THEN                                      0783.000
  817.           SBREAK = STATE                                                0784.000
  818.           RETURN                                                        0785.000
  819.         ENDIF                                                           0786.000
  820.         TOTSDRC = TOTSDRC + 1                                           0787.000
  821.         NUMTRY = 0                                                      0788.000
  822.         PACKNUM = MOD(PACKNUM+1,64)                                     0789.000
  823.         SBREAK = C                                                      0790.000
  824.       ELSE IF (PTYP .EQ. ERROR) THEN                                    0791.000
  825.         SBREAK = STATE                                                  0792.000
  826.       ELSE                                                              0793.000
  827.         SBREAK = A                                                      0794.000
  828.         ABORTYP(INVALID) = .TRUE.                                       0795.000
  829.         ABORTYP(SENDING) = .TRUE.                                       0796.000
  830.         ABORTYP(BRKERR) = .TRUE.                                        0797.000
  831.       ENDIF                                                             0798.000
  832.       RETURN                                                            0799.000
  833.       END                                                               0800.000
  834.       SUBROUTINE MONSDRC(ISTATE)                                        0801.000
  835.            IMPLICIT NONE                                                0802.000
  836.            INTEGER   ISTATE                                             0803.000
  837. C                                                                       0804.000
  838. C= Monitor send or receive transaction                                  0805.000
  839. C                                                                       0806.000
  840.       INCLUDE K.KERMD                                                   0807.000
  841.       INCLUDE K.PROTC                                                   0808.000
  842.       INCLUDE      K.DBUGC                                              0809.000
  843. C                                                                       0810.000
  844.       IF (STDIN .NE. IFD) THEN                                          0811.000
  845.         CALL PUTC(STDOUT, CR)                                           0812.000
  846.         IF (DEBUG(DBGSTAT)) THEN                                        0813.000
  847.           CALL PRINT(STDOUT, 'State ')                                  0814.000
  848.           CALL PUTC(STDOUT, ISTATE)                                     0815.000
  849.         ENDIF                                                           0816.000
  850.         CALL PRINT(STDOUT, ' Receive ')                                 0817.000
  851.         CALL PUTINT(STDOUT, TOTSDRC, 3)                                 0818.000
  852.         CALL PRINT(STDOUT, ' Retry ')                                   0819.000
  853.         CALL PUTINT(STDOUT, TOTRTRY, 3)                                 0820.000
  854.         CALL FLUSH(STDOUT)                                              0821.000
  855.       ENDIF                                                             0822.000
  856.       RETURN                                                            0823.000
  857.       END                                                               0824.000
  858.