home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / perkinelmeros32 / perkin.ftn < prev    next >
Text File  |  2020-01-01  |  33KB  |  1,089 lines
  1. $BATCH
  2. $PROG PEKERMIT
  3.       IMPLICIT INTEGER (A-Z)
  4.       INTEGER COMNDS(15)
  5. C
  6.       LOGICAL HLPFLG
  7. C
  8.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  9.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  10.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  11.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  12.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  13.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  14.       COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
  15. C
  16.       DATA COMNDS/'8BIT','DIRE','EXIT','HELP','LINE','MODE','NPAD',
  17.      +'PACK','PAD-','QUIT','RECE','SEND','SOH ','STAT','TYPE'/
  18. C
  19.       SPACE=Y'20202020'
  20.       BKSPC=Y'08080808'
  21.       BELL=Y'07070707'
  22.       DELE=8
  23.       CTLX=24
  24. C
  25.       DASH=45                               ; -
  26.       STAR=42                               ; *
  27.       PERIOD=46                             ; .
  28.       BSLSH=92                              ; \
  29.       COLON=58                              ; :
  30. C
  31.       SOH=15
  32.       MYEOL=13
  33.       YREOL=MYEOL
  34.       MYCTL=35
  35.       YRCTL=MYCTL
  36.       MYFG0=38
  37.       QUOT8B=0
  38.       MYMAX=50
  39.       YRMAX=94
  40.       MYTIM=8
  41.       YRTIM=MYTIM
  42.       MYNPAD=0
  43.       YRNPAD=MYNPAD
  44.       MYPAD=0
  45.       YRPAD=MYPAD
  46.       MYRPT=78                              ; USE "~"(126), FOR RPTS
  47.       RECORD=80
  48.       MODE=0                                ; DEFAULT TO ASCII MODE
  49. C
  50.       SI=83                                 ; "S"
  51.       FN=70                                 ; "F"
  52.       DA=68                                 ; "D"
  53.       ER=69                                 ; "E"
  54.       BR=66                                 ; "B"
  55.       EF=90                                 ; "Z"
  56.       ACK=89                                ; "Y"
  57.       NAK=78                                ; "N"
  58.       SEQNCE=32
  59. C
  60.       CLU=2                                 ; INITIAL MODE IS BATCH
  61.       LLU=15                                ; 15 NORMALLY UNASSIGNED
  62.       FILE=2
  63.       DIR=3
  64.       PRMPT=14
  65. C
  66.       HELP=63                               ; => ?
  67.       INIT=0
  68. C  >> START WITH A [CLS] <<
  69.       REPORT=CONMSG(1)                      ; CLS
  70. C  >> [<CR><LF><SP>PEKERMIT]
  71. 1     REPORT=CONMSG(2)                      ; PROMPT
  72.       POINTR=0
  73.       NTODO=0
  74.       VALUE=0
  75.       FLAG=0
  76. 2     IC=GETCH(0)
  77.       IF(INIT.EQ.2) INIT=0
  78.       IF(IC.EQ.SOH.AND.INIT.EQ.0) INIT=1
  79.       IF(IC.EQ.MYEOL.AND.INIT.EQ.1) INIT=2
  80.       IF(INIT.NE.0) GO TO 2                 ; IGNORE EXCESS PACKETS
  81.       IF(IC.EQ.MYPAD) GO TO 2               ; IGNORE INADVERTENT PADS
  82.       IF(IC.NE.DELE.AND.IC.NE.CTLX) GO TO 3
  83.        IF(IC.EQ.CTLX) CALL SYSIO(PBLK,41,LLU,BKSPC,1,0,0)
  84.        CALL SYSIO(PBLK,41,LLU,SPACE,1,0,0)  ; OVERWRITE CHAR
  85.        CALL SYSIO(PBLK,41,LLU,BKSPC,1,0,0)  ; BACKSPACE
  86.        IF(IC.EQ.CTLX) GO TO 1               ; CTRL-X
  87.        POINTR=POINTR-1
  88.        IF(POINTR.GE.0) CALL ILBYTE(IC,RBUF,POINTR)
  89.        IF(IC.GE.48.AND.IC.LE.57) VALUE=VALUE/10
  90.        IF(FLAG.GT.POINTR) FLAG=POINTR
  91.        IF(POINTR.GT.0) GO TO 2
  92.        CALL SYSIO(PBLK,41,LLU,BELL,1,0,0)
  93.        GO TO 1
  94. 3     IF(IC.GE.97.AND.IC.LE.122) IC=IC-32
  95.       IF(IC.EQ.13.OR.IC.EQ.HELP) GO TO 4    ; HELP CHAR DEF = ?
  96.       IF(IC.GE.48.AND.IC.LE.57.AND.POINTR.GT.0) VALUE=10*VALUE+IC-48
  97.        CALL ISBYTE(IC,RBUF,POINTR)
  98.        IF(IC.GE.65.AND.NTODO.EQ.POINTR) NTODO=NTODO+1
  99.        IF(IC.LT.65.AND.FLAG.LE.0.AND.POINTR.NE.0) FLAG=POINTR+1
  100. C
  101.         IF(IC.EQ.56.AND.POINTR.EQ.0) NTODO=NTODO+1
  102. C
  103.        POINTR=POINTR+1
  104.        GO TO 2
  105. C
  106. C  >> COMMAND PARSER <<
  107. C
  108. 4     I=-1                                  ; INDICATES FULL-HELP
  109.       IF(POINTR.LE.0) GO TO 301
  110.       IF(NTODO.GT.4) NTODO=4
  111.       I=0
  112.       J=0
  113.       K=0
  114.       DO 6 M=1,15
  115.         DO 5 L=1,NTODO
  116.          CALL ILBYTE(L1,RBUF,L-1)
  117.          CALL ILBYTE(L2,COMNDS(M),L-1)
  118.          IF(L1.NE.L2) GO TO 6
  119. 5       CONTINUE
  120.         J=M
  121.         IF(K.EQ.0) K=J
  122.         IF(J.EQ.M) CALL BSET(I,M-1)
  123.         IF(J.EQ.K.AND.K.EQ.4) I=-1
  124. 6       CONTINUE
  125.        IF(J.EQ.K.AND.K.EQ.0) I=-1
  126.        IF(K.EQ.J.AND.K.NE.0.AND.IC.NE.HELP) GO TO 8
  127. 7      REPORT=CONMSG(1)                     ; CLS
  128.        IF(IC.EQ.HELP) GO TO 9
  129.        REPORT=CONMSG(3)                     ; UNKNOWN COMMAND
  130.        IF(POINTR.GT.0) CALL SYSIO(PBLK,41,LLU,RBUF,POINTR,0,0)
  131.        IF(POINTR.LE.0) CALL SYSIO(PBLK,40,LLU,SPACE,1,0,0)
  132.        GO TO 9
  133. 8     CONTINUE
  134.       GO TO (1400,100,200,300,1000,400,500,600,700,800,900,1100,
  135.      +1500,1200,1300),K
  136. C
  137. C  >> HELP FUNCTION - LEVEL 1 <<
  138. C
  139. 9     REPORT=CONMSG(5)                      ; HELP SCREEN BANNER
  140.       DO 10 N=1,15
  141.        IF(COMNDS(N).LE.'    ') GO TO 10
  142.         HLPFLG=BTEST(I,N-1)
  143.         IF(.NOT.HLPFLG) GO TO 10
  144.          REPORT=CONMSG(6)                   ; (NEW LINE)
  145.          IER=N+25
  146.          REPORT=CONMSG(IER)                 ; HELP LINE #N+1
  147. 10    CONTINUE
  148.       REPORT=CONMSG(6)                      ; (NEW LINE)
  149.       GO TO 1
  150. C
  151. C  >> DIRECTORY <<
  152. C
  153. 100   IF(FLAG.LE.0) RBUF(1)='*.* '
  154.       CALL EXPDFD(FLAG)
  155.       REWIND DIR
  156.       REPORT=CONMSG(6)                      ; (NEW LINE)
  157.       CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0)
  158.       CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0)
  159.       CALL SYSIO(PBLK,40,LLU,RBUF(5),20,0,0)
  160.       CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0)
  161.       REPORT=CONMSG(6)
  162.       COUNT=3
  163. 101   CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0)
  164.       IER=IAND(PBLK(1),Y'FFFF')
  165.       IF(IER.NE.0) GO TO 1
  166.       IER=COMPFD(RBUF,RBUF(5),1)
  167.       IF(IER.EQ.0) GO TO 101
  168. C
  169.        CALL ISBYTE(32,RBUF(5),13)
  170.        CALL ILBYTE(IC,RBUF(5),14)
  171.        IF(IC.NE.35) CALL ISBYTE(32,RBUF(5),14)  ; CLEAR OUT GARBAGE
  172. C
  173.        CALL SYSIO(PBLK,40,LLU,RBUF(5),15,0,0)
  174.        COUNT=COUNT+1
  175.        IF(COUNT.LT.23) GO TO 101
  176.         COUNT=0
  177.         REPORT=CONMSG(21)                   ; CONTINUE PROMPT
  178.         IC=GETCH(0)
  179.         IF(IC.EQ.81.OR.IC.EQ.113) GO TO 1
  180.         REPORT=CONMSG(1)                    ; CLS
  181.          GO TO 101
  182. C
  183. C  >> EXIT <<
  184. C
  185. 200   REPORT=CONMSG(1)                      ; CLS
  186.       REPORT=CONMSG(4)                      ; LOGOFF...
  187.       DO 201 N=1,15
  188. 201   CALL CLOSE(N-1,IER)
  189.       CALL EXIT
  190. C
  191. C  >> HELP <<
  192. 300   I=-1
  193. 301   REPORT=CONMSG(1)                      ; CLS
  194.       GO TO 9
  195. C
  196. C  >> MODE <<
  197. C
  198. 400   IC=MODE
  199.       IF(FLAG.GT.0) CALL ILBYTE(IC,RBUF,FLAG)
  200.       IF(IC.EQ.65.OR.IC.EQ.66) IC=66-IC
  201.       MODE=1-IC
  202.       REPORT=CONMSG(6)
  203.       REPORT=CONMSG(18)
  204.       RBUF(1)='ASCI'
  205.       RBUF(2)='I   '
  206.       IF(MODE.LE.0) GO TO 401
  207.        RBUF(1)='BINA'
  208.        RBUF(2)='RY  '
  209. 401   CALL SYSIO(PBLK,40,LLU,RBUF,7,0,0)
  210.       GO TO 1
  211. C
  212. C  >> NPADS <<
  213. C
  214. 500   IF(VALUE.LT.0.OR.VALUE.GT.64) GO TO 301
  215.       MYNPAD=VALUE
  216.       REPORT=CONMSG(6)
  217.       REPORT=CONMSG(13)
  218.       CALL SYSIO(PBLK,40,LLU,NCOD(MYNPAD),4,0,0)
  219.       GO TO 1
  220. C
  221. C  >> PACK <<
  222. C
  223. 600   IF(VALUE.LT.20.OR.VALUE.GT.94) GO TO 301   ; ILLEGAL
  224.       MYMAX=VALUE
  225.       YRMAX=MYMAX
  226.       REPORT=CONMSG(6)
  227.       REPORT=CONMSG(12)
  228.       CALL SYSIO(PBLK,40,LLU,NCOD(MYMAX),4,0,0)
  229.       GO TO 1
  230. C
  231. C  >> PADDING <<
  232. C
  233. 700   IF((VALUE.LT.0.OR.VALUE.GT.32).AND.VALUE.NE.127) GO TO 301
  234.       MYPAD=VALUE
  235.       YRPAD=MYPAD
  236.       REPORT=CONMSG(6)
  237.       REPORT=CONMSG(14)
  238.       CALL SYSIO(PBLK,40,LLU,NCOD(MYPAD),4,0,0)
  239.       GO TO 1
  240. C
  241. C  >> QUIT <<
  242. C
  243. 800   GO TO 200
  244. C
  245. C  >> RECEIV <<
  246. C
  247. 900   CALL RECEIV
  248.       GO TO 1
  249. C
  250. C  >> RECORD <<
  251. C
  252. 1000  IF(VALUE.LT.1.OR.VALUE.GT.256) GO TO 301
  253.       RECORD=VALUE
  254.       REPORT=CONMSG(6)
  255.       REPORT=CONMSG(17)
  256.       CALL SYSIO(PBLK,40,LLU,NCOD(RECORD),4,0,0)
  257.       GO TO 1
  258. C
  259. C  >> SEND <<
  260. C
  261. 1100  IF(FLAG.LE.0) GO TO 7
  262.       CALL SEND(FLAG)
  263.       GO TO 1
  264. C
  265. C  >> STATUS <<
  266. C
  267. 1200  CALL STATUS
  268.       GO TO 1
  269. C
  270. C  >> TYPE <<
  271. C
  272. 1300  IF(FLAG.LE.0) GO TO 7
  273.       DO 1301 N=1,20
  274.        CALL ILBYTE(IC,RBUF,FLAG)
  275.        IF(IC.LT.32.OR.IC.GT.125) FLAG=N-1
  276.        IF(FLAG.LT.N) IC=32
  277.        FLAG=FLAG+1
  278. 1301  CALL ISBYTE(IC,RBUF,N-1)
  279.       CALL CLOSE(FILE,IER)
  280.       CALL OPENW(FILE,RBUF,4,0,0,IER)
  281.       CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0)   ; NEW LINE
  282.       COUNT=0
  283.       IF(IER.LE.0) GO TO 1302
  284.        REPORT=CONMSG(20)                    ; FILE ACCESS ERROR
  285.        CALL SYSIO(PBLK,41,LLU,RBUF,20,0,0)
  286.        REPORT=CONMSG(6)
  287.        GO TO 1
  288. 1302  CALL SYSIO(PBLK,72,FILE,RBUF,126,0,0)
  289.       IER=IAND(PBLK(1),Y'FFFF')
  290.       IF(IER.NE.0) GO TO 1303
  291.       LEN=PBLK(5)
  292.       CALL SYSIO(PBLK,40,LLU,RBUF,LEN,0,0)
  293.       COUNT=COUNT+1
  294.       IF(COUNT.LT.23) GO TO 1302
  295.       COUNT=0
  296.       REPORT=CONMSG(21)                     ; CONTINUE PROMPT
  297.       IC=GETCH(0)
  298.       IF(IC.EQ.81.OR.IC.EQ.113) GO TO 1303
  299.       CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0)
  300.       GO TO 1302
  301. 1303  CALL CLOSE(FILE,IER)
  302.       GO TO 1
  303. C
  304. C  >> 8BIT <<
  305. C
  306. 1400  QUOT8B=1-QUOT8B                       ; TOGGLE QUOT8B
  307.       IF(VALUE.EQ.1) QUOT8B=VALUE
  308.       IF(FLAG.LE.0) GO TO 1401
  309.       CALL ILBYTE(IC,RBUF,FLAG+1)
  310.       IF(IC.EQ.70.OR.IC.EQ.79) QUOT8B=0     ; "OFF" OR "NO"
  311.       IF(IC.EQ.69.OR.IC.EQ.78) QUOT8B=1     ; "ON" OR "YES'
  312. 1401  REPORT=CONMSG(6)
  313.       REPORT=CONMSG(16)
  314.       RBUF(1)='OFF '
  315.       IF(QUOT8B.EQ.1) RBUF(1)=MYFG0
  316.       CALL SYSIO(PBLK,40,LLU,RBUF,4,0,0)
  317.       GO TO 1
  318. C
  319. C  >> SOH <<
  320. C
  321. 1500  IF((VALUE.LT.1.OR.VALUE.GT.31).AND.VALUE.NE.127) GO TO 301
  322.       SOH=VALUE
  323.       REPORT=CONMSG(6)
  324.       REPORT=CONMSG(10)
  325.       CALL SYSIO(PBLK,40,LLU,NCOD(SOH),4,0,0)
  326.       GO TO 1
  327.       END
  328. $PROG CKSUM
  329. C
  330. C
  331.       INTEGER FUNCTION CKSUM(BUFF)
  332.       IMPLICIT INTEGER (A-Z)
  333.       INTEGER BUFF(1)
  334.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  335.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  336.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  337.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  338.       CALL ILBYTE(LEN,BUFF,1)
  339.       LEN=LEN-32
  340.       CKSUM=0
  341.       DO 1 N=1,LEN
  342.        CALL ILBYTE(IC,BUFF,N)
  343. 1     CKSUM=CKSUM+IC
  344.       CKSUM=IAND((CKSUM+IAND(CKSUM,Y'C0')/Y'40'),Y'3F')+32
  345.       RETURN
  346.       END
  347. $PROG COMPFD
  348. C
  349. C
  350.       INTEGER FUNCTION COMPFD(BUFF1,BUFF2,INPTR)
  351.       IMPLICIT INTEGER(A-Z)
  352.       INTEGER BUFF1(1),BUFF2(1),POINTR
  353.       COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
  354. C
  355. C  >> COMPARES 12 BYTES IN BUFF1, BEGINNING WITH BYTE #0,
  356. C     WITH 12 BYTES IN BUFF2, BEGINNING WITH BYTE #POINTR.
  357. C     IF ANY BUFF1 BYTE WHICH IS NOT BACKSLASH OR PERIOD
  358. C     DOES NOT MATCH THE COMPARABLE BUFF2 BYTE, RESULT=0
  359. C     OTHERWISE, RESULT=1.
  360. C
  361. C     ON RESULT=1, BUFF2 WILL HOLD PACKED FD, STARTING AT BYTE #1
  362. C
  363.       POINTR=INPTR
  364.       COMPFD=0
  365.       DO 1 N=1,12
  366.        CALL ILBYTE(IC,BUFF1,N-1)
  367.        CALL ILBYTE(JC,BUFF2,N)
  368.        CALL ISBYTE(32,BUFF2,N)
  369.        IF(IC.NE.JC.AND.JC.NE.PERIOD.AND.IC.NE.BSLSH) RETURN
  370.        IF(JC.LE.32) GO TO 1
  371.         CALL ISBYTE(JC,BUFF2,POINTR)
  372.         POINTR=POINTR+1
  373. 1     CONTINUE
  374.       COMPFD=1
  375.       RETURN
  376.       END
  377. $PROG CONMSG
  378. C
  379. C
  380.       INTEGER FUNCTION CONMSG(NDX)
  381.       IMPLICIT INTEGER(A-Z)
  382.       INTEGER MBUF(20)
  383. C
  384. C  >> ALWAYS WRITES TO LLU IN IMAGE MODE <<
  385. C  >> ERROR(S) RETURNED IN PBLK(1) USING STD SYSIO DEFINITIONS <<
  386. C
  387.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  388.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  389.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  390.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  391.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  392.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  393.       CONMSG=-1
  394.       IF(NDX.LE.0) RETURN
  395.       N=NDX-1
  396.       CALL SYSIO(PBLK,77,PRMPT,MBUF,80,N,0)
  397.       CONMSG=IAND(PBLK(1),Y'FFFF')
  398.       NBYTS=MBUF(1)
  399.       IF(NBYTS.GT.80.AND.CONMSG.EQ.0) CONMSG=NBYTS
  400.       IF(CONMSG.NE.0) RETURN
  401.       IF(NBYTS.GT.0) CALL SYSIO(PBLK,41,LLU,MBUF(2),NBYTS,0,0)
  402.       RETURN
  403.       END
  404. $PROG CTL
  405. C
  406. C
  407.       INTEGER FUNCTION CTL(CH)
  408. C
  409. C
  410. C  >>  TOGGLE BIT 1 OF THE LOW-ORDER BYTE OF CH (INT*4)
  411. C  >>  (USED TO FORCE KERMIT DATA BYTES TO BE PRINTABLE)
  412. C
  413.       INTEGER CH
  414. C
  415.       CTL=IEOR(CH,64)                       ; FLIP BIT 1, BYTE 3
  416.       RETURN
  417.       END
  418. $PROG EXPDFD
  419.       SUBROUTINE EXPDFD(START)
  420. C
  421. C
  422.       IMPLICIT INTEGER (A-Z)
  423.       INTEGER START
  424.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  425.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  426.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  427.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  428.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  429.       COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
  430.       INPTR=START
  431.       OUTPTR=0
  432. 1     CALL ILBYTE(IC,RBUF,INPTR)
  433.       INPTR=INPTR+1
  434.       IF(IC.NE.COLON) GO TO 2
  435.        OUTPTR=0
  436. 2     IF(IC.NE.STAR.AND.IC.NE.DASH.AND.IC.NE.PERIOD.AND.IC.GT.32.AND.
  437.      +IC.LT.126) GO TO 4
  438.        JC=BSLSH
  439.        IF(IC.EQ.PERIOD) JC=32
  440. 3      IF(OUTPTR.GE.9) JC=BSLSH
  441.        IF(IC.EQ.PERIOD.AND.OUTPTR.GE.9) GO TO 5
  442.        CALL ISBYTE(JC,RBUF,OUTPTR+28)
  443.        OUTPTR=OUTPTR+1
  444.        IF(OUTPTR.NE.9.AND.OUTPTR.LT.12) GO TO 3
  445.        IF(OUTPTR.LT.12) GO TO 1
  446.        GO TO 5
  447. 4     CALL ISBYTE(IC,RBUF,OUTPTR+28)
  448.       OUTPTR=OUTPTR+1
  449. 5     IF(OUTPTR.LT.12.AND.IC.GT.32.AND.IC.LT.126) GO TO 1
  450.       DO 6 N=1,24
  451.        IC=32
  452.        IF(N.LE.12) CALL ILBYTE(IC,RBUF,N+27)
  453. 6     CALL ISBYTE(IC,RBUF,N-1)
  454.       RETURN
  455.       END
  456. $PROG FLIPB0
  457. C
  458. C
  459.       INTEGER FUNCTION FLIPB0(CH)
  460. C
  461. C
  462. C  >>  TOGGLE BIT 0 OF THE LOW-ORDER BYTE OF CH (INT*4)
  463. C  >>  (FOR USE IN 7-BIT TRANSMISSION)
  464. C
  465.       INTEGER CH
  466. C
  467.       FLIPB0=IEOR(CH,128)                   ; FLIP BIT 0, BYTE 3
  468.       RETURN
  469.       END
  470. $PROG GETCH
  471. C
  472. C
  473.       INTEGER FUNCTION GETCH(DUMMY)
  474.       IMPLICIT INTEGER (A-Z)
  475.       INTEGER GBUF(20)
  476.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  477.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  478.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  479.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  480.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  481.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  482.       COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
  483. C
  484. C     >> EXPECTS CLU TO BE 0 IF SINGLE CHARACTER I/O TO BE DONE <<
  485. C     >>  - OTHERWISE DOES FULL-LINE I/O AND PASSES IT TO CALLER<<
  486. C     >>    ONE BYTE PER CALL.  ON I/O ERROR WITH CLU.NE.0,     <<
  487. C     >>    CLU IS RESET TO 0, LLU TO 1, AND I/0 CONTINUES.       <<
  488. C
  489.       DATA POINTR,NBYTS/0,0/
  490.       IF(POINTR.LT.NBYTS) GO TO 2
  491. 1      NBYTS=1
  492.        IF(CLU.NE.0) NBYTS=80
  493.        CALL SYSIO(PBLK,73,CLU,GBUF,NBYTS,0,0)
  494.        POINTR=0
  495.        IER=IAND(PBLK(1),Y'FFFF')
  496.        IF(IER.EQ.0) GO TO 2
  497.        CALL CLOSE(FILE,IER)
  498.        CLU=0
  499.        LLU=1
  500.        YREOL=MYEOL
  501.        YRCTL=MYCTL
  502.        YRFG0=MYFG0
  503.        YRMAX=94
  504.        YRTIM=MYTIM
  505.        YRPAD=MYPAD
  506.        CALL WAIT(100,1,IER)
  507.        REPORT=CONMSG(1)                      ; CLS
  508.        CALL STATUS
  509.        REPORT=CONMSG(2)                      ; PROMPT
  510.        GO TO 1
  511. 2     CALL ILBYTE(GETCH,GBUF,POINTR)
  512.       POINTR=POINTR+1
  513.       IF(GETCH.EQ.BSLSH.AND.CLU.NE.0) GETCH=13  ; END THE RECORD!
  514.       IF(GETCH.EQ.13) NBYTS=POINTR
  515.       RETURN
  516.       END
  517. $PROG NCOD
  518. C
  519. C
  520.       INTEGER FUNCTION NCOD(IVAL)
  521.       NCOD='    '
  522.       IDIV=1000
  523.       I=IVAL
  524.       M=1
  525.       DO 1 N=1,4
  526.        J=I/IDIV
  527.        I=I-IDIV*J
  528.        IDIV=IDIV/10
  529.        IF(J.GE.M.AND.J.LE.9) CALL ISBYTE(J+48,NCOD,N-1)
  530. 1     IF(J.GE.1.AND.J.LE.57) M=0
  531.       IF(NCOD.LE.'    ') CALL ISBYTE(48,NCOD,3)
  532.       RETURN
  533.       END
  534. $PROG OPNFIL
  535. C
  536. C
  537.       SUBROUTINE OPNFIL(IER)
  538. C
  539. C  >> READS FILE NAME FROM A PACKET STARTING AT BYTE 0
  540. C     IN SBUF:  IF FNAME EXISTS, DELETES FILE.
  541. C               ALLOCATES FNAME,IN,RECORD
  542. C               ASSIGNS TO <FILE>
  543. C               UPDATES <DIR> IF NECESSARY.
  544. C
  545.       IMPLICIT INTEGER(A-Z)
  546.       INTEGER NAME(6)
  547.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  548.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  549.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  550.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  551.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  552.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  553.       COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
  554.       POINTR=4
  555.       CALL ILBYTE(LEN,SBUF,1)
  556. C
  557.       LEN=LEN-32
  558.       DO 1 N=1,24
  559.        CALL ISBYTE(32,NAME,N-1)
  560.        IF(POINTR.GT.LEN) GO TO 1
  561.        CALL ILBYTE(IC,SBUF,POINTR)
  562.        CALL ISBYTE(IC,NAME,N-1)
  563.        POINTR=POINTR+1
  564. 1     CONTINUE
  565.       CALL CLOSE(FILE,IER)
  566.       CALL DFILW(NAME,0,0,JER)
  567.       CALL CFILW(NAME,2,RECORD,1,1,0,0,IER)
  568.       CALL OPENW(FILE,NAME,7,0,0,IER)
  569.       IF(JER.EQ.0.OR.IER.NE.0) RETURN
  570. C  >> FILE DIDN'T PREVIOUSLY EXIST <<
  571.       POINTR=12
  572.       DO 2 N=1,24
  573.        CALL ILBYTE(IC,NAME,24-N)
  574.        CALL ISBYTE(32,NAME,24-N)
  575.        IF(IC.LE.32) GO TO 2
  576.         CALL ISBYTE(IC,NAME,POINTR)
  577.         IF(IC.EQ.PERIOD) POINTR=25-N
  578.         POINTR=POINTR-1
  579. 2     CONTINUE
  580.       CALL ISBYTE(35,NAME,14)
  581.       CALL SYSIO(PBLK,132,DIR,0,0,0,0)
  582.       CALL SYSIO(PBLK,40,DIR,NAME,15,0,0)
  583.       RETURN
  584.       END
  585. $PROG RECEIV
  586. C
  587. C
  588.       SUBROUTINE RECEIV
  589.       IMPLICIT INTEGER(A-Z)
  590.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  591.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  592.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  593.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  594.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  595.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  596. C
  597. C  >> LU 2 RESERVED FOR FILE ACCESS
  598. C
  599. C  >> PACKET TYPES;
  600. C
  601. C     SI-NIT    ---   "S"
  602. C     FN-AME    ---   "F"
  603. C     DA-TA     ---   "D"
  604. C     ER-ROR    ---   "E"
  605. C     BR-EAK    ---   "B"
  606. C     EF-ILE    ---   "Z"
  607. C
  608. C
  609.       RETRY=5                               ; 5 TRIES ONLY
  610.       REPORT=CONMSG(7)                      ; RETURN TO CALLER
  611. C
  612. C
  613.       PAKTYP=ER
  614.       PARM='-000'
  615.       POINTR=0
  616.       PASS=0
  617. 1     CALL SYSIO(PBLK,73,CLU,RBUF,80,0,Y'18000000')
  618.       IER=IAND(PBLK(1),Y'FFFF')
  619.       IF(IER.NE.0) GO TO 10
  620. C
  621. C  >> OKAY, WE HAVE DATA SEE HOW MUCH..
  622. C
  623. C  >>> NOTE: <<<
  624. C      ON RAW I/O, THIS MODULE WOULD HAVE TO BE ALTERED
  625. C      TO CONTINUE READS UNTIL A COMPLETE PACKET IS RECEIVED,
  626. C      SINCE AN EMBEDDED RAW <CR> VALUE WOULD PRECIPITOUSLY
  627. C      TERMINATE DATA I/O.
  628. C
  629. C
  630.       DO 2 N=1,80
  631.        CALL ILBYTE(IC,RBUF,N-1)
  632.        IF(IC.NE.SOH.AND.POINTR.LE.0) GO TO 2; SKIP ANY PADS
  633.        CALL ISBYTE(IC,SBUF,POINTR)
  634.        IF(IC.EQ.MYEOL.AND.POINTR.NE.0) GO TO 3
  635.        POINTR=POINTR+1
  636.        IF(IC.NE.SOH) GO TO 2                ; UH-OH ... RESET!
  637.         POINTR=1
  638.         CALL ISBYTE(IC,SBUF,0)
  639.         PASS=0
  640. 2     CONTINUE
  641. C
  642. C  >> UH-OH ... BAD PACKET (NO SOH OR NO EOL)
  643. C  >>  SEND A NAK
  644. C
  645.       IER=1
  646.       PARM='    '
  647.       CALL ILBYTE(LEN,SBUF,1)
  648.       LEN=LEN-32
  649.       SIZE=LEN+MYNPAD+3
  650.       IF(POINTR.LE.0.OR.PASS.NE.0) GO TO 10
  651.       IF(SIZE.LE.80.OR.LEN.GT.94) GO TO 10
  652.       PASS=PASS+1
  653.       GO TO 1                               ; FINISH THE PACKET
  654. C
  655. C
  656. 3     IER=2
  657.       PASS=0
  658.       CALL ILBYTE(LEN,SBUF,1)
  659.       LEN=LEN-31
  660.       CALL ILBYTE(PAKTYP,SBUF,3)
  661.       PARM=PAKTYP
  662.       IF(PAKTYP.EQ.ER) GO TO 14             ; DID HE SEE PROBLEMS?
  663.       IF(PAKTYP.NE.SI.AND.PAKTYP.NE.FN.AND.PAKTYP.NE.DA.AND.PAKTYP.
  664.      +NE.BR.AND.PAKTYP.NE.EF) GO TO 10      ; UNKNOWN PAK TYPE
  665.       IER=3
  666.       PARM=NCOD(LEN-1)
  667.       IF(LEN.LT.0.OR.LEN.GT.95) GO TO 10
  668.       IER=4
  669.       CALL ILBYTE(INCK,SBUF,LEN)            ; GET HIS CHEKSUM
  670.       OUTCK=CKSUM(SBUF)                     ; GET MY CHECKSUM
  671.       PARM=NCOD(INCK*100+OUTCK)
  672.       IF(INCK.NE.OUTCK) GO TO 10            ; IF UNEQUAL, PROBLEMS..
  673.       CALL ILBYTE(SEQNCE,SBUF,2)
  674.       IER=0
  675.       PARM='    '
  676.       IF(PAKTYP.EQ.SI) CALL SETPAR(SBUF,0)
  677.       IF(PAKTYP.EQ.FN) CALL OPNFIL(IER)
  678.       IF(IER.NE.0) IER=IER+10
  679.       IF(PAKTYP.EQ.DA) CALL STORE
  680.       IF(PAKTYP.EQ.EF.OR.PAKTYP.EQ.BR) CALL XSTORE
  681. 10    RETRY=RETRY-1
  682.       IF(IER.EQ.0) RETRY=5
  683.       COND=ACK
  684.       IF(IER.EQ.0) GO TO 11
  685.        COND=NAK
  686.        CALL ISBYTE(35,SBUF,1)
  687. 11    CALL ISBYTE(SOH,SBUF,0)
  688.       IF(RETRY.GT.0.AND.IER.LE.4) GO TO 12
  689.        COND=ER
  690.        SBUF(2)='RECV'
  691.        SBUF(3)=' ERR'
  692.        SBUF(4)='OR #'
  693.        SBUF(5)=NCOD(IER)
  694.        SBUF(6)=PARM
  695.        CALL ISBYTE(55,SBUF,1)
  696. 12    CALL ILBYTE(LEN,SBUF,1)
  697.       LEN=LEN-31
  698.       IF(COND.NE.ER.AND.PAKTYP.NE.SI) LEN=4
  699.       CALL ISBYTE(LEN+31,SBUF,1)
  700.       CALL ISBYTE(SEQNCE,SBUF,2)
  701.       CALL ISBYTE(COND,SBUF,3)
  702.       CALL ISBYTE(CKSUM(SBUF),SBUF,LEN)
  703.       CALL ISBYTE(YREOL,SBUF,LEN+1)
  704.       LEN=LEN+2
  705.       M=YRNPAD+LEN
  706.       DO 13 N=1,M
  707.        IC=YRPAD
  708.        IF(N.LE.LEN) CALL ILBYTE(IC,SBUF,LEN-N)
  709. 13    CALL ISBYTE(IC,SBUF,M-N)
  710. C
  711.       CALL SYSIO(QBLK,33,LLU,SBUF,M,0,Y'00000000')   ; SEND IT
  712. C
  713.       IF(PAKTYP.EQ.BR)  GO TO 15
  714.        POINTR=0
  715.       IF(IER.LE.4.AND.RETRY.GE.1) GO TO 1
  716. 14    REPORT=CONMSG(8)                      ; READ-PACK ERROR
  717.       CALL SYSIO(PBLK,40,LLU,NCOD(IER),4,0,0)
  718. 15    CALL WAIT(3000,1,J)                   ; A BRIEF DELAY ...
  719.       RETURN
  720.       END
  721. $PROG SEND
  722. C
  723. C
  724.       SUBROUTINE SEND(FLAG)
  725.       IMPLICIT INTEGER(A-Z)
  726.       INTEGER FLAG,NAME(3),FD(4)
  727.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  728.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  729.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  730.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  731.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  732.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  733.       DATA CRLF/Y'00000D0A'/
  734. C
  735. C
  736.       SEQNCE=32
  737. C
  738. C  >> PACKET TYPES;
  739. C
  740. C     SI-NIT    ---   "S"
  741. C     FN-AME    ---   "F"
  742. C     DA-TA     ---   "D"
  743. C     ER-ROR    ---   "E"
  744. C     BR-EAK    ---   "B"
  745. C     EF-ILE    ---   "Z"
  746. C
  747. C
  748. C  >> INSURE PACKET NEVER EXCEEDS YRMAX <<
  749. C
  750.       YRLIM=YRMAX-3
  751. C
  752.       PAKTYP=ER
  753.       BRANCH=0
  754.       BEGIN=0
  755.       CALL EXPDFD(FLAG)
  756.       REWIND DIR
  757.       FD(1)=RBUF(1)
  758.       FD(2)=RBUF(2)
  759.       FD(3)=RBUF(3)
  760.       FD(4)=RBUF(4)
  761.       FLAG=1
  762.       RETRY=6                               ; ALLOW 5 TRIES ...
  763.       CALL SYSIO(PBLK,88,DIR,RBUF,20,0,0)   ; DUMMY
  764.       CALL SYSIO(PBLK,88,DIR,RBUF,20,0,0)   ; DUMMY
  765.       REPORT=CONMSG(22)                     ; RETURN & RECEIVE
  766.       CALL WAIT(5000,1,IER)                 ; ALLOW 5 SECONDS ...
  767. 1     CALL SYSIO(PBLK,72,DIR,RBUF,20,0,0)   ; GET NEXT DIR ENTRY
  768.       IER=IAND(PBLK(1),Y'FFFF')
  769.       IF(IER.EQ.0) GO TO 2
  770.        IF(FLAG.LE.1) GO TO 3
  771.        IF(PAKTYP.EQ.BR.OR.BRANCH.NE.1) RETURN  ; FINISHED ...
  772.        PAKTYP=BR
  773.        LEN=3
  774.        POINTR=0
  775.        CALL ISBYTE(PAKTYP,SBUF,3)
  776.        BRANCH=1                             ; RETURN TO 1
  777.        LGTH=1
  778.        FLAG=6
  779.        GO TO 14
  780. 2     IF(COMPFD(FD,RBUF,0).NE.1) GO TO 1    ; NOT SELECTED
  781.       FLAG=5                                ; SELECTED
  782.       BEGIN=BEGIN+1
  783.       CALL CLOSE(FILE,IER)
  784.       NAME(1)=RBUF(1)
  785.       NAME(2)=RBUF(2)
  786.       NAME(3)=RBUF(3)
  787.       CALL OPENW(FILE,NAME,4,0,0,IER)       ; ACCESS FILE ...
  788.       IF(IER.LE.0) GO TO 4
  789. 3      REPORT=CONMSG(20)                    ; FILE ACCESS ERROR
  790.        CALL SYSIO(PBLK,40,LLU,RBUF(FLAG),12,0,0)   ; FNAME
  791.        RETURN
  792. 4     POINTR=0
  793.       PAKTYP=SI                             ; BEGIN W/SINIT
  794.       IF(BEGIN.GT.1) PAKTYP=FN              ; -- IF FIRST OF A SET
  795. C
  796. 5      BRANCH=2                             ; RETURN TO 5
  797.        IF(PAKTYP.NE.SI) GO TO 6
  798.        CALL ISBYTE(PAKTYP,SBUF,3)           ; SET TYPE IN PACKET
  799.        LEN=12
  800.        SEQNCE=32
  801.        PAKTYP=FN                            ; NEXT TYPE
  802.        CALL SETPAR(SBUF,-1)                 ; SET UP SINIT PACKET
  803.        LGTH=1
  804.        FLAG=6
  805.        GO TO 14
  806. 6     IF(PAKTYP.NE.FN) GO TO 8
  807.        LEN=3
  808.         DO 7 NB=1,12
  809.         CALL ILBYTE(IC,NAME,NB-1)
  810.         CALL ISBYTE(32,SBUF,NB+3)
  811.         IF(IC.LE.32.OR.IC.GT.125) GO TO 7
  812.          LEN=LEN+1
  813.          CALL ISBYTE(IC,SBUF,LEN)
  814. 7      CONTINUE
  815.        CALL ISBYTE(PAKTYP,SBUF,3)           ; SET TYPE IN PACKET
  816.        PAKTYP=DA                            ; NEXT TYPE
  817.        POINTR=4
  818.        LGTH=1
  819.        FLAG=6
  820.        GO TO 14
  821. 8     IF(PAKTYP.NE.EF.AND.PAKTYP.NE.BR) GO TO 9
  822.        BRANCH=1                             ; RETURN TO 1
  823.        LEN=3
  824.        CALL ISBYTE(PAKTYP,SBUF,3)           ; SET TYPE IN PACKET
  825.        POINTR=0                             ; NO MORE DATA ...
  826.        LGTH=1
  827.        FLAG=6
  828.        GO TO 14
  829. 9     IF(PAKTYP.NE.DA) GO TO 24             ; ERROR PACKET ...
  830.        LEN=0
  831.        CALL SYSIO(PBLK,88,FILE,DBUF,256,0,0); READ IN MAX DATA
  832.        IER=IAND(PBLK(1),Y'FFFF')
  833.        CALL ISBYTE(PAKTYP,SBUF,3)           ; WAS DATA ...
  834.        IF(IER.EQ.0) GO TO 11
  835.         PAKTYP=EF                           ; FLAG END-OF-DATA
  836.         IF(POINTR.LE.4) GO TO 8
  837.         LGTH=1
  838.         FLAG=6
  839.         GO TO 14
  840. 11    LGTH=PBLK(5)
  841.       FLAG=0
  842.       IF(MODE.NE.0) GO TO 14                ; ALL OUT FOR BINARY
  843.       M=LGTH
  844.       LGTH=0
  845.       DO 12 N=1,M
  846.        CALL ILBYTE(IC,DBUF,N-1)
  847.        IC=IAND(IC,127)                      ; IF ASCII - MAX=127
  848.        IF(IC.GT.32) LGTH=N
  849.        IF(IC.LT.32) GO TO 13
  850. 12    CONTINUE
  851. 13    LGTH=LGTH+2
  852.       CALL ISBYTE(13,DBUF,LGTH-2)           ; CR
  853.       CALL ISBYTE(10,DBUF,LGTH-1)           ; LF
  854. 14    DO 23 N=1,LGTH
  855.        IF(FLAG.EQ.6) GO TO 17
  856.        CALL ILBYTE(DATUM,DBUF,N-1)
  857.        IF(DATUM.LE.127.OR.QUOT8B.EQ.0) GO TO 15
  858.         CALL ISBYTE(YRFG0,SBUF,POINTR)
  859.         POINTR=POINTR+1
  860.         DATUM=FLIPB0(DATUM)
  861. 15     JC=IAND(DATUM,Y'7F')
  862.        IF(JC.GE.32.AND.JC.LE.126.AND.JC.NE.YRCTL.AND.JC.NE.YRFG0)
  863.      + GO TO 16
  864.         IF(YRCTL.EQ.NAK) GO TO 16           ; ON "N" USE RAW ...
  865.          IF(JC.EQ.YRFG0.AND.QUOT8B.EQ.0) GO TO 16
  866.           CALL ISBYTE(YRCTL,SBUF,POINTR)
  867.           POINTR=POINTR+1
  868.           IF(DATUM.NE.YRCTL.AND.DATUM.NE.YRFG0)
  869.      +    DATUM=CTL(JC)
  870. 16     CALL ISBYTE(DATUM,SBUF,POINTR)
  871.        POINTR=POINTR+1
  872.        BRANCH=3                             ; RETURN TO 23
  873.        IF(POINTR.LT.YRLIM) GO TO 23
  874. 17     IF(LEN.LE.0.AND.POINTR.LE.4) GO TO 22
  875.         CALL ISBYTE(SOH,SBUF,0)
  876.         IF(POINTR.GT.4) LEN=POINTR-1
  877.         CALL ISBYTE(LEN+32,SBUF,1)
  878.         CALL ISBYTE(SEQNCE,SBUF,2)
  879.         CALL ISBYTE(CKSUM(SBUF),SBUF,LEN+1)
  880.         CALL ISBYTE(YREOL,SBUF,LEN+2)
  881.         LEN=LEN+3
  882.         IF(YRNPAD.LT.1) GO TO 19
  883.         L=LEN+YRNPAD
  884.         DO 18 M=1,L
  885.          IC=YRPAD
  886.          IF(M.LE.LEN) CALL ILBYTE(IC,SBUF,LEN-M)
  887. 18      CALL ISBYTE(IC,SBUF,L-M)
  888.         LEN=LEN+YRNPAD
  889. 19      CALL SYSIO(PBLK,33,LLU,SBUF,LEN,0,0); SEND IT OFF
  890.         POINTR=4
  891.         CALL SYSIO(RBLK,73,CLU,RBUF,200,0,Y'18000000')   ; GET RESP
  892.         PTR=0
  893. 20      CALL ILBYTE(KC,RBUF,PTR)
  894.         PTR=PTR+1
  895.         IF(KC.NE.SOH.AND.PTR.LT.100) GO TO 20
  896.          IF(KC.NE.SOH) GO TO 25
  897.          CALL ILBYTE(JC,RBUF,PTR+1)         ; GET SEQNCE
  898.          CALL ILBYTE(KC,RBUF,PTR+2)         ; GET RESPONSE
  899.          IF(KC.EQ.ACK.AND.JC.EQ.SEQNCE) GO TO 21
  900.          CALL WAIT(500,1,IER)               ; WAIT BEFORE RETRY
  901.          RETRY=RETRY-1
  902.          IF(RETRY.GT.0) GO TO 19            ; TRY AGAIN
  903.           CALL WAIT(5000,1,IER)             ; GIVE UP ...
  904.           REPORT=CONMSG(23)                 ; SEND ERROR
  905.           IF(KC.EQ.ER) GO TO 24
  906.           RETURN
  907. 21      SEQNCE=SEQNCE+1
  908.         IF(SEQNCE.GT.95) SEQNCE=32
  909.         RETRY=6
  910.         IF(PAKTYP.EQ.FN) CALL SETPAR(RBUF,PTR-1) ; HIS REPLY TO SI
  911. 22      GO TO (1,5,23),BRANCH
  912. 23    CONTINUE
  913.       GO TO 5                               ; NEXT DBUF ...
  914. C
  915. 24    CALL ILBYTE(LEN,RBUF,1)               ; LENGTH OF ERR PACKET
  916.       LEN=LEN-30
  917.       REPORT=CONMSG(24)                     ; REPORT EPACK
  918.       IF(LEN.GT.0) CALL SYSIO(PBLK,41,LLU,RBUF(2),LEN,0,0)
  919. 25    RETURN
  920.       END
  921. $PROG SETPAR
  922. C
  923. C
  924.       SUBROUTINE SETPAR(BUFF,CODE)
  925.       IMPLICIT INTEGER (A-Z)
  926.       INTEGER BUFF(1),CODE
  927. C
  928. C  >> ON CODE = 0;  WE'RE RECEIVING - GOT HIS - TELL HIM OURS
  929. C             < 0;  SET OUR PARAMS FOR SEND INIT TO CALLER
  930. C             > 0;  WE'RE SENDING - GOT HIS - MATCH THINGS UP
  931. C
  932.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  933.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  934.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  935.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  936.       IF(CODE.LT.0) GO TO 1
  937.       CALL ILBYTE(YRMAX,BUFF,4+CODE)
  938.       YRMAX=YRMAX-32
  939.       CALL ILBYTE(YRTIM,BUFF,5+CODE)
  940.       YRTIM=YRTIM-32
  941.       CALL ILBYTE(YRNPAD,BUFF,6+CODE)
  942.       YRNPAD=YRNPAD-32
  943.       CALL ILBYTE(YRPAD,BUFF,7+CODE)
  944.       YRPAD=CTL(YRPAD)
  945.       CALL ILBYTE(YREOL,BUFF,8+CODE)
  946.       YREOL=YREOL-32
  947.       CALL ILBYTE(YRCTL,BUFF,9+CODE)
  948.       CALL ILBYTE(YRFG0,BUFF,10+CODE)
  949.       CALL ILBYTE(YRCKT,BUFF,11+CODE)
  950.       YRCKT=YRCKT-48
  951.       CALL ILBYTE(YRRPT,BUFF,12+CODE)
  952. 1     CALL ISBYTE(MYMAX+32,BUFF,4)
  953.       CALL ISBYTE(MYTIM+32,BUFF,5)
  954.       CALL ISBYTE(MYNPAD+32,BUFF,6)
  955.       CALL ISBYTE(CTL(MYPAD),BUFF,7)
  956.       CALL ISBYTE(MYEOL+32,BUFF,8)
  957.       CALL ISBYTE(MYCTL,BUFF,9)
  958.        IF(YRFG0.EQ.ACK) YRFG0=MYFG0         ; "Y" MEANS "YOURS"
  959.        IF(MYFG0.NE.YRFG0.AND.YRFG0.NE.ACK) QUOT8B=0
  960.        J=32
  961.        IF(CODE.LT.0) J=ACK                  ; OKAY BY US ..
  962.        IF(QUOT8B.NE.0) J=MYFG0
  963.       CALL ISBYTE(J,BUFF,10)
  964.       CALL ISBYTE(49,BUFF,11)               ; 1
  965.       CALL ISBYTE(MYRPT,BUFF,12)            ; N
  966. C
  967.       CALL ISBYTE(44,BUFF,1)
  968. C
  969.       RETURN
  970.       END
  971. $PROG STATUS
  972. C
  973. C
  974.       SUBROUTINE STATUS
  975.       IMPLICIT INTEGER (A-Z)
  976.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  977.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  978.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  979.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  980.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  981.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  982.       NONE='NONE'
  983.       IF(LLU.NE.1) RETURN                   ; INTERACTIVE ONLY
  984.       REPORT=CONMSG(1)                      ; CLEAR SCREEN
  985.       REPORT=CONMSG(9)                      ; STATUS BANNER
  986.       REPORT=CONMSG(10)                     ; SOH MESSG
  987.       CALL SYSIO(PBLK,40,LLU,NCOD(SOH),4,0,0)   ; SOH VALUE
  988.       REPORT=CONMSG(11)                     ; EOL MESSG
  989.       CALL SYSIO(PBLK,40,LLU,NCOD(MYEOL),4,0,0)  ; EOL VALUE
  990.       REPORT=CONMSG(12)                     ; PACKET MESSG
  991.       CALL SYSIO(PBLK,40,LLU,NCOD(MYMAX),4,0,0)   ; MYMAX VALUE
  992.       REPORT=CONMSG(13)                     ; MYNPAD MESSG
  993.       CALL SYSIO(PBLK,40,LLU,NCOD(MYNPAD),4,0,0)  ; MYNPAD VALUE
  994.       REPORT=CONMSG(14)                     ; MYPAD MESSG
  995.       CALL SYSIO(PBLK,40,LLU,NCOD(MYPAD),4,0,0)  ; MYPAD
  996.       REPORT=CONMSG(15)                     ; MYCTL MESSG
  997.       CALL SYSIO(PBLK,40,LLU,MYCTL,4,0,0)   ; MYCTL VALUE
  998.       REPORT=CONMSG(16)                     ; MYFG0 MESSG
  999.       J=MYFG0
  1000.       IF(QUOT8B.LE.0) J='OFF '
  1001.       CALL SYSIO(PBLK,40,LLU,J,4,0,0)       ; MYFG0 VALUE
  1002.       REPORT=CONMSG(17)                     ; RECORD MESSG
  1003.       CALL SYSIO(PBLK,40,LLU,NCOD(RECORD),4,0,0)  ; RECORD VALUE
  1004.       RBUF(1)='ASCI'
  1005.       RBUF(2)='I   '
  1006.       IF(MODE.LE.0) GO TO 1
  1007.        RBUF(1)='BINA'
  1008.        RBUF(2)='RY  '
  1009. 1     REPORT=CONMSG(18)                     ; MODE MESSAGE
  1010.       CALL SYSIO(PBLK,40,LLU,RBUF,6,0,0)    ; MODE VALUE
  1011.       REPORT=CONMSG(19)                     ; PARITY MESSG
  1012.       CALL SYSIO(PBLK,40,LLU,NONE,4,0,0)    ; PARITY VALUE
  1013.       RETURN
  1014.       END
  1015. $PROG STORE
  1016. C
  1017. C
  1018.       SUBROUTINE STORE
  1019. C
  1020. C  >> DECODES A RECEIVED PACKET FROM SBUF INTO DBUF
  1021. C  >>  - <CR> FOR ASCII FILES (QUOT8B - <= 0),
  1022. C  >>    OR BYTE COUNT => RECORD, CAUSES I/O TO LU #2.
  1023. C
  1024. C  >>  NOTE: CALL TO XSTORE AFTER RECEIV COMPLETION
  1025. C  >>   IS REQUIRED TO FLUSH FINAL RECORD (IF ANY).
  1026. C
  1027.       IMPLICIT INTEGER (A-Z)
  1028.       INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
  1029.       COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
  1030.       COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
  1031.      +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
  1032.      +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
  1033.       COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
  1034.       DATA POINTR,CRLF/0,Y'00000D0A'/
  1035. C
  1036.       DATA FLAG1,FLAG0,LAST/0,0,0/
  1037. C
  1038.       CALL ILBYTE(LEN,SBUF,1)
  1039.       LEN=LEN-32
  1040.       WFLAG=0
  1041.       DO 4 N=4,LEN
  1042.        CALL ILBYTE(IC,SBUF,N)
  1043.        IF(IC.NE.MYFG0) GO TO 1
  1044.         IF(FLAG1.NE.0.OR.QUOT8B.EQ.0) GO TO 3   ; "&" OR "#&"
  1045.          FLAG0=1                            ; RECEIVED "QUOTE"
  1046.          GO TO 4
  1047. 1      IF(IC.NE.MYCTL) GO TO 2
  1048.         IF(FLAG1.NE.0.OR.MYCTL.EQ.NAK) GO TO 3   ; "##" OR "#"/RAW
  1049.          FLAG1=1                            ; RECEIVED "CTL"
  1050.          GO TO 4
  1051. 2      IF(FLAG0.NE.0) IC=FLIPB0(IC)         ; SET BIT 0
  1052.        IF(FLAG1.NE.0) IC=CTL(IC)            ; SET BIT 1
  1053. 3      IF(MODE.EQ.0) IC=IAND(IC,Y'7F')      ; STRIP BIT 0
  1054.        CALL ISBYTE(IC,DBUF,POINTR)          ; PLACE IN BUFFER
  1055.        POINTR=POINTR+1
  1056.        IC=IAND(IC,127)
  1057.        FLAG0=0
  1058.        FLAG1=0
  1059.        CALL ILBYTE(JC,LAST,3)
  1060.        CALL ISBYTE(IC,LAST,3)
  1061.        CALL ISBYTE(JC,LAST,2)
  1062.        IF(POINTR.GE.RECORD) WFLAG=1
  1063.        IF(LAST.EQ.CRLF.AND.MODE.EQ.0) WFLAG=1
  1064.        IF(WFLAG.EQ.0) GO TO 4
  1065.        K=33                                 ; IMAGE WRITE & PROCEED
  1066.        IF(MODE.LE.0) K=32                   ; ASCII WRITE & PROCEED
  1067.        IF(LAST.EQ.CRLF.AND.MODE.EQ.0) POINTR=POINTR-2
  1068.         IF(POINTR.GT.0) CALL SYSIO(RBLK,K,FILE,DBUF,POINTR,0,0)
  1069.        POINTR=0
  1070.         IF(WFLAG.GT.1) RETURN
  1071.        WFLAG=0
  1072. 4     CONTINUE
  1073.       RETURN
  1074. C
  1075.       ENTRY XSTORE                          ; CLEAN UP SHOP
  1076. C
  1077.       FLAG1=0
  1078.       FLAG0=0
  1079.       LAST=0
  1080. C
  1081.       K=33                                 ; IMAGE WRITE & PROCEED
  1082.       IF(MODE.LE.0) K=32                   ; ASCII WRITE & PROCEED
  1083.       IF(LAST.EQ.CRLF.AND.MODE.EQ.0) POINTR=POINTR-2
  1084.        IF(POINTR.GT.0) CALL SYSIO(RBLK,K,FILE,DBUF,POINTR,0,0)
  1085.       POINTR=0
  1086.       RETURN
  1087.       END
  1088. $BEND
  1089.