home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / gould3.tar.gz / gould3.tar / kermit3 < prev    next >
Text File  |  2011-08-09  |  41KB  |  510 lines
  1. *     BASE -ULTLY-KERM -SFM-A2703 - 08/01/90  WJH     HEADER  SFMKERM   0001.000
  2.       SUBROUTINE SNDPACK(TYPE, NUM, LEN, DATA)                          0001.100
  3.            IMPLICIT NONE                                                0002.000
  4.            INTEGER   TYPE          !type of packet                      0003.000
  5.            INTEGER   NUM           !packet number                       0004.000
  6.            INTEGER   LEN           !length of packet                    0005.000
  7.            INTEGER   DATA(LEN)     !packet to send                      0006.000
  8.            INTEGER   LEN1                                               0006.100
  9.            INTEGER   LEN2                                               0006.200
  10.            INTEGER   LENP6                                              0006.300
  11.            INTEGER   CHCKSM                                             0006.400
  12. C                                                                       0007.000
  13. C= Send a packet down an output stream                                  0008.000
  14. C                                                                       0009.000
  15. C  Sndpack will send a packet of information and log it                 0010.000
  16. C  if debug is turned on.  This subroutine could be made                0011.000
  17. C  more efficient by not calling a subroutine for each                  0012.000
  18. C  character, but that might cause portability problems.                0013.000
  19. C                                                                       0014.000
  20.       INCLUDE      K.KERMD                                              0015.000
  21.       INCLUDE      K.DBUGC                                              0016.000
  22.       INCLUDE      K.PROTC                                              0017.000
  23.       INCLUDE      K.PACKC                                              0018.000
  24. C                                                                       0019.000
  25.       INTEGER      I                                                    0020.000
  26.       INTEGER      CHKSUM          ! com puted checksum                 0021.000
  27.       INTEGER      TMP                                                  0022.000
  28.       INTEGER      NCH             !number of characters                0023.000
  29. C                                                                       0024.000
  30.       INTEGER      TOCHAR                                               0025.000
  31.       INTEGER      CHKSUMER      !find checksum                         0026.000
  32. C                                                                       0027.000
  33.       IF (DEBUG(DBGPACK)) THEN                                          0028.000
  34.         CALL PRINTL(DBGFD, 'Sending...')                                0029.000
  35.       ENDIF                                                             0030.000
  36. C                                                                       0031.000
  37. C put out pad chars                                                     0032.000
  38. C                                                                       0033.000
  39.       DO I=1, SPAD                                                      0034.000
  40.         CALL PUTC(OFD, SPADCH)                                          0035.000
  41.         IF (DEBUG(DBGPACK)) THEN                                        0036.000
  42.           CALL PUTC(DBGFD, SPADCH)                                      0037.000
  43.         ENDIF                                                           0038.000
  44.       ENDDO                                                             0039.000
  45.       CALL PUTC(OFD, SNDSYNC)                                           0040.000
  46. C                                                                       0041.000
  47. C packet len assumes one character checksums                            0042.000
  48. C                                                                       0043.000
  49.       LENP6 = LEN                                                       0043.010
  50.       IF((LENP6).GT.95)THEN                                             0043.100
  51.        LEN1  =  (LENP6)/95                                              0043.200
  52.        LEN2  =  (LENP6) - LEN1*95 + 1                                   0043.300
  53.        CHKSUM=  2Z20                                                    0043.400
  54.       ELSE                                                              0043.500
  55.         CHKSUM = TOCHAR(LEN+3)                                          0044.000
  56.       ENDIF                                                             0044.100
  57.       CALL PUTC(OFD, CHKSUM)                                            0045.000
  58.       TMP = TOCHAR(NUM)                                                 0046.000
  59.       CHKSUM = CHKSUM + TMP                                             0047.000
  60.       CALL PUTC(OFD, TMP)                                               0048.000
  61.       CHKSUM = CHKSUM + TYPE                                            0049.000
  62.       CALL PUTC(OFD, TYPE)                                              0050.000
  63.       IF(LENP6.GT.95)THEN                                               0050.100
  64.         TMP = TOCHAR(LEN1)                                              0050.110
  65.         CHKSUM = CHKSUM + TMP                                           0050.120
  66.         CALL PUTC(OFD,TMP)                                              0050.200
  67.         TMP = TOCHAR(LEN2)                                              0050.210
  68.         CHKSUM = CHKSUM + TMP                                           0050.220
  69.         CALL PUTC(OFD,TMP)                                              0050.300
  70.         CHCKSM = CHKSUMER(CHKSUM) + 2Z20                                0050.310
  71.         CALL PUTC(OFD,CHCKSM)                                           0050.400
  72.         CHKSUM = CHKSUM + CHCKSM                                        0050.410
  73.       ENDIF                                                             0050.500
  74.       DO I=1, LEN                                                       0051.000
  75.         CHKSUM = CHKSUM + DATA(I)                                       0052.000
  76.         CALL PUTC(OFD, DATA(I))                                         0053.000
  77.       ENDDO                                                             0054.000
  78.       CHKSUM = CHKSUMER(CHKSUM)                                         0055.000
  79.       CALL PUTC(OFD, TOCHAR(CHKSUM))                                    0056.000
  80.       CALL PUTC(OFD, SPEOL)                                             0057.000
  81.       IF (DEBUG(DBGPACK)) THEN                                          0058.000
  82.         CALL PUTC(DBGFD, SNDSYNC)                                       0059.000
  83.         CALL PUTC(DBGFD, TOCHAR(LEN+3))                                 0060.000
  84.         CALL PUTC(DBGFD, TOCHAR(NUM))                                   0061.000
  85.         CALL PUTC(DBGFD, TYPE)                                          0062.000
  86.         IF (LEN .GT. 0) CALL PUTSTR(DBGFD, DATA)                        0063.000
  87.         CALL PUTC(DBGFD, TOCHAR(CHKSUM))                                0064.000
  88.         CALL PUTC(DBGFD, SPEOL)                                         0065.000
  89.         CALL FLUSH(DBGFD)                                               0066.000
  90.       ENDIF                                                             0067.000
  91. C                                                                       0068.000
  92. C force buffer flush since desired eol char won't                       0069.000
  93. C                                                                       0070.000
  94.       CALL FLUSH(OFD)                                                   0071.000
  95. C                                                                       0072.000
  96. C update the statistics                                                 0073.000
  97. C                                                                       0074.000
  98.       NCH = SPAD + 5 + LEN + 1                                          0075.000
  99.       SCHCNT = SCHCNT + NCH                                             0076.000
  100.       SCHOVRH = SCHOVRH + NCH - LEN                                     0077.000
  101.       RETURN                                                            0078.000
  102.       END                                                               0079.000
  103.       INTEGER FUNCTION RDPACK(LEN, NUM, DATA)                           0080.000
  104.            IMPLICIT NONE                                                0081.000
  105.            INTEGER   LEN           !length of packet read               0082.000
  106.            INTEGER   NUM           !packet number                       0083.000
  107.            INTEGER   DATA(*)       !data read                           0084.000
  108. C                                                                       0085.000
  109. C= Read a packet of information                                         0086.000
  110.       INCLUDE      K.KERMD                                              0087.000
  111.       INCLUDE      K.DBUGC                                              0088.000
  112.       INCLUDE      K.PROTC                                              0089.000
  113.       INCLUDE      K.PACKC                                              0090.000
  114.       LOGICAL      BREAK                                                0091.000
  115.       COMMON /BREAK/BREAK                                               0092.000
  116. C                                                                       0093.000
  117.       INTEGER      CHKSUM                                               0094.000
  118.       INTEGER      FIELD                                                0095.000
  119.       INTEGER      NCH                                                  0096.000
  120.       INTEGER      CH                                                   0097.000
  121.       INTEGER      TYPE                                                 0098.000
  122.       INTEGER      I                                                    0099.000
  123.       INTEGER      STIME           !start time                          0100.000
  124.       INTEGER      FTIME           !finish time                         0101.000
  125. C                                                                       0102.000
  126.       INTEGER      GETC                                                 0103.000
  127.       INTEGER      UNCHAR                                               0104.000
  128.       INTEGER      CHKSUMER      !compute checksum                      0105.000
  129.       INTEGER      LEN1,LEN2                                            0105.100
  130.       INTEGER      LOOPF                                                0105.200
  131.       INTEGER      LPK                                                  0105.300
  132. C                                                                       0106.000
  133. C debug                                                                 0107.000
  134. C                                                                       0108.000
  135.       IF (DEBUG(DBGPACK)) THEN                                          0109.000
  136.         CALL PRINTL(DBGFD, 'Reading...')                                0110.000
  137.       ENDIF                                                             0111.000
  138.       NCH = 0                                                           0112.000
  139. C                                                                       0113.000
  140. C hunt for start of packet                                              0114.000
  141. C                                                                       0115.000
  142.       LEN = 0                                                           0116.000
  143.       LOOPF = 0                                                         0116.100
  144.       CHKSUM = 0                                                        0117.000
  145.       CALL MSEC(STIME)                                                  0118.000
  146.       BREAK = .FALSE.                                                   0119.000
  147.  10   CONTINUE                                                          0120.000
  148.       CALL MSEC(FTIME)                                                  0121.000
  149.       IF ((FTIME-STIME)/1000 .GT. TIMEOUT .OR. BREAK) THEN              0122.000
  150.         IF (DEBUG(DBGPACK)) THEN                                        0123.000
  151.           IF (BREAK) THEN                                               0124.000
  152.             CALL PRINTL(DBGFD, 'BREAK TIMEOUT')                         0125.000
  153.           ELSE                                                          0126.000
  154.             CALL PRINTL(DBGFD, 'TIMEOUT')                               0127.000
  155.           ENDIF                                                         0128.000
  156.         ENDIF                                                           0129.000
  157.         RDPACK = ERROR                                                  0130.000
  158.         GOTO 30       !RETURN                                           0131.000
  159.       ENDIF                                                             0132.000
  160.       CH = GETC(IFD, CH)                                                0133.000
  161.       IF (DEBUG(DBGPACK)) CALL PUTC(DBGFD, CH)                          0134.000
  162.       IF (CH .EQ. ERROR) THEN                                           0135.000
  163.         GOTO 10                                                         0136.000
  164.       ENDIF                                                             0137.000
  165.       NCH = NCH + 1                                                     0138.000
  166. CLT   IF (DEBUG(DBGPACK)) CALL PUTC(DBGFD, CH)                          0139.000
  167.       IF (CH .NE. SYNC) GOTO 10                                         0140.000
  168.       CALL MSEC(STIME)                                                  0140.100
  169. C                                                                       0141.000
  170. C parse each field of the packet                                        0142.000
  171. C                                                                       0143.000
  172.       FIELD = 1                                                         0144.000
  173.  20   CONTINUE                                                          0145.000
  174.       CALL MSEC(FTIME)                                                  0146.000
  175.       IF ((FTIME-STIME)/1000 .GT. TIMEOUT .OR. BREAK) THEN              0147.000
  176.         RDPACK = ERROR                                                  0148.000
  177. X             WRITE(19,1481)FTIME,STIME,TIMEOUT ,I                      0148.100
  178. X1481         FORMAT(' 1481** ',4(1X,1Z8))                              0148.200
  179.         GOTO 30       !RETURN                                           0149.000
  180.       ENDIF                                                             0150.000
  181. 21    IF (FIELD .LE. (5+LOOPF)) THEN                                    0151.000
  182. C                                                                       0152.000
  183. C a character read in field 4 here is the first char of the             0153.000
  184. C data field or the checksum character if the data field is             0154.000
  185. C empty                                                                 0155.000
  186. C                                                                       0156.000
  187.         IF (FIELD .NE. (5+LOOPF) .OR. LEN .GT. 0) THEN                  0157.000
  188.           IF (GETC(IFD, CH) .EQ. SYNC) FIELD = 0                        0158.000
  189.           NCH = NCH + 1                                                 0159.000
  190.           IF (DEBUG(DBGPACK)) CALL PUTC(DBGFD, CH)                      0160.000
  191.         ENDIF                                                           0161.000
  192.         IF (FIELD .LE.  3        ) CHKSUM = CHKSUM + CH                 0162.000
  193. C                                                                       0163.000
  194. C if resync                                                             0164.000
  195. C                                                                       0165.000
  196.         IF (FIELD .EQ. 0) THEN                                          0166.000
  197.           CHKSUM = 0                                                    0167.000
  198.           IF (DEBUG(DBGPACK)) THEN                                      0168.000
  199.             CALL PRINTL(DBGFD, 'Reading...')                            0169.000
  200.             CALL PUTC(DBGFD, SYNC)                                      0170.000
  201.           ENDIF                                                         0171.000
  202. C                                                                       0172.000
  203. C if data length                                                        0173.000
  204. C                                                                       0174.000
  205.         ELSE IF (FIELD .EQ. 1) THEN                                     0175.000
  206.           IF(CH.EQ.2Z20)THEN                                            0175.100
  207.              LEN = 0                                                    0175.200
  208.              LPK = 1                                                    0175.210
  209.           ELSE                                                          0175.300
  210.              LEN = UNCHAR(CH-3)                                         0176.000
  211.              LPK = 0                                                    0176.010
  212.           ENDIF                                                         0176.100
  213. C                                                                       0177.000
  214. C if pack number                                                        0178.000
  215. C                                                                       0179.000
  216.         ELSE IF (FIELD .EQ. 2) THEN                                     0180.000
  217.           NUM = UNCHAR(CH)                                              0181.000
  218. C                                                                       0182.000
  219. C if packet type                                                        0183.000
  220. C                                                                       0184.000
  221.         ELSE IF (FIELD .EQ. 3) THEN                                     0185.000
  222.           TYPE = CH                                                     0186.000
  223.         ELSE IF (FIELD .EQ. 4 .AND. LPK .EQ. 1) THEN                    0186.100
  224.            CHKSUM = CHKSUM + CH                                         0186.200
  225.            LOOPF = 3                                                    0186.220
  226.            LEN1 = UNCHAR(CH)*95                                         0186.230
  227.         ELSE IF (FIELD .EQ. 5 .AND. LPK .EQ. 1) THEN                    0186.300
  228.            CHKSUM = CHKSUM + CH                                         0186.301
  229.            LEN2 = UNCHAR(CH)                                            0186.310
  230.            LEN  = LEN1 + LEN2  - 1                                      0186.400
  231.            IF(LEN.GT.MAXPACK)THEN                                       0186.410
  232.              RDPACK = ERROR                                             0186.420
  233.              GO TO 30                                                   0186.430
  234.            ENDIF                                                        0186.440
  235.         ELSE IF (FIELD .EQ. 6 .AND. LPK .EQ. 1) THEN                    0186.500
  236.            CHKSUM = CHKSUM + CH                                         0186.600
  237. C                                                                       0187.000
  238. C if data field is not empty                                            0188.000
  239. C                                                                       0189.000
  240.         ELSE IF (FIELD .EQ. (4+LOOPF) .AND. LEN .GT. 0) THEN            0190.000
  241. C                                                                       0191.000
  242. C read 2nd-len chars of data áchecksum char                            0192.000
  243. C                                                                       0193.000
  244. X     WRITE(19,1002)LEN,LEN1,LEN2,FIELD,LOOPF,CHKSUM                    0193.100
  245. X1002 FORMAT(' 1932** ',6(1X,1Z8))                                      0193.200
  246.           DO I=1, LEN                                                   0194.000
  247.             CALL MSEC(FTIME)                                            0195.000
  248.             IF ((FTIME-STIME)/1000 .GT. TIMEOUT .OR. BREAK) THEN        0196.000
  249.               RDPACK = ERROR                                            0197.000
  250. X             WRITE(19,1971)FTIME,STIME,TIMEOUT ,I                      0197.100
  251. X1971         FORMAT(' 1971** ',4(1X,1Z8))                              0197.200
  252.               GOTO 30       !RETURN                                     0198.000
  253.             ENDIF                                                       0199.000
  254.             IF (I .GT. 1) THEN                                          0200.000
  255.               CH = GETC(IFD, CH)                                        0201.000
  256.               NCH = NCH + 1                                             0202.000
  257. C             IF (CH .EQ. SYNC) THEN                                    0203.000
  258. C               FIELD = 0                                               0204.000
  259. C               CALL MSEC(STIME)                                        0204.100
  260. C               WRITE(19,2041)LEN,LEN1,LEN2,CH,SYNC,STIME,I             0204.200
  261. C2041           FORMAT(' 2041**  ',7(1X,1Z8))                           0204.300
  262. C               GOTO 20                                                 0205.000
  263. C             ENDIF                                                     0206.000
  264. C             IF (DEBUG(DBGPACK)) CALL PUTC(DBGFD, CH)                  0207.000
  265.             ENDIF                                                       0208.000
  266.             CHKSUM = CHKSUM + CH                                        0209.000
  267.             DATA (I) = CH                                               0210.000
  268.           ENDDO                                                         0211.000
  269.           FIELD = FIELD + 1                                             0211.100
  270.           GO TO 21                                                      0211.200
  271. C                                                                       0212.000
  272. C if chksum char                                                        0213.000
  273. C                                                                       0214.000
  274.         ELSE IF (FIELD .EQ. (5+LOOPF)) THEN                             0215.000
  275.           DATA(LEN+1) = 0                                               0216.000
  276. X         WRITE(19,2161)CHKSUM                                          0216.100
  277. X2161     FORMAT(' CHKSUM = ',1Z8)                                      0216.200
  278.           CHKSUM = CHKSUMER(CHKSUM)                                     0217.000
  279.         ENDIF                                                           0218.000
  280. C                                                                       0219.000
  281. C process next packet field                                             0220.000
  282. C                                                                       0221.000
  283.         FIELD = FIELD + 1                                               0222.000
  284. X       WRITE(19,1005)FIELD,LEN,LOOPF,CH,CHKSUM                         0222.100
  285. X1005   FORMAT(' 2222** ',5(1X,1Z8))                                    0222.200
  286.         GOTO 20                                                         0223.000
  287.       ENDIF                                                             0224.000
  288.       IF (DEBUG(DBGPACK)) CALL PUTC(DBGFD, NEL)                         0225.000
  289. C                                                                       0226.000
  290. C does the checksum match                                               0227.000
  291. C                                                                       0228.000
  292.       IF (CHKSUM .NE. UNCHAR(CH)) THEN                                  0229.000
  293. X       WRITE(19,2291)LEN,NCH,CHKSUM,CH                                 0229.100
  294. X2291   FORMAT(' 2291**  ',4(1X,1Z8))                                   0229.200
  295. X       WRITE(19,2292)(  DATA(I),I=1,LEN)                               0229.300
  296. X2292   FORMAT(1X,19A4)                                                 0229.400
  297.         RDPACK = ERROR                                                  0230.000
  298.         RCHOVRH = RCHOVRH + NCH                                         0231.000
  299.         IF (DEBUG(DBGON)) THEN                                          0232.000
  300.           CALL PRINTL(DBGFD, 'chksum error, found ')                    0233.000
  301.           CALL PUTINT(DBGFD, UNCHAR(CH), 1)                             0234.000
  302.           CALL PRINT(DBGFD, ' needed ')                                 0235.000
  303.           CALL PUTINT(DBGFD, CHKSUM, 1)                                 0236.000
  304.         ENDIF                                                           0237.000
  305.       ELSE                                                              0238.000
  306. X       WRITE(19,2381)LEN,NCH,CHKSUM,CH                                 0238.100
  307. X2381   FORMAT(' 2381**  ',4(1X,1Z8))                                   0238.200
  308.         RDPACK = TYPE                                                   0239.000
  309.         RCHOVRH = RCHOVRH + NCH - LEN                                   0240.000
  310.       ENDIF                                                             0241.000
  311.       RCHCNT = RCHCNT + NCH                                             0242.000
  312. C                                                                       0243.000
  313. C flush any eol characters and other garbage                            0244.000
  314. C                                                                       0245.000
  315.       CALL FLUSH(IFD)                                                   0246.000
  316.  30   CONTINUE     !error exit                                          0247.000
  317.       IF (DEBUG(DBGON)) THEN                                            0248.000
  318.         CALL FLUSH(DBGFD)                                               0249.000
  319.       ENDIF                                                             0250.000
  320.       RETURN                                                            0251.000
  321.       END                                                               0252.000
  322.       INTEGER FUNCTION BUFFIL(FD, BUFFER)                               0253.000
  323.            IMPLICIT NONE                                                0254.000
  324.            INTEGER   FD            !file device                         0255.000
  325.            INTEGER   BUFFER(*)     !buffer to fill                      0256.000
  326. C                                                                       0257.000
  327. C= Get some data to send.                                               0258.000
  328. C                                                                       0259.000
  329. C BUFFIL READS FROM THE FILE TO SEND AND PERFORMS ALL                   0260.000
  330. C THE PROPER ESCAPING OF CONTROL CHARACTERS AND MAPPING                 0261.000
  331. C NEWLINES INTO CRLF SEQUENCES.  IF IT EVER GETS SMART                  0262.000
  332. C ENOUGH, IT WILL ALSO DO THE 8 BIT QUOTING AND REPEAT                  0263.000
  333. C COUNTS.                                                               0264.000
  334. C                                                                       0265.000
  335. C *** NOTE: THIS ALGORTHM ASSUMES 5 OVERHEAD CHARACTERS FOR THE         0266.000
  336. C PACKET AND LEAVES 3 CHARACTERS IN CASE THE LAST CHARACTER TO          0267.000
  337. C BUFFER IS A NEL (EXPANDS TO 4 CHARACTERS).                            0268.000
  338.       INCLUDE      K.KERMD                                              0269.000
  339.       INCLUDE      K.DBUGC                                              0270.000
  340.       INCLUDE      K.PROTC                                              0271.000
  341.       INCLUDE      K.PACKC                                              0272.000
  342. C                                                                       0273.000
  343.       INTEGER      I                                                    0274.000
  344.       INTEGER      CH                                                   0275.000
  345.       INTEGER      X18 /X'18'/                                          0276.000
  346.       INTEGER      X50 /X'50'/                                          0277.000
  347.       INTEGER      TEMPCH,TEMPCH1,TEMPCH2                               0278.000
  348.       INTEGER      FIEND /X'A0'/                                        0279.000
  349. C                                                                       0280.000
  350.       INTEGER      GETC                                                 0281.000
  351.       INTEGER      CTL             !control switch                      0282.000
  352. C                                                                       0283.000
  353. C                                                                       0284.000
  354. C get a packet worth of data                                            0285.000
  355. C                                                                       0286.000
  356.       I = 0                                                             0287.000
  357. X     WRITE(19,1000)SPKSIZ                                              0287.100
  358. X1000 FORMAT(' 2873**' 1X,1Z8)                                          0287.200
  359.  10   CONTINUE                                                          0288.000
  360. C       READ A CHARACTER FROM THE FILE TO BE TRANSFERRED                0289.000
  361.       TEMPCH = GETC(FD, CH)                                             0290.000
  362.       IF (TEMPCH .NE. EOF) THEN                                         0291.000
  363.         IF (CH .LT. BLANK .OR. CH .EQ. DEL .OR. CH .EQ. NEL .OR.        0292.000
  364.      $      CH .EQ. SPQUOTE) THEN                                       0293.000
  365.           IF (CH .EQ. NEL) THEN                                         0294.000
  366.             BUFFER(I+1) = SPQUOTE                                       0295.000
  367.             BUFFER(I+2) = CTL(CR)                                       0296.000
  368.             I = I + 2                                                   0297.000
  369.             CH = LF                                                     0298.000
  370.           ENDIF                                                         0299.000
  371.           I = I + 1                                                     0300.000
  372.           BUFFER(I) = SPQUOTE                                           0301.000
  373.           IF (CH .NE. SPQUOTE) CH = CTL(CH)                             0302.000
  374.         ENDIF                                                           0303.000
  375.         I = I + 1                                                       0304.000
  376. C     Put the character into the Output Buffer                          0305.000
  377.         BUFFER(I) = CH                                                  0306.000
  378.         IF (I .GE. SPKSIZ-10) THEN                                      0307.000
  379.           BUFFIL = I                                                    0308.000
  380.           GOTO 99                                                       0309.000
  381.         ENDIF                                                           0310.000
  382.         GOTO 10                                                         0311.000
  383.       ENDIF                                                             0312.000
  384.  90   IF (I .EQ. 0) THEN                                                0313.000
  385.         BUFFIL = EOF                                                    0314.000
  386.       ELSE                                                              0315.000
  387.         BUFFIL = I                                                      0316.000
  388.       ENDIF                                                             0317.000
  389.  99   CONTINUE                                                          0318.000
  390. C    Check for END OF BLOCK                                             0319.000
  391.         IF (BUFFER(I).EQ.X50.AND.BUFFER(I-1).EQ.X'20') THEN             0320.000
  392.            TEMPCH = GETC(FD,CH)                                         0321.000
  393.            IF (CH.EQ.0) THEN                                            0322.000
  394.               BUFFER(I-1) = LF                                          0323.000
  395.               BUFFER(I)   = 0                                           0324.000
  396.               I = I - 1                                                 0325.000
  397.               ELSE                                                      0326.000
  398.                  I = I + 1                                              0327.000
  399.                  BUFFER(I) = CH                                         0328.000
  400.             END IF                                                      0329.000
  401.             BUFFIL = I                                                  0330.000
  402.          END IF                                                         0331.000
  403. C           IF (BUFFER(I).EQ.X'20') THEN                                0332.000
  404. C              TEMPCH1 = GETC(FD,CH)                                    0333.000
  405. C              IF (TEMPCH1.EQ.X50) THEN                                 0334.000
  406. C                 TEMPCH2 = GETC(FD,CH)                                 0335.000
  407. C                 IF (TEMPCH2.EQ.0) THEN                                0336.000
  408. C                    BUFFER(I) = LF                                     0337.000
  409. C                   ELSE                                                0338.000
  410. C                    BUFFER(I+1) = TEMPCH1                              0339.000
  411. C                    BUFFER(I+2) = TEMPCH2                              0340.000
  412. C                    I = I + 2                                          0341.000
  413. C                  END IF                                               0342.000
  414. C                 ELSE                                                  0343.000
  415. C                  I = I + 1                                            0344.000
  416. C                  BUFFER(I) = CH                                       0345.000
  417. C               END IF                                                  0346.000
  418. C            END IF                                                     0347.000
  419. C         END IF                                                        0348.000
  420.       BUFFER(I+1) = 0                                                   0349.000
  421.       RETURN                                                            0350.000
  422.       END                                                               0351.000
  423.       SUBROUTINE BUFEMP( BUFFER, FD, LEN)                               0352.000
  424.            IMPLICIT NONE                                                0353.000
  425.            INTEGER  BUFFER(*)      !buffer to empty                     0354.000
  426.            INTEGER  FD             !file descriptor                     0355.000
  427.            INTEGER  LEN            !length of buffer to empty           0356.000
  428. C                                                                       0357.000
  429. C= dumps a buffer to a file                                             0358.000
  430. C                                                                       0359.000
  431.       INCLUDE      K.KERMD                                              0360.000
  432.       INCLUDE      K.DBUGC                                              0361.000
  433.       INCLUDE      K.PROTC                                              0362.000
  434.       INCLUDE      K.PACKC                                              0363.000
  435. C                                                                       0364.000
  436.       INTEGER      I,J                                                  0365.000
  437.       INTEGER      PREVCH                                               0366.000
  438.       INTEGER      CH                                                   0367.000
  439. C                                                                       0368.000
  440.       INTEGER      CTL                                                  0369.000
  441.       INTEGER      CHN                                                  0369.100
  442. C                                                                       0370.000
  443. C                                                                       0371.000
  444. C write the packet data to the file                                     0372.000
  445. C                                                                       0373.000
  446. X     WRITE(19,1000)QUOTECH,CR,LF,LEN                                   0373.100
  447. X1000 FORMAT(' 3732** ',4(1X,1Z8))                                      0373.200
  448. X     WRITE(19,1001)BUFFER                                              0373.300
  449. X1001 FORMAT(1X,80A4)                                                   0373.400
  450.       I = 1                                                             0374.000
  451.  10   CONTINUE                                                          0375.000
  452.       IF (I .LE. LEN) THEN                                              0376.000
  453.         CH = BUFFER(I)                                                  0377.000
  454.         IF (CH .EQ. QUOTECH) THEN                                       0378.000
  455.           I = I + 1                                                     0379.000
  456.           CH = BUFFER(I)                                                0380.000
  457.           IF (CH .EQ. RPREFIX)THEN                                      0380.100
  458.              CONTINUE                                                   0380.200
  459.           ELSE IF (CH .NE. QUOTECH) THEN                                0381.000
  460.              CH = CTL(CH)                                               0381.010
  461.           ENDIF                                                         0381.020
  462.         ELSE IF(CH .EQ. RPREFIX)THEN                                    0381.100
  463.           I = I + 1                                                     0381.110
  464.           CH = BUFFER(I)                                                0381.120
  465.             CHN = CH - 2Z21                                             0381.800
  466.             I = I + 1                                                   0381.900
  467.             CH = BUFFER(I)                                              0381.910
  468.             IF(CH.EQ.QUOTECH)THEN                                       0381.911
  469.               I = I + 1                                                 0381.912
  470.               CH = BUFFER(I)                                            0381.913
  471.             ENDIF                                                       0381.914
  472.             DO J =1,CHN                                                 0381.920
  473.               CALL PUTC(FD,CH)                                          0381.930
  474.             ENDDO                                                       0381.940
  475.         ENDIF                                                           0382.000
  476. C                                                                       0383.000
  477. C convert cr/lf pair to NEL                                             0384.000
  478. C                                                                       0385.000
  479.         IF (CH .EQ. LF .AND. PREVCH .EQ. CR) THEN                       0386.000
  480.           CH = NEL                                                      0387.000
  481. C                                                                       0388.000
  482. C just a lone cr                                                        0389.000
  483. C                                                                       0390.000
  484.         ELSE IF (PREVCH .EQ. CR) THEN                                   0391.000
  485.           CALL PUTC(FD, PREVCH)                                         0392.000
  486.         ENDIF                                                           0393.000
  487.         IF (CH .NE. CR) CALL PUTC(FD, CH)                               0394.000
  488.         PREVCH = CH                                                     0395.000
  489.         I = I + 1                                                       0396.000
  490.         GOTO 10                                                         0397.000
  491.       ENDIF                                                             0398.000
  492.       RETURN                                                            0399.000
  493.       END                                                               0400.000
  494.       INTEGER FUNCTION CHKSUMER (SUM)                                   0401.000
  495.            IMPLICIT NONE                                                0402.000
  496.            INTEGER   SUM      !sum to find check sum of                 0403.000
  497. C                                                                       0404.000
  498. C= Compute checksum for transmission                                    0405.000
  499. C                                                                       0406.000
  500.       INTEGER      HIGHBITS/X'C0'/  !mask for high bits                 0407.000
  501.       INTEGER      SHIFTLOW /X'40'/ !make them low bits                 0408.000
  502.       INTEGER      SIXBITS /X'3F'/  !return only six bits               0409.000
  503. C                                                                       0410.000
  504.       INTEGER      IAND            !and words together                  0411.000
  505. C                                                                       0412.000
  506.       CHKSUMER = IAND (SUM + IAND (SUM,HIGHBITS) / SHIFTLOW,            0413.000
  507.      $           SIXBITS)                                               0414.000
  508.       RETURN                                                            0415.000
  509.       END                                                               0416.000
  510.