C     SIMPLE KERMIT BOOT PROGRAM
C
C     WRITTEN BY: JIM LEWINSON;  BREUER & COMPANY  (JIML@SCORE.ARPA)
C
C     VERSION 1.0(25)  9-JUL-84
C
      INTEGER SEQNUM,RETRY,STATE,TYPE,NEWLEN,NEWSEQ
      INTEGER DATA(256),OUTDAT(256)
      INTEGER TOCHAR,UNCHAR,CTL
      INTEGER STATEI,STATEF,STATED,STATEB,STATEA
      INTEGER DLET,YLET,NLET,SLET,BLET,FLET,ZLET,ELET,TLET
      INTEGER MYQUO,FILOPN,FILLIN(512),FILPTR
      LOGICAL*1 FILNAM(40)
C
      FILOPN = 0
      SEQNUM = 0
      RETRY = 0
      STATEI = 1
      STATEF = 2
      STATED = 3
      STATEB = 4
      STATEA = 5
C
      DLET = 68
      YLET = 89
      NLET = 78
      SLET = 83
      BLET = 66
      FLET = 70
      ZLET = 90
      ELET = 69
      TLET = 84
      MYQUO = 35
C
      STATE = STATEI
C
1000  CONTINUE
CDBG        WRITE (2,1001) STATE
CDBG  1001  FORMAT (' STATE NOW IS ',I4)
      IF (STATE.EQ.STATEI) GO TO 2000
      IF (STATE.EQ.STATEF) GO TO 3000
      IF (STATE.EQ.STATED) GO TO 4000
      IF (STATE.EQ.STATEA) GO TO 5000
      GO TO 8000
C
C     SEND AN ACK
1100  CALL SNDPAK(0,SEQNUM,'Y',OUTDAT)
      GO TO 1000
C
C     SEND AN ACK AND INC SEQ NUMBER
1200  CALL SNDPAK(0,SEQNUM,'Y',OUTDAT)
      SEQNUM = MOD(SEQNUM+1,64)
      RETRY = 0
      GO TO 1000
C
C     SEND A NAK
1300  CALL SNDPAK(0,SEQNUM,'N',OUTDAT)
      GO TO 1000
C
C     REPLY TO AN SEND-INIT PACKET
1400  SEQNUM = 0
      RETRY = 0
      OUTDAT(1) = TOCHAR(60)
      OUTDAT(2) = TOCHAR(10)
      OUTDAT(3) = TOCHAR(0)
      OUTDAT(4) = ' '
      OUTDAT(5) = TOCHAR(13)
      OUTDAT(6) = MYQUO
      OUTDAT(7) = 'N'
      OUTDAT(8) = '1'
      OUTDAT(9) = ' '
      OUTDAT(10) = ' '
      CALL SNDPAK(10,SEQNUM,'Y',OUTDAT)
      STATE = STATEF
      SEQNUM = MOD(SEQNUM+1,64)
      RETRY = 0
      GO TO 1000
C
C     STATE S - AWAIT SEND-INIT
2000  SEQNUM = 0
      RETRY = 0
      CALL GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
      IF (NEWLEN.LT.0) GO TO 2800
      IF (TYPE.NE.SLET) GO TO 2800
      GO TO 1400
C
2800  RETRY = RETRY + 1
      GO TO 1300
C
C     STATE F - AWAIT FILE HEADER
3000  CALL GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
      IF (NEWLEN.LT.0) GO TO 3800
      IF (TYPE.EQ.FLET) GO TO 3100
      IF (TYPE.EQ.SLET) GO TO 3200
      IF (TYPE.EQ.ZLET) GO TO 3300
      IF (TYPE.EQ.BLET) GO TO 3400
      GO TO 3500
C
3100  DO 3110 I=1,40
3110  FILNAM(I) = 0
      DO 3120 I = 1,NEWLEN
3120  FILNAM(I) = DATA(I)
      IF (FILOPN.EQ.0) GO TO 3130
      CLOSE (UNIT=1)
3130  OPEN (UNIT=1,NAME=FILNAM,CARRIAGECONTROL='LIST')
      FILOPN = -1
      FILPTR = 1
      STATE = STATED
      GO TO 1200
C
3200  SEQNUM = 0
      RETRY = 0
      GO TO 1400
C
3300  NEWSEQ = MOD(NEWSEQ+1,64)
      IF (NEWSEQ.NE.SEQNUM) GO TO 3500
      RETRY = RETRY + 1
      GO TO 1100
C
3400  STATE = STATEI
      GO TO 1100
C
3500  STATE = STATEA
      GO TO 1300
C
3800  GO TO 1300
C
C     STATE D - RECEIVE DATA
4000  CONTINUE
CDBG        WRITE (2,4001) SEQNUM
CDBG  4001  FORMAT (' LOOKING FOR PACKET ',I4)
      CALL GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
      IF (NEWLEN.LT.0) GO TO 4800
      IF (TYPE.EQ.DLET) GO TO 4100
      IF (TYPE.EQ.ZLET) GO TO 4200
      IF (TYPE.EQ.FLET) GO TO 4300
      GO TO 4400
C
4100  IF (NEWSEQ.EQ.SEQNUM) GO TO 4110
      RETRY = RETRY + 1
      GO TO 1100
4110  I = 1
CDBG        WRITE (2,4111) (DATA(J),J=1,NEWLEN)
CDBG  4111  FORMAT(' DATA RCVD=',132A1)
4120  IF (I.GT.NEWLEN) GO TO 4170
      IF (DATA(I).NE.MYQUO) GO TO 4160
4130  I = I + 1
      IF (DATA(I).EQ.MYQUO) GO TO 4160
      DATA(I) = CTL(DATA(I))
      IF ((DATA(I).NE.10).AND.(DATA(I).NE.13)) GO TO 4160
      IF (DATA(I).EQ.10) GO TO 4150
      IF (FILPTR.EQ.1) GO TO 4140
      WRITE (1,4131) (FILLIN(J),J=1,FILPTR-1)
4131  FORMAT(132A1)
      GO TO 4150
4140  WRITE (1,4131)
4150  I = I + 1
      FILPTR = 1
      GO TO 4120
4160  FILLIN(FILPTR) = DATA(I)
      FILPTR = FILPTR + 1
      I = I + 1
      GO TO 4120
C
4170  GO TO 1200
C
4200  CLOSE(UNIT=1)
      FILOPN = 0
      STATE = STATEF
      GO TO 1200
C
4300  RETRY = RETRY + 1
      GO TO 1100
C
4400  STATE = STATEA
      GO TO 1300
C
4800  GO TO 1300
C
C     STATE A - ABORT
5000  STATE = STATEI
      IF (FILOPN.EQ.0) GO TO 5010
      CLOSE (UNIT=1)
5010  FILOPN = 0
      RETRY = 0
      SEQNUM = 0
      GO TO 1300
C
8000  CONTINUE
      STOP
      END
C
      SUBROUTINE GETPAK(NEWLEN,NEWSEQ,TYPE,DATA)
C
      INTEGER NEWLEN,NEWSEQ,TYPE,DATA(256)
      INTEGER TOCHAR,UNCHAR,CTL
      INTEGER LINE(132),SOH,SEQ,LEN,DST,DEND,SUM,TYP,CHK
C
      NEWLEN = -1
      NEWSEQ = 0
      TYPE = ' '
C
100   READ (5,101) (LINE(I),I=1,132)
101   FORMAT(132A1)
C
      NONBLK = 0
      DO 110 I = 1,132
      J = MOD(LINE(I),128)
      IF (J.EQ.32) GO TO 110
      NONBLK = 1
110   LINE(I) = J
C
      IF (NONBLK.EQ.0) GO TO 100
C
      DO 200 I=1,132
200   IF (LINE(I).EQ.1) GO TO 210
      I = 0
C
210   SOH = I
      IF (SOH+4.GT.132) GO TO 800
      LEN = UNCHAR(LINE(SOH+1))
      SEQ = UNCHAR(LINE(SOH+2))
      TYP = LINE(SOH+3)
      IF ((SOH+1+LEN).GT.132) GO TO 800
      IF ((LEN.LT.3).OR.(LEN.GT.94)) GO TO 800
C
      CHK = LINE(SOH+1+LEN)
      SUM = 0
      DST = SOH + 4
      DEND = SOH + 4 + (LEN-3) - 1
C
      DO 310 I = SOH+1,DEND
310   SUM = MOD(SUM + LINE(I),256)
      SUM = TOCHAR(MOD( SUM + SUM/64,64))
CDBG        WRITE (2,311) LEN,SEQ,TYP,CHK,SUM
CDBG  311   FORMAT (' LEN,SEQ,TYP,GIVEN SUM,REAL SUM= ',5I6)
      IF (SUM.NE.CHK) GO TO 800
C
      DO 410 I = DST,DEND
410   DATA(I-DST+1) = LINE(I)
      NEWLEN = LEN - 3
      NEWSEQ = SEQ
      TYPE = TYP
      GO TO 900
C
800   NEWLEN = -1
      GO TO 900
C
900   RETURN
      END
C
      SUBROUTINE SNDPAK(DLEN,SEQ,TYP,OUTDAT)
C
      INTEGER DLEN,SEQ,TYP,OUTDAT(256)
      INTEGER TOCHAR,UNCHAR,CTL
      INTEGER SOH,SQ,SUM,LN,CHK
C
      SOH = 1
      LN = TOCHAR(DLEN+3)
      SQ = TOCHAR(SEQ)
C
      SUM = LN + SQ + TYP
      IF (DLEN.LE.0) GO TO 120
      DO 110 I = 1,DLEN
110   SUM = MOD(SUM + OUTDAT(I),256)
120   SUM = MOD(SUM + SUM/64,64)
      CHK = TOCHAR(SUM)
C
      IF (DLEN.EQ.0) GO TO 300
      WRITE (6,201) SOH,LN,SQ,TYP,(OUTDAT(I),I=1,DLEN),CHK
201   FORMAT (' ',132A1)
      GO TO 900
300   WRITE (6,201) SOH,LN,SQ,TYP,CHK
C
900   RETURN
      END
C
C
      FUNCTION TOCHAR(I)
      INTEGER TOCHAR,I
C
      TOCHAR = MOD(I,128) + 32
      RETURN
      END
C
      FUNCTION UNCHAR(I)
      INTEGER UNCHAR,I
C
      UNCHAR = MOD(I,128) - 32
      RETURN
      END
C
      FUNCTION CTL(I)
      INTEGER CTL,I,J
C
      J = I / 64
      J = MOD(J,2)
      IF (J.EQ.0) GO TO 10
      CTL = MOD(I,128) - 64
      GO TO 20
C
10    CTL = MOD(I,128) + 64
20    RETURN
      END