home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / e / kerboo.for < prev    next >
Text File  |  2020-01-01  |  7KB  |  305 lines
  1. C     SIMPLE KERMIT BOOT PROGRAM
  2. C
  3. C     WRITTEN BY: JIM LEWINSON;  BREUER & COMPANY  (JIML@SCORE.ARPA)
  4. C
  5. C     VERSION 1.0(25)  9-JUL-84
  6. C
  7.       INTEGER SEQNUM,RETRY,STATE,TYPE,NEWLEN,NEWSEQ
  8.       INTEGER DATA(256),OUTDAT(256)
  9.       INTEGER TOCHAR,UNCHAR,CTL
  10.       INTEGER STATEI,STATEF,STATED,STATEB,STATEA
  11.       INTEGER DLET,YLET,NLET,SLET,BLET,FLET,ZLET,ELET,TLET
  12.       INTEGER MYQUO,FILOPN,FILLIN(512),FILPTR
  13.       LOGICAL*1 FILNAM(40)
  14. C
  15.       FILOPN = 0
  16.       SEQNUM = 0
  17.       RETRY = 0
  18.       STATEI = 1
  19.       STATEF = 2
  20.       STATED = 3
  21.       STATEB = 4
  22.       STATEA = 5
  23. C
  24.       DLET = 68
  25.       YLET = 89
  26.       NLET = 78
  27.       SLET = 83
  28.       BLET = 66
  29.       FLET = 70
  30.       ZLET = 90
  31.       ELET = 69
  32.       TLET = 84
  33.       MYQUO = 35
  34. C
  35.       STATE = STATEI
  36. C
  37. 1000  CONTINUE
  38. CDBG        WRITE (2,1001) STATE
  39. CDBG  1001  FORMAT (' STATE NOW IS ',I4)
  40.       IF (STATE.EQ.STATEI) GO TO 2000
  41.       IF (STATE.EQ.STATEF) GO TO 3000
  42.       IF (STATE.EQ.STATED) GO TO 4000
  43.       IF (STATE.EQ.STATEA) GO TO 5000
  44.       GO TO 8000
  45. C
  46. C     SEND AN ACK
  47. 1100  CALL SNDPAK(0,SEQNUM,'Y',OUTDAT)
  48.       GO TO 1000
  49. C
  50. C     SEND AN ACK AND INC SEQ NUMBER
  51. 1200  CALL SNDPAK(0,SEQNUM,'Y',OUTDAT)
  52.       SEQNUM = MOD(SEQNUM+1,64)
  53.       RETRY = 0
  54.       GO TO 1000
  55. C
  56. C     SEND A NAK
  57. 1300  CALL SNDPAK(0,SEQNUM,'N',OUTDAT)
  58.       GO TO 1000
  59. C
  60. C     REPLY TO AN SEND-INIT PACKET
  61. 1400  SEQNUM = 0
  62.       RETRY = 0
  63.       OUTDAT(1) = TOCHAR(60)
  64.       OUTDAT(2) = TOCHAR(10)
  65.       OUTDAT(3) = TOCHAR(0)
  66.       OUTDAT(4) = ' '
  67.       OUTDAT(5) = TOCHAR(13)
  68.       OUTDAT(6) = MYQUO
  69.       OUTDAT(7) = 'N'
  70.       OUTDAT(8) = '1'
  71.       OUTDAT(9) = ' '
  72.       OUTDAT(10) = ' '
  73.       CALL SNDPAK(10,SEQNUM,'Y',OUTDAT)
  74.       STATE = STATEF
  75.       SEQNUM = MOD(SEQNUM+1,64)
  76.       RETRY = 0
  77.       GO TO 1000
  78. C
  79. C     STATE S - AWAIT SEND-INIT
  80. 2000  SEQNUM = 0
  81.       RETRY = 0
  82.       CALL GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
  83.       IF (NEWLEN.LT.0) GO TO 2800
  84.       IF (TYPE.NE.SLET) GO TO 2800
  85.       GO TO 1400
  86. C
  87. 2800  RETRY = RETRY + 1
  88.       GO TO 1300
  89. C
  90. C     STATE F - AWAIT FILE HEADER
  91. 3000  CALL GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
  92.       IF (NEWLEN.LT.0) GO TO 3800
  93.       IF (TYPE.EQ.FLET) GO TO 3100
  94.       IF (TYPE.EQ.SLET) GO TO 3200
  95.       IF (TYPE.EQ.ZLET) GO TO 3300
  96.       IF (TYPE.EQ.BLET) GO TO 3400
  97.       GO TO 3500
  98. C
  99. 3100  DO 3110 I=1,40
  100. 3110  FILNAM(I) = 0
  101.       DO 3120 I = 1,NEWLEN
  102. 3120  FILNAM(I) = DATA(I)
  103.       IF (FILOPN.EQ.0) GO TO 3130
  104.       CLOSE (UNIT=1)
  105. 3130  OPEN (UNIT=1,NAME=FILNAM,CARRIAGECONTROL='LIST')
  106.       FILOPN = -1
  107.       FILPTR = 1
  108.       STATE = STATED
  109.       GO TO 1200
  110. C
  111. 3200  SEQNUM = 0
  112.       RETRY = 0
  113.       GO TO 1400
  114. C
  115. 3300  NEWSEQ = MOD(NEWSEQ+1,64)
  116.       IF (NEWSEQ.NE.SEQNUM) GO TO 3500
  117.       RETRY = RETRY + 1
  118.       GO TO 1100
  119. C
  120. 3400  STATE = STATEI
  121.       GO TO 1100
  122. C
  123. 3500  STATE = STATEA
  124.       GO TO 1300
  125. C
  126. 3800  GO TO 1300
  127. C
  128. C     STATE D - RECEIVE DATA
  129. 4000  CONTINUE
  130. CDBG        WRITE (2,4001) SEQNUM
  131. CDBG  4001  FORMAT (' LOOKING FOR PACKET ',I4)
  132.       CALL GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
  133.       IF (NEWLEN.LT.0) GO TO 4800
  134.       IF (TYPE.EQ.DLET) GO TO 4100
  135.       IF (TYPE.EQ.ZLET) GO TO 4200
  136.       IF (TYPE.EQ.FLET) GO TO 4300
  137.       GO TO 4400
  138. C
  139. 4100  IF (NEWSEQ.EQ.SEQNUM) GO TO 4110
  140.       RETRY = RETRY + 1
  141.       GO TO 1100
  142. 4110  I = 1
  143. CDBG        WRITE (2,4111) (DATA(J),J=1,NEWLEN)
  144. CDBG  4111  FORMAT(' DATA RCVD=',132A1)
  145. 4120  IF (I.GT.NEWLEN) GO TO 4170
  146.       IF (DATA(I).NE.MYQUO) GO TO 4160
  147. 4130  I = I + 1
  148.       IF (DATA(I).EQ.MYQUO) GO TO 4160
  149.       DATA(I) = CTL(DATA(I))
  150.       IF ((DATA(I).NE.10).AND.(DATA(I).NE.13)) GO TO 4160
  151.       IF (DATA(I).EQ.10) GO TO 4150
  152.       IF (FILPTR.EQ.1) GO TO 4140
  153.       WRITE (1,4131) (FILLIN(J),J=1,FILPTR-1)
  154. 4131  FORMAT(132A1)
  155.       GO TO 4150
  156. 4140  WRITE (1,4131)
  157. 4150  I = I + 1
  158.       FILPTR = 1
  159.       GO TO 4120
  160. 4160  FILLIN(FILPTR) = DATA(I)
  161.       FILPTR = FILPTR + 1
  162.       I = I + 1
  163.       GO TO 4120
  164. C
  165. 4170  GO TO 1200
  166. C
  167. 4200  CLOSE(UNIT=1)
  168.       FILOPN = 0
  169.       STATE = STATEF
  170.       GO TO 1200
  171. C
  172. 4300  RETRY = RETRY + 1
  173.       GO TO 1100
  174. C
  175. 4400  STATE = STATEA
  176.       GO TO 1300
  177. C
  178. 4800  GO TO 1300
  179. C
  180. C     STATE A - ABORT
  181. 5000  STATE = STATEI
  182.       IF (FILOPN.EQ.0) GO TO 5010
  183.       CLOSE (UNIT=1)
  184. 5010  FILOPN = 0
  185.       RETRY = 0
  186.       SEQNUM = 0
  187.       GO TO 1300
  188. C
  189. 8000  CONTINUE
  190.       STOP
  191.       END
  192. C
  193.       SUBROUTINE GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
  194. C
  195.       INTEGER NEWLEN,NEWSEQ,TYPE,DATA(256)
  196.       INTEGER TOCHAR,UNCHAR,CTL
  197.       INTEGER LINE(132),SOH,SEQ,LEN,DST,DEND,SUM,TYP,CHK
  198. C
  199.       NEWLEN = -1
  200.       NEWSEQ = 0
  201.       TYPE = ' '
  202. C
  203. 100   READ (5,101) (LINE(I),I=1,132)
  204. 101   FORMAT(132A1)
  205. C
  206.       NONBLK = 0
  207.       DO 110 I = 1,132
  208.       J = MOD(LINE(I),128)
  209.       IF (J.EQ.32) GO TO 110
  210.       NONBLK = 1
  211. 110   LINE(I) = J
  212. C
  213.       IF (NONBLK.EQ.0) GO TO 100
  214. C
  215.       DO 200 I=1,132
  216. 200   IF (LINE(I).EQ.1) GO TO 210
  217.       I = 0
  218. C
  219. 210   SOH = I
  220.       IF (SOH+4.GT.132) GO TO 800
  221.       LEN = UNCHAR(LINE(SOH+1))
  222.       SEQ = UNCHAR(LINE(SOH+2))
  223.       TYP = LINE(SOH+3)
  224.       IF ((SOH+1+LEN).GT.132) GO TO 800
  225.       IF ((LEN.LT.3).OR.(LEN.GT.94)) GO TO 800
  226. C
  227.       CHK = LINE(SOH+1+LEN)
  228.       SUM = 0
  229.       DST = SOH + 4
  230.       DEND = SOH + 4 + (LEN-3) - 1
  231. C
  232.       DO 310 I = SOH+1,DEND
  233. 310   SUM = MOD(SUM + LINE(I),256)
  234.       SUM = TOCHAR(MOD( SUM + SUM/64,64))
  235. CDBG        WRITE (2,311) LEN,SEQ,TYP,CHK,SUM
  236. CDBG  311   FORMAT (' LEN,SEQ,TYP,GIVEN SUM,REAL SUM= ',5I6)
  237.       IF (SUM.NE.CHK) GO TO 800
  238. C
  239.       DO 410 I = DST,DEND
  240. 410   DATA(I-DST+1) = LINE(I)
  241.       NEWLEN = LEN - 3
  242.       NEWSEQ = SEQ
  243.       TYPE = TYP
  244.       GO TO 900
  245. C
  246. 800   NEWLEN = -1
  247.       GO TO 900
  248. C
  249. 900   RETURN
  250.       END
  251. C
  252.       SUBROUTINE SNDPAK(DLEN,SEQ,TYP,OUTDAT)
  253. C
  254.       INTEGER DLEN,SEQ,TYP,OUTDAT(256)
  255.       INTEGER TOCHAR,UNCHAR,CTL
  256.       INTEGER SOH,SQ,SUM,LN,CHK
  257. C
  258.       SOH = 1
  259.       LN = TOCHAR(DLEN+3)
  260.       SQ = TOCHAR(SEQ)
  261. C
  262.       SUM = LN + SQ + TYP
  263.       IF (DLEN.LE.0) GO TO 120
  264.       DO 110 I = 1,DLEN
  265. 110   SUM = MOD(SUM + OUTDAT(I),256)
  266. 120   SUM = MOD(SUM + SUM/64,64)
  267.       CHK = TOCHAR(SUM)
  268. C
  269.       IF (DLEN.EQ.0) GO TO 300
  270.       WRITE (6,201) SOH,LN,SQ,TYP,(OUTDAT(I),I=1,DLEN),CHK
  271. 201   FORMAT (' ',132A1)
  272.       GO TO 900
  273. 300   WRITE (6,201) SOH,LN,SQ,TYP,CHK
  274. C
  275. 900   RETURN
  276.       END
  277. C
  278. C
  279.       FUNCTION TOCHAR(I)
  280.       INTEGER TOCHAR,I
  281. C
  282.       TOCHAR = MOD(I,128) + 32
  283.       RETURN
  284.       END
  285. C
  286.       FUNCTION UNCHAR(I)
  287.       INTEGER UNCHAR,I
  288. C
  289.       UNCHAR = MOD(I,128) - 32
  290.       RETURN
  291.       END
  292. C
  293.       FUNCTION CTL(I)
  294.       INTEGER CTL,I,J
  295. C
  296.       J = I / 64
  297.       J = MOD(J,2)
  298.       IF (J.EQ.0) GO TO 10
  299.       CTL = MOD(I,128) - 64
  300.       GO TO 20
  301. C
  302. 10    CTL = MOD(I,128) + 64
  303. 20    RETURN
  304.       END
  305.