home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
e
/
kerboo.for
< prev
next >
Wrap
Text File
|
2020-01-01
|
7KB
|
305 lines
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