$BATCH
$PROG PEKERMIT
      IMPLICIT INTEGER (A-Z)
      INTEGER COMNDS(15)
C
      LOGICAL HLPFLG
C
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
C
      DATA COMNDS/'8BIT','DIRE','EXIT','HELP','LINE','MODE','NPAD',
     +'PACK','PAD-','QUIT','RECE','SEND','SOH ','STAT','TYPE'/
C
      SPACE=Y'20202020'
      BKSPC=Y'08080808'
      BELL=Y'07070707'
      DELE=8
      CTLX=24
C
      DASH=45                               ; -
      STAR=42                               ; *
      PERIOD=46                             ; .
      BSLSH=92                              ; \
      COLON=58                              ; :
C
      SOH=15
      MYEOL=13
      YREOL=MYEOL
      MYCTL=35
      YRCTL=MYCTL
      MYFG0=38
      QUOT8B=0
      MYMAX=50
      YRMAX=94
      MYTIM=8
      YRTIM=MYTIM
      MYNPAD=0
      YRNPAD=MYNPAD
      MYPAD=0
      YRPAD=MYPAD
      MYRPT=78                              ; USE "~"(126), FOR RPTS
      RECORD=80
      MODE=0                                ; DEFAULT TO ASCII MODE
C
      SI=83                                 ; "S"
      FN=70                                 ; "F"
      DA=68                                 ; "D"
      ER=69                                 ; "E"
      BR=66                                 ; "B"
      EF=90                                 ; "Z"
      ACK=89                                ; "Y"
      NAK=78                                ; "N"
      SEQNCE=32
C
      CLU=2                                 ; INITIAL MODE IS BATCH
      LLU=15                                ; 15 NORMALLY UNASSIGNED
      FILE=2
      DIR=3
      PRMPT=14
C
      HELP=63                               ; => ?
      INIT=0
C  >> START WITH A [CLS] <<
      REPORT=CONMSG(1)                      ; CLS
C  >> [<CR><LF><SP>PEKERMIT]
1     REPORT=CONMSG(2)                      ; PROMPT
      POINTR=0
      NTODO=0
      VALUE=0
      FLAG=0
2     IC=GETCH(0)
      IF(INIT.EQ.2) INIT=0
      IF(IC.EQ.SOH.AND.INIT.EQ.0) INIT=1
      IF(IC.EQ.MYEOL.AND.INIT.EQ.1) INIT=2
      IF(INIT.NE.0) GO TO 2                 ; IGNORE EXCESS PACKETS
      IF(IC.EQ.MYPAD) GO TO 2               ; IGNORE INADVERTENT PADS
      IF(IC.NE.DELE.AND.IC.NE.CTLX) GO TO 3
       IF(IC.EQ.CTLX) CALL SYSIO(PBLK,41,LLU,BKSPC,1,0,0)
       CALL SYSIO(PBLK,41,LLU,SPACE,1,0,0)  ; OVERWRITE CHAR
       CALL SYSIO(PBLK,41,LLU,BKSPC,1,0,0)  ; BACKSPACE
       IF(IC.EQ.CTLX) GO TO 1               ; CTRL-X
       POINTR=POINTR-1
       IF(POINTR.GE.0) CALL ILBYTE(IC,RBUF,POINTR)
       IF(IC.GE.48.AND.IC.LE.57) VALUE=VALUE/10
       IF(FLAG.GT.POINTR) FLAG=POINTR
       IF(POINTR.GT.0) GO TO 2
       CALL SYSIO(PBLK,41,LLU,BELL,1,0,0)
       GO TO 1
3     IF(IC.GE.97.AND.IC.LE.122) IC=IC-32
      IF(IC.EQ.13.OR.IC.EQ.HELP) GO TO 4    ; HELP CHAR DEF = ?
      IF(IC.GE.48.AND.IC.LE.57.AND.POINTR.GT.0) VALUE=10*VALUE+IC-48
       CALL ISBYTE(IC,RBUF,POINTR)
       IF(IC.GE.65.AND.NTODO.EQ.POINTR) NTODO=NTODO+1
       IF(IC.LT.65.AND.FLAG.LE.0.AND.POINTR.NE.0) FLAG=POINTR+1
C
        IF(IC.EQ.56.AND.POINTR.EQ.0) NTODO=NTODO+1
C
       POINTR=POINTR+1
       GO TO 2
C
C  >> COMMAND PARSER <<
C
4     I=-1                                  ; INDICATES FULL-HELP
      IF(POINTR.LE.0) GO TO 301
      IF(NTODO.GT.4) NTODO=4
      I=0
      J=0
      K=0
      DO 6 M=1,15
        DO 5 L=1,NTODO
         CALL ILBYTE(L1,RBUF,L-1)
         CALL ILBYTE(L2,COMNDS(M),L-1)
         IF(L1.NE.L2) GO TO 6
5       CONTINUE
        J=M
        IF(K.EQ.0) K=J
        IF(J.EQ.M) CALL BSET(I,M-1)
        IF(J.EQ.K.AND.K.EQ.4) I=-1
6       CONTINUE
       IF(J.EQ.K.AND.K.EQ.0) I=-1
       IF(K.EQ.J.AND.K.NE.0.AND.IC.NE.HELP) GO TO 8
7      REPORT=CONMSG(1)                     ; CLS
       IF(IC.EQ.HELP) GO TO 9
       REPORT=CONMSG(3)                     ; UNKNOWN COMMAND
       IF(POINTR.GT.0) CALL SYSIO(PBLK,41,LLU,RBUF,POINTR,0,0)
       IF(POINTR.LE.0) CALL SYSIO(PBLK,40,LLU,SPACE,1,0,0)
       GO TO 9
8     CONTINUE
      GO TO (1400,100,200,300,1000,400,500,600,700,800,900,1100,
     +1500,1200,1300),K
C
C  >> HELP FUNCTION - LEVEL 1 <<
C
9     REPORT=CONMSG(5)                      ; HELP SCREEN BANNER
      DO 10 N=1,15
       IF(COMNDS(N).LE.'    ') GO TO 10
        HLPFLG=BTEST(I,N-1)
        IF(.NOT.HLPFLG) GO TO 10
         REPORT=CONMSG(6)                   ; (NEW LINE)
         IER=N+25
         REPORT=CONMSG(IER)                 ; HELP LINE #N+1
10    CONTINUE
      REPORT=CONMSG(6)                      ; (NEW LINE)
      GO TO 1
C
C  >> DIRECTORY <<
C
100   IF(FLAG.LE.0) RBUF(1)='*.* '
      CALL EXPDFD(FLAG)
      REWIND DIR
      REPORT=CONMSG(6)                      ; (NEW LINE)
      CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0)
      CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0)
      CALL SYSIO(PBLK,40,LLU,RBUF(5),20,0,0)
      CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0)
      REPORT=CONMSG(6)
      COUNT=3
101   CALL SYSIO(PBLK,72,DIR,RBUF(5),20,0,0)
      IER=IAND(PBLK(1),Y'FFFF')
      IF(IER.NE.0) GO TO 1
      IER=COMPFD(RBUF,RBUF(5),1)
      IF(IER.EQ.0) GO TO 101
C
       CALL ISBYTE(32,RBUF(5),13)
       CALL ILBYTE(IC,RBUF(5),14)
       IF(IC.NE.35) CALL ISBYTE(32,RBUF(5),14)  ; CLEAR OUT GARBAGE
C
       CALL SYSIO(PBLK,40,LLU,RBUF(5),15,0,0)
       COUNT=COUNT+1
       IF(COUNT.LT.23) GO TO 101
        COUNT=0
        REPORT=CONMSG(21)                   ; CONTINUE PROMPT
        IC=GETCH(0)
        IF(IC.EQ.81.OR.IC.EQ.113) GO TO 1
        REPORT=CONMSG(1)                    ; CLS
         GO TO 101
C
C  >> EXIT <<
C
200   REPORT=CONMSG(1)                      ; CLS
      REPORT=CONMSG(4)                      ; LOGOFF...
      DO 201 N=1,15
201   CALL CLOSE(N-1,IER)
      CALL EXIT
C
C  >> HELP <<
300   I=-1
301   REPORT=CONMSG(1)                      ; CLS
      GO TO 9
C
C  >> MODE <<
C
400   IC=MODE
      IF(FLAG.GT.0) CALL ILBYTE(IC,RBUF,FLAG)
      IF(IC.EQ.65.OR.IC.EQ.66) IC=66-IC
      MODE=1-IC
      REPORT=CONMSG(6)
      REPORT=CONMSG(18)
      RBUF(1)='ASCI'
      RBUF(2)='I   '
      IF(MODE.LE.0) GO TO 401
       RBUF(1)='BINA'
       RBUF(2)='RY  '
401   CALL SYSIO(PBLK,40,LLU,RBUF,7,0,0)
      GO TO 1
C
C  >> NPADS <<
C
500   IF(VALUE.LT.0.OR.VALUE.GT.64) GO TO 301
      MYNPAD=VALUE
      REPORT=CONMSG(6)
      REPORT=CONMSG(13)
      CALL SYSIO(PBLK,40,LLU,NCOD(MYNPAD),4,0,0)
      GO TO 1
C
C  >> PACK <<
C
600   IF(VALUE.LT.20.OR.VALUE.GT.94) GO TO 301   ; ILLEGAL
      MYMAX=VALUE
      YRMAX=MYMAX
      REPORT=CONMSG(6)
      REPORT=CONMSG(12)
      CALL SYSIO(PBLK,40,LLU,NCOD(MYMAX),4,0,0)
      GO TO 1
C
C  >> PADDING <<
C
700   IF((VALUE.LT.0.OR.VALUE.GT.32).AND.VALUE.NE.127) GO TO 301
      MYPAD=VALUE
      YRPAD=MYPAD
      REPORT=CONMSG(6)
      REPORT=CONMSG(14)
      CALL SYSIO(PBLK,40,LLU,NCOD(MYPAD),4,0,0)
      GO TO 1
C
C  >> QUIT <<
C
800   GO TO 200
C
C  >> RECEIV <<
C
900   CALL RECEIV
      GO TO 1
C
C  >> RECORD <<
C
1000  IF(VALUE.LT.1.OR.VALUE.GT.256) GO TO 301
      RECORD=VALUE
      REPORT=CONMSG(6)
      REPORT=CONMSG(17)
      CALL SYSIO(PBLK,40,LLU,NCOD(RECORD),4,0,0)
      GO TO 1
C
C  >> SEND <<
C
1100  IF(FLAG.LE.0) GO TO 7
      CALL SEND(FLAG)
      GO TO 1
C
C  >> STATUS <<
C
1200  CALL STATUS
      GO TO 1
C
C  >> TYPE <<
C
1300  IF(FLAG.LE.0) GO TO 7
      DO 1301 N=1,20
       CALL ILBYTE(IC,RBUF,FLAG)
       IF(IC.LT.32.OR.IC.GT.125) FLAG=N-1
       IF(FLAG.LT.N) IC=32
       FLAG=FLAG+1
1301  CALL ISBYTE(IC,RBUF,N-1)
      CALL CLOSE(FILE,IER)
      CALL OPENW(FILE,RBUF,4,0,0,IER)
      CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0)   ; NEW LINE
      COUNT=0
      IF(IER.LE.0) GO TO 1302
       REPORT=CONMSG(20)                    ; FILE ACCESS ERROR
       CALL SYSIO(PBLK,41,LLU,RBUF,20,0,0)
       REPORT=CONMSG(6)
       GO TO 1
1302  CALL SYSIO(PBLK,72,FILE,RBUF,126,0,0)
      IER=IAND(PBLK(1),Y'FFFF')
      IF(IER.NE.0) GO TO 1303
      LEN=PBLK(5)
      CALL SYSIO(PBLK,40,LLU,RBUF,LEN,0,0)
      COUNT=COUNT+1
      IF(COUNT.LT.23) GO TO 1302
      COUNT=0
      REPORT=CONMSG(21)                     ; CONTINUE PROMPT
      IC=GETCH(0)
      IF(IC.EQ.81.OR.IC.EQ.113) GO TO 1303
      CALL SYSIO(PBLK,40,LLU,SPACE,4,0,0)
      GO TO 1302
1303  CALL CLOSE(FILE,IER)
      GO TO 1
C
C  >> 8BIT <<
C
1400  QUOT8B=1-QUOT8B                       ; TOGGLE QUOT8B
      IF(VALUE.EQ.1) QUOT8B=VALUE
      IF(FLAG.LE.0) GO TO 1401
      CALL ILBYTE(IC,RBUF,FLAG+1)
      IF(IC.EQ.70.OR.IC.EQ.79) QUOT8B=0     ; "OFF" OR "NO"
      IF(IC.EQ.69.OR.IC.EQ.78) QUOT8B=1     ; "ON" OR "YES'
1401  REPORT=CONMSG(6)
      REPORT=CONMSG(16)
      RBUF(1)='OFF '
      IF(QUOT8B.EQ.1) RBUF(1)=MYFG0
      CALL SYSIO(PBLK,40,LLU,RBUF,4,0,0)
      GO TO 1
C
C  >> SOH <<
C
1500  IF((VALUE.LT.1.OR.VALUE.GT.31).AND.VALUE.NE.127) GO TO 301
      SOH=VALUE
      REPORT=CONMSG(6)
      REPORT=CONMSG(10)
      CALL SYSIO(PBLK,40,LLU,NCOD(SOH),4,0,0)
      GO TO 1
      END
$PROG CKSUM
C
C
      INTEGER FUNCTION CKSUM(BUFF)
      IMPLICIT INTEGER (A-Z)
      INTEGER BUFF(1)
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      CALL ILBYTE(LEN,BUFF,1)
      LEN=LEN-32
      CKSUM=0
      DO 1 N=1,LEN
       CALL ILBYTE(IC,BUFF,N)
1     CKSUM=CKSUM+IC
      CKSUM=IAND((CKSUM+IAND(CKSUM,Y'C0')/Y'40'),Y'3F')+32
      RETURN
      END
$PROG COMPFD
C
C
      INTEGER FUNCTION COMPFD(BUFF1,BUFF2,INPTR)
      IMPLICIT INTEGER(A-Z)
      INTEGER BUFF1(1),BUFF2(1),POINTR
      COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
C
C  >> COMPARES 12 BYTES IN BUFF1, BEGINNING WITH BYTE #0,
C     WITH 12 BYTES IN BUFF2, BEGINNING WITH BYTE #POINTR.
C     IF ANY BUFF1 BYTE WHICH IS NOT BACKSLASH OR PERIOD
C     DOES NOT MATCH THE COMPARABLE BUFF2 BYTE, RESULT=0
C     OTHERWISE, RESULT=1.
C
C     ON RESULT=1, BUFF2 WILL HOLD PACKED FD, STARTING AT BYTE #1
C
      POINTR=INPTR
      COMPFD=0
      DO 1 N=1,12
       CALL ILBYTE(IC,BUFF1,N-1)
       CALL ILBYTE(JC,BUFF2,N)
       CALL ISBYTE(32,BUFF2,N)
       IF(IC.NE.JC.AND.JC.NE.PERIOD.AND.IC.NE.BSLSH) RETURN
       IF(JC.LE.32) GO TO 1
        CALL ISBYTE(JC,BUFF2,POINTR)
        POINTR=POINTR+1
1     CONTINUE
      COMPFD=1
      RETURN
      END
$PROG CONMSG
C
C
      INTEGER FUNCTION CONMSG(NDX)
      IMPLICIT INTEGER(A-Z)
      INTEGER MBUF(20)
C
C  >> ALWAYS WRITES TO LLU IN IMAGE MODE <<
C  >> ERROR(S) RETURNED IN PBLK(1) USING STD SYSIO DEFINITIONS <<
C
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      CONMSG=-1
      IF(NDX.LE.0) RETURN
      N=NDX-1
      CALL SYSIO(PBLK,77,PRMPT,MBUF,80,N,0)
      CONMSG=IAND(PBLK(1),Y'FFFF')
      NBYTS=MBUF(1)
      IF(NBYTS.GT.80.AND.CONMSG.EQ.0) CONMSG=NBYTS
      IF(CONMSG.NE.0) RETURN
      IF(NBYTS.GT.0) CALL SYSIO(PBLK,41,LLU,MBUF(2),NBYTS,0,0)
      RETURN
      END
$PROG CTL
C
C
      INTEGER FUNCTION CTL(CH)
C
C
C  >>  TOGGLE BIT 1 OF THE LOW-ORDER BYTE OF CH (INT*4)
C  >>  (USED TO FORCE KERMIT DATA BYTES TO BE PRINTABLE)
C
      INTEGER CH
C
      CTL=IEOR(CH,64)                       ; FLIP BIT 1, BYTE 3
      RETURN
      END
$PROG EXPDFD
      SUBROUTINE EXPDFD(START)
C
C
      IMPLICIT INTEGER (A-Z)
      INTEGER START
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
      INPTR=START
      OUTPTR=0
1     CALL ILBYTE(IC,RBUF,INPTR)
      INPTR=INPTR+1
      IF(IC.NE.COLON) GO TO 2
       OUTPTR=0
2     IF(IC.NE.STAR.AND.IC.NE.DASH.AND.IC.NE.PERIOD.AND.IC.GT.32.AND.
     +IC.LT.126) GO TO 4
       JC=BSLSH
       IF(IC.EQ.PERIOD) JC=32
3      IF(OUTPTR.GE.9) JC=BSLSH
       IF(IC.EQ.PERIOD.AND.OUTPTR.GE.9) GO TO 5
       CALL ISBYTE(JC,RBUF,OUTPTR+28)
       OUTPTR=OUTPTR+1
       IF(OUTPTR.NE.9.AND.OUTPTR.LT.12) GO TO 3
       IF(OUTPTR.LT.12) GO TO 1
       GO TO 5
4     CALL ISBYTE(IC,RBUF,OUTPTR+28)
      OUTPTR=OUTPTR+1
5     IF(OUTPTR.LT.12.AND.IC.GT.32.AND.IC.LT.126) GO TO 1
      DO 6 N=1,24
       IC=32
       IF(N.LE.12) CALL ILBYTE(IC,RBUF,N+27)
6     CALL ISBYTE(IC,RBUF,N-1)
      RETURN
      END
$PROG FLIPB0
C
C
      INTEGER FUNCTION FLIPB0(CH)
C
C
C  >>  TOGGLE BIT 0 OF THE LOW-ORDER BYTE OF CH (INT*4)
C  >>  (FOR USE IN 7-BIT TRANSMISSION)
C
      INTEGER CH
C
      FLIPB0=IEOR(CH,128)                   ; FLIP BIT 0, BYTE 3
      RETURN
      END
$PROG GETCH
C
C
      INTEGER FUNCTION GETCH(DUMMY)
      IMPLICIT INTEGER (A-Z)
      INTEGER GBUF(20)
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
C
C     >> EXPECTS CLU TO BE 0 IF SINGLE CHARACTER I/O TO BE DONE <<
C     >>  - OTHERWISE DOES FULL-LINE I/O AND PASSES IT TO CALLER<<
C     >>    ONE BYTE PER CALL.  ON I/O ERROR WITH CLU.NE.0,     <<
C     >>    CLU IS RESET TO 0, LLU TO 1, AND I/0 CONTINUES.       <<
C
      DATA POINTR,NBYTS/0,0/
      IF(POINTR.LT.NBYTS) GO TO 2
1      NBYTS=1
       IF(CLU.NE.0) NBYTS=80
       CALL SYSIO(PBLK,73,CLU,GBUF,NBYTS,0,0)
       POINTR=0
       IER=IAND(PBLK(1),Y'FFFF')
       IF(IER.EQ.0) GO TO 2
       CALL CLOSE(FILE,IER)
       CLU=0
       LLU=1
       YREOL=MYEOL
       YRCTL=MYCTL
       YRFG0=MYFG0
       YRMAX=94
       YRTIM=MYTIM
       YRPAD=MYPAD
       CALL WAIT(100,1,IER)
       REPORT=CONMSG(1)                      ; CLS
       CALL STATUS
       REPORT=CONMSG(2)                      ; PROMPT
       GO TO 1
2     CALL ILBYTE(GETCH,GBUF,POINTR)
      POINTR=POINTR+1
      IF(GETCH.EQ.BSLSH.AND.CLU.NE.0) GETCH=13  ; END THE RECORD!
      IF(GETCH.EQ.13) NBYTS=POINTR
      RETURN
      END
$PROG NCOD
C
C
      INTEGER FUNCTION NCOD(IVAL)
      NCOD='    '
      IDIV=1000
      I=IVAL
      M=1
      DO 1 N=1,4
       J=I/IDIV
       I=I-IDIV*J
       IDIV=IDIV/10
       IF(J.GE.M.AND.J.LE.9) CALL ISBYTE(J+48,NCOD,N-1)
1     IF(J.GE.1.AND.J.LE.57) M=0
      IF(NCOD.LE.'    ') CALL ISBYTE(48,NCOD,3)
      RETURN
      END
$PROG OPNFIL
C
C
      SUBROUTINE OPNFIL(IER)
C
C  >> READS FILE NAME FROM A PACKET STARTING AT BYTE 0
C     IN SBUF:  IF FNAME EXISTS, DELETES FILE.
C               ALLOCATES FNAME,IN,RECORD
C               ASSIGNS TO <FILE>
C               UPDATES <DIR> IF NECESSARY.
C
      IMPLICIT INTEGER(A-Z)
      INTEGER NAME(6)
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      COMMON/CHRS/SPACE,BKSPC,BELL,DASH,STAR,PERIOD,COLON,BSLSH
      POINTR=4
      CALL ILBYTE(LEN,SBUF,1)
C
      LEN=LEN-32
      DO 1 N=1,24
       CALL ISBYTE(32,NAME,N-1)
       IF(POINTR.GT.LEN) GO TO 1
       CALL ILBYTE(IC,SBUF,POINTR)
       CALL ISBYTE(IC,NAME,N-1)
       POINTR=POINTR+1
1     CONTINUE
      CALL CLOSE(FILE,IER)
      CALL DFILW(NAME,0,0,JER)
      CALL CFILW(NAME,2,RECORD,1,1,0,0,IER)
      CALL OPENW(FILE,NAME,7,0,0,IER)
      IF(JER.EQ.0.OR.IER.NE.0) RETURN
C  >> FILE DIDN'T PREVIOUSLY EXIST <<
      POINTR=12
      DO 2 N=1,24
       CALL ILBYTE(IC,NAME,24-N)
       CALL ISBYTE(32,NAME,24-N)
       IF(IC.LE.32) GO TO 2
        CALL ISBYTE(IC,NAME,POINTR)
        IF(IC.EQ.PERIOD) POINTR=25-N
        POINTR=POINTR-1
2     CONTINUE
      CALL ISBYTE(35,NAME,14)
      CALL SYSIO(PBLK,132,DIR,0,0,0,0)
      CALL SYSIO(PBLK,40,DIR,NAME,15,0,0)
      RETURN
      END
$PROG RECEIV
C
C
      SUBROUTINE RECEIV
      IMPLICIT INTEGER(A-Z)
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
C
C  >> LU 2 RESERVED FOR FILE ACCESS
C
C  >> PACKET TYPES;
C
C     SI-NIT    ---   "S"
C     FN-AME    ---   "F"
C     DA-TA     ---   "D"
C     ER-ROR    ---   "E"
C     BR-EAK    ---   "B"
C     EF-ILE    ---   "Z"
C
C
      RETRY=5                               ; 5 TRIES ONLY
      REPORT=CONMSG(7)                      ; RETURN TO CALLER
C
C
      PAKTYP=ER
      PARM='-000'
      POINTR=0
      PASS=0
1     CALL SYSIO(PBLK,73,CLU,RBUF,80,0,Y'18000000')
      IER=IAND(PBLK(1),Y'FFFF')
      IF(IER.NE.0) GO TO 10
C
C  >> OKAY, WE HAVE DATA SEE HOW MUCH..
C
C  >>> NOTE: <<<
C      ON RAW I/O, THIS MODULE WOULD HAVE TO BE ALTERED
C      TO CONTINUE READS UNTIL A COMPLETE PACKET IS RECEIVED,
C      SINCE AN EMBEDDED RAW <CR> VALUE WOULD PRECIPITOUSLY
C      TERMINATE DATA I/O.
C
C
      DO 2 N=1,80
       CALL ILBYTE(IC,RBUF,N-1)
       IF(IC.NE.SOH.AND.POINTR.LE.0) GO TO 2; SKIP ANY PADS
       CALL ISBYTE(IC,SBUF,POINTR)
       IF(IC.EQ.MYEOL.AND.POINTR.NE.0) GO TO 3
       POINTR=POINTR+1
       IF(IC.NE.SOH) GO TO 2                ; UH-OH ... RESET!
        POINTR=1
        CALL ISBYTE(IC,SBUF,0)
        PASS=0
2     CONTINUE
C
C  >> UH-OH ... BAD PACKET (NO SOH OR NO EOL)
C  >>  SEND A NAK
C
      IER=1
      PARM='    '
      CALL ILBYTE(LEN,SBUF,1)
      LEN=LEN-32
      SIZE=LEN+MYNPAD+3
      IF(POINTR.LE.0.OR.PASS.NE.0) GO TO 10
      IF(SIZE.LE.80.OR.LEN.GT.94) GO TO 10
      PASS=PASS+1
      GO TO 1                               ; FINISH THE PACKET
C
C
3     IER=2
      PASS=0
      CALL ILBYTE(LEN,SBUF,1)
      LEN=LEN-31
      CALL ILBYTE(PAKTYP,SBUF,3)
      PARM=PAKTYP
      IF(PAKTYP.EQ.ER) GO TO 14             ; DID HE SEE PROBLEMS?
      IF(PAKTYP.NE.SI.AND.PAKTYP.NE.FN.AND.PAKTYP.NE.DA.AND.PAKTYP.
     +NE.BR.AND.PAKTYP.NE.EF) GO TO 10      ; UNKNOWN PAK TYPE
      IER=3
      PARM=NCOD(LEN-1)
      IF(LEN.LT.0.OR.LEN.GT.95) GO TO 10
      IER=4
      CALL ILBYTE(INCK,SBUF,LEN)            ; GET HIS CHEKSUM
      OUTCK=CKSUM(SBUF)                     ; GET MY CHECKSUM
      PARM=NCOD(INCK*100+OUTCK)
      IF(INCK.NE.OUTCK) GO TO 10            ; IF UNEQUAL, PROBLEMS..
      CALL ILBYTE(SEQNCE,SBUF,2)
      IER=0
      PARM='    '
      IF(PAKTYP.EQ.SI) CALL SETPAR(SBUF,0)
      IF(PAKTYP.EQ.FN) CALL OPNFIL(IER)
      IF(IER.NE.0) IER=IER+10
      IF(PAKTYP.EQ.DA) CALL STORE
      IF(PAKTYP.EQ.EF.OR.PAKTYP.EQ.BR) CALL XSTORE
10    RETRY=RETRY-1
      IF(IER.EQ.0) RETRY=5
      COND=ACK
      IF(IER.EQ.0) GO TO 11
       COND=NAK
       CALL ISBYTE(35,SBUF,1)
11    CALL ISBYTE(SOH,SBUF,0)
      IF(RETRY.GT.0.AND.IER.LE.4) GO TO 12
       COND=ER
       SBUF(2)='RECV'
       SBUF(3)=' ERR'
       SBUF(4)='OR #'
       SBUF(5)=NCOD(IER)
       SBUF(6)=PARM
       CALL ISBYTE(55,SBUF,1)
12    CALL ILBYTE(LEN,SBUF,1)
      LEN=LEN-31
      IF(COND.NE.ER.AND.PAKTYP.NE.SI) LEN=4
      CALL ISBYTE(LEN+31,SBUF,1)
      CALL ISBYTE(SEQNCE,SBUF,2)
      CALL ISBYTE(COND,SBUF,3)
      CALL ISBYTE(CKSUM(SBUF),SBUF,LEN)
      CALL ISBYTE(YREOL,SBUF,LEN+1)
      LEN=LEN+2
      M=YRNPAD+LEN
      DO 13 N=1,M
       IC=YRPAD
       IF(N.LE.LEN) CALL ILBYTE(IC,SBUF,LEN-N)
13    CALL ISBYTE(IC,SBUF,M-N)
C
      CALL SYSIO(QBLK,33,LLU,SBUF,M,0,Y'00000000')   ; SEND IT
C
      IF(PAKTYP.EQ.BR)  GO TO 15
       POINTR=0
      IF(IER.LE.4.AND.RETRY.GE.1) GO TO 1
14    REPORT=CONMSG(8)                      ; READ-PACK ERROR
      CALL SYSIO(PBLK,40,LLU,NCOD(IER),4,0,0)
15    CALL WAIT(3000,1,J)                   ; A BRIEF DELAY ...
      RETURN
      END
$PROG SEND
C
C
      SUBROUTINE SEND(FLAG)
      IMPLICIT INTEGER(A-Z)
      INTEGER FLAG,NAME(3),FD(4)
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      DATA CRLF/Y'00000D0A'/
C
C
      SEQNCE=32
C
C  >> PACKET TYPES;
C
C     SI-NIT    ---   "S"
C     FN-AME    ---   "F"
C     DA-TA     ---   "D"
C     ER-ROR    ---   "E"
C     BR-EAK    ---   "B"
C     EF-ILE    ---   "Z"
C
C
C  >> INSURE PACKET NEVER EXCEEDS YRMAX <<
C
      YRLIM=YRMAX-3
C
      PAKTYP=ER
      BRANCH=0
      BEGIN=0
      CALL EXPDFD(FLAG)
      REWIND DIR
      FD(1)=RBUF(1)
      FD(2)=RBUF(2)
      FD(3)=RBUF(3)
      FD(4)=RBUF(4)
      FLAG=1
      RETRY=6                               ; ALLOW 5 TRIES ...
      CALL SYSIO(PBLK,88,DIR,RBUF,20,0,0)   ; DUMMY
      CALL SYSIO(PBLK,88,DIR,RBUF,20,0,0)   ; DUMMY
      REPORT=CONMSG(22)                     ; RETURN & RECEIVE
      CALL WAIT(5000,1,IER)                 ; ALLOW 5 SECONDS ...
1     CALL SYSIO(PBLK,72,DIR,RBUF,20,0,0)   ; GET NEXT DIR ENTRY
      IER=IAND(PBLK(1),Y'FFFF')
      IF(IER.EQ.0) GO TO 2
       IF(FLAG.LE.1) GO TO 3
       IF(PAKTYP.EQ.BR.OR.BRANCH.NE.1) RETURN  ; FINISHED ...
       PAKTYP=BR
       LEN=3
       POINTR=0
       CALL ISBYTE(PAKTYP,SBUF,3)
       BRANCH=1                             ; RETURN TO 1
       LGTH=1
       FLAG=6
       GO TO 14
2     IF(COMPFD(FD,RBUF,0).NE.1) GO TO 1    ; NOT SELECTED
      FLAG=5                                ; SELECTED
      BEGIN=BEGIN+1
      CALL CLOSE(FILE,IER)
      NAME(1)=RBUF(1)
      NAME(2)=RBUF(2)
      NAME(3)=RBUF(3)
      CALL OPENW(FILE,NAME,4,0,0,IER)       ; ACCESS FILE ...
      IF(IER.LE.0) GO TO 4
3      REPORT=CONMSG(20)                    ; FILE ACCESS ERROR
       CALL SYSIO(PBLK,40,LLU,RBUF(FLAG),12,0,0)   ; FNAME
       RETURN
4     POINTR=0
      PAKTYP=SI                             ; BEGIN W/SINIT
      IF(BEGIN.GT.1) PAKTYP=FN              ; -- IF FIRST OF A SET
C
5      BRANCH=2                             ; RETURN TO 5
       IF(PAKTYP.NE.SI) GO TO 6
       CALL ISBYTE(PAKTYP,SBUF,3)           ; SET TYPE IN PACKET
       LEN=12
       SEQNCE=32
       PAKTYP=FN                            ; NEXT TYPE
       CALL SETPAR(SBUF,-1)                 ; SET UP SINIT PACKET
       LGTH=1
       FLAG=6
       GO TO 14
6     IF(PAKTYP.NE.FN) GO TO 8
       LEN=3
        DO 7 NB=1,12
        CALL ILBYTE(IC,NAME,NB-1)
        CALL ISBYTE(32,SBUF,NB+3)
        IF(IC.LE.32.OR.IC.GT.125) GO TO 7
         LEN=LEN+1
         CALL ISBYTE(IC,SBUF,LEN)
7      CONTINUE
       CALL ISBYTE(PAKTYP,SBUF,3)           ; SET TYPE IN PACKET
       PAKTYP=DA                            ; NEXT TYPE
       POINTR=4
       LGTH=1
       FLAG=6
       GO TO 14
8     IF(PAKTYP.NE.EF.AND.PAKTYP.NE.BR) GO TO 9
       BRANCH=1                             ; RETURN TO 1
       LEN=3
       CALL ISBYTE(PAKTYP,SBUF,3)           ; SET TYPE IN PACKET
       POINTR=0                             ; NO MORE DATA ...
       LGTH=1
       FLAG=6
       GO TO 14
9     IF(PAKTYP.NE.DA) GO TO 24             ; ERROR PACKET ...
       LEN=0
       CALL SYSIO(PBLK,88,FILE,DBUF,256,0,0); READ IN MAX DATA
       IER=IAND(PBLK(1),Y'FFFF')
       CALL ISBYTE(PAKTYP,SBUF,3)           ; WAS DATA ...
       IF(IER.EQ.0) GO TO 11
        PAKTYP=EF                           ; FLAG END-OF-DATA
        IF(POINTR.LE.4) GO TO 8
        LGTH=1
        FLAG=6
        GO TO 14
11    LGTH=PBLK(5)
      FLAG=0
      IF(MODE.NE.0) GO TO 14                ; ALL OUT FOR BINARY
      M=LGTH
      LGTH=0
      DO 12 N=1,M
       CALL ILBYTE(IC,DBUF,N-1)
       IC=IAND(IC,127)                      ; IF ASCII - MAX=127
       IF(IC.GT.32) LGTH=N
       IF(IC.LT.32) GO TO 13
12    CONTINUE
13    LGTH=LGTH+2
      CALL ISBYTE(13,DBUF,LGTH-2)           ; CR
      CALL ISBYTE(10,DBUF,LGTH-1)           ; LF
14    DO 23 N=1,LGTH
       IF(FLAG.EQ.6) GO TO 17
       CALL ILBYTE(DATUM,DBUF,N-1)
       IF(DATUM.LE.127.OR.QUOT8B.EQ.0) GO TO 15
        CALL ISBYTE(YRFG0,SBUF,POINTR)
        POINTR=POINTR+1
        DATUM=FLIPB0(DATUM)
15     JC=IAND(DATUM,Y'7F')
       IF(JC.GE.32.AND.JC.LE.126.AND.JC.NE.YRCTL.AND.JC.NE.YRFG0)
     + GO TO 16
        IF(YRCTL.EQ.NAK) GO TO 16           ; ON "N" USE RAW ...
         IF(JC.EQ.YRFG0.AND.QUOT8B.EQ.0) GO TO 16
          CALL ISBYTE(YRCTL,SBUF,POINTR)
          POINTR=POINTR+1
          IF(DATUM.NE.YRCTL.AND.DATUM.NE.YRFG0)
     +    DATUM=CTL(JC)
16     CALL ISBYTE(DATUM,SBUF,POINTR)
       POINTR=POINTR+1
       BRANCH=3                             ; RETURN TO 23
       IF(POINTR.LT.YRLIM) GO TO 23
17     IF(LEN.LE.0.AND.POINTR.LE.4) GO TO 22
        CALL ISBYTE(SOH,SBUF,0)
        IF(POINTR.GT.4) LEN=POINTR-1
        CALL ISBYTE(LEN+32,SBUF,1)
        CALL ISBYTE(SEQNCE,SBUF,2)
        CALL ISBYTE(CKSUM(SBUF),SBUF,LEN+1)
        CALL ISBYTE(YREOL,SBUF,LEN+2)
        LEN=LEN+3
        IF(YRNPAD.LT.1) GO TO 19
        L=LEN+YRNPAD
        DO 18 M=1,L
         IC=YRPAD
         IF(M.LE.LEN) CALL ILBYTE(IC,SBUF,LEN-M)
18      CALL ISBYTE(IC,SBUF,L-M)
        LEN=LEN+YRNPAD
19      CALL SYSIO(PBLK,33,LLU,SBUF,LEN,0,0); SEND IT OFF
        POINTR=4
        CALL SYSIO(RBLK,73,CLU,RBUF,200,0,Y'18000000')   ; GET RESP
        PTR=0
20      CALL ILBYTE(KC,RBUF,PTR)
        PTR=PTR+1
        IF(KC.NE.SOH.AND.PTR.LT.100) GO TO 20
         IF(KC.NE.SOH) GO TO 25
         CALL ILBYTE(JC,RBUF,PTR+1)         ; GET SEQNCE
         CALL ILBYTE(KC,RBUF,PTR+2)         ; GET RESPONSE
         IF(KC.EQ.ACK.AND.JC.EQ.SEQNCE) GO TO 21
         CALL WAIT(500,1,IER)               ; WAIT BEFORE RETRY
         RETRY=RETRY-1
         IF(RETRY.GT.0) GO TO 19            ; TRY AGAIN
          CALL WAIT(5000,1,IER)             ; GIVE UP ...
          REPORT=CONMSG(23)                 ; SEND ERROR
          IF(KC.EQ.ER) GO TO 24
          RETURN
21      SEQNCE=SEQNCE+1
        IF(SEQNCE.GT.95) SEQNCE=32
        RETRY=6
        IF(PAKTYP.EQ.FN) CALL SETPAR(RBUF,PTR-1) ; HIS REPLY TO SI
22      GO TO (1,5,23),BRANCH
23    CONTINUE
      GO TO 5                               ; NEXT DBUF ...
C
24    CALL ILBYTE(LEN,RBUF,1)               ; LENGTH OF ERR PACKET
      LEN=LEN-30
      REPORT=CONMSG(24)                     ; REPORT EPACK
      IF(LEN.GT.0) CALL SYSIO(PBLK,41,LLU,RBUF(2),LEN,0,0)
25    RETURN
      END
$PROG SETPAR
C
C
      SUBROUTINE SETPAR(BUFF,CODE)
      IMPLICIT INTEGER (A-Z)
      INTEGER BUFF(1),CODE
C
C  >> ON CODE = 0;  WE'RE RECEIVING - GOT HIS - TELL HIM OURS
C             < 0;  SET OUR PARAMS FOR SEND INIT TO CALLER
C             > 0;  WE'RE SENDING - GOT HIS - MATCH THINGS UP
C
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      IF(CODE.LT.0) GO TO 1
      CALL ILBYTE(YRMAX,BUFF,4+CODE)
      YRMAX=YRMAX-32
      CALL ILBYTE(YRTIM,BUFF,5+CODE)
      YRTIM=YRTIM-32
      CALL ILBYTE(YRNPAD,BUFF,6+CODE)
      YRNPAD=YRNPAD-32
      CALL ILBYTE(YRPAD,BUFF,7+CODE)
      YRPAD=CTL(YRPAD)
      CALL ILBYTE(YREOL,BUFF,8+CODE)
      YREOL=YREOL-32
      CALL ILBYTE(YRCTL,BUFF,9+CODE)
      CALL ILBYTE(YRFG0,BUFF,10+CODE)
      CALL ILBYTE(YRCKT,BUFF,11+CODE)
      YRCKT=YRCKT-48
      CALL ILBYTE(YRRPT,BUFF,12+CODE)
1     CALL ISBYTE(MYMAX+32,BUFF,4)
      CALL ISBYTE(MYTIM+32,BUFF,5)
      CALL ISBYTE(MYNPAD+32,BUFF,6)
      CALL ISBYTE(CTL(MYPAD),BUFF,7)
      CALL ISBYTE(MYEOL+32,BUFF,8)
      CALL ISBYTE(MYCTL,BUFF,9)
       IF(YRFG0.EQ.ACK) YRFG0=MYFG0         ; "Y" MEANS "YOURS"
       IF(MYFG0.NE.YRFG0.AND.YRFG0.NE.ACK) QUOT8B=0
       J=32
       IF(CODE.LT.0) J=ACK                  ; OKAY BY US ..
       IF(QUOT8B.NE.0) J=MYFG0
      CALL ISBYTE(J,BUFF,10)
      CALL ISBYTE(49,BUFF,11)               ; 1
      CALL ISBYTE(MYRPT,BUFF,12)            ; N
C
      CALL ISBYTE(44,BUFF,1)
C
      RETURN
      END
$PROG STATUS
C
C
      SUBROUTINE STATUS
      IMPLICIT INTEGER (A-Z)
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      NONE='NONE'
      IF(LLU.NE.1) RETURN                   ; INTERACTIVE ONLY
      REPORT=CONMSG(1)                      ; CLEAR SCREEN
      REPORT=CONMSG(9)                      ; STATUS BANNER
      REPORT=CONMSG(10)                     ; SOH MESSG
      CALL SYSIO(PBLK,40,LLU,NCOD(SOH),4,0,0)   ; SOH VALUE
      REPORT=CONMSG(11)                     ; EOL MESSG
      CALL SYSIO(PBLK,40,LLU,NCOD(MYEOL),4,0,0)  ; EOL VALUE
      REPORT=CONMSG(12)                     ; PACKET MESSG
      CALL SYSIO(PBLK,40,LLU,NCOD(MYMAX),4,0,0)   ; MYMAX VALUE
      REPORT=CONMSG(13)                     ; MYNPAD MESSG
      CALL SYSIO(PBLK,40,LLU,NCOD(MYNPAD),4,0,0)  ; MYNPAD VALUE
      REPORT=CONMSG(14)                     ; MYPAD MESSG
      CALL SYSIO(PBLK,40,LLU,NCOD(MYPAD),4,0,0)  ; MYPAD
      REPORT=CONMSG(15)                     ; MYCTL MESSG
      CALL SYSIO(PBLK,40,LLU,MYCTL,4,0,0)   ; MYCTL VALUE
      REPORT=CONMSG(16)                     ; MYFG0 MESSG
      J=MYFG0
      IF(QUOT8B.LE.0) J='OFF '
      CALL SYSIO(PBLK,40,LLU,J,4,0,0)       ; MYFG0 VALUE
      REPORT=CONMSG(17)                     ; RECORD MESSG
      CALL SYSIO(PBLK,40,LLU,NCOD(RECORD),4,0,0)  ; RECORD VALUE
      RBUF(1)='ASCI'
      RBUF(2)='I   '
      IF(MODE.LE.0) GO TO 1
       RBUF(1)='BINA'
       RBUF(2)='RY  '
1     REPORT=CONMSG(18)                     ; MODE MESSAGE
      CALL SYSIO(PBLK,40,LLU,RBUF,6,0,0)    ; MODE VALUE
      REPORT=CONMSG(19)                     ; PARITY MESSG
      CALL SYSIO(PBLK,40,LLU,NONE,4,0,0)    ; PARITY VALUE
      RETURN
      END
$PROG STORE
C
C
      SUBROUTINE STORE
C
C  >> DECODES A RECEIVED PACKET FROM SBUF INTO DBUF
C  >>  - <CR> FOR ASCII FILES (QUOT8B - <= 0),
C  >>    OR BYTE COUNT => RECORD, CAUSES I/O TO LU #2.
C
C  >>  NOTE: CALL TO XSTORE AFTER RECEIV COMPLETION
C  >>   IS REQUIRED TO FLUSH FINAL RECORD (IF ANY).
C
      IMPLICIT INTEGER (A-Z)
      INTEGER PBLK(6),QBLK(6),RBLK(6),RBUF(50),SBUF(50),DBUF(65)
      COMMON /IOSET/PBLK,QBLK,RBLK,RBUF,SBUF,DBUF
      COMMON /KERMIT/SOH,MYEOL,QUOT8B,SI,FN,DA,ER,BR,EF,MYPAD,YRPAD,
     +ACK,NAK,YRMAX,MYMAX,YRTIM,MYTIM,YRNPAD,MYNPAD,YREOL,YRCTL,
     +MYCTL,YRFG0,MYFG0,YRRPT,MYRPT,SEQNCE,RECORD,MODE
      COMMON/LUSET/CLU,LLU,FILE,DIR,PRMPT
      DATA POINTR,CRLF/0,Y'00000D0A'/
C
      DATA FLAG1,FLAG0,LAST/0,0,0/
C
      CALL ILBYTE(LEN,SBUF,1)
      LEN=LEN-32
      WFLAG=0
      DO 4 N=4,LEN
       CALL ILBYTE(IC,SBUF,N)
       IF(IC.NE.MYFG0) GO TO 1
        IF(FLAG1.NE.0.OR.QUOT8B.EQ.0) GO TO 3   ; "&" OR "#&"
         FLAG0=1                            ; RECEIVED "QUOTE"
         GO TO 4
1      IF(IC.NE.MYCTL) GO TO 2
        IF(FLAG1.NE.0.OR.MYCTL.EQ.NAK) GO TO 3   ; "##" OR "#"/RAW
         FLAG1=1                            ; RECEIVED "CTL"
         GO TO 4
2      IF(FLAG0.NE.0) IC=FLIPB0(IC)         ; SET BIT 0
       IF(FLAG1.NE.0) IC=CTL(IC)            ; SET BIT 1
3      IF(MODE.EQ.0) IC=IAND(IC,Y'7F')      ; STRIP BIT 0
       CALL ISBYTE(IC,DBUF,POINTR)          ; PLACE IN BUFFER
       POINTR=POINTR+1
       IC=IAND(IC,127)
       FLAG0=0
       FLAG1=0
       CALL ILBYTE(JC,LAST,3)
       CALL ISBYTE(IC,LAST,3)
       CALL ISBYTE(JC,LAST,2)
       IF(POINTR.GE.RECORD) WFLAG=1
       IF(LAST.EQ.CRLF.AND.MODE.EQ.0) WFLAG=1
       IF(WFLAG.EQ.0) GO TO 4
       K=33                                 ; IMAGE WRITE & PROCEED
       IF(MODE.LE.0) K=32                   ; ASCII WRITE & PROCEED
       IF(LAST.EQ.CRLF.AND.MODE.EQ.0) POINTR=POINTR-2
        IF(POINTR.GT.0) CALL SYSIO(RBLK,K,FILE,DBUF,POINTR,0,0)
       POINTR=0
        IF(WFLAG.GT.1) RETURN
       WFLAG=0
4     CONTINUE
      RETURN
C
      ENTRY XSTORE                          ; CLEAN UP SHOP
C
      FLAG1=0
      FLAG0=0
      LAST=0
C
      K=33                                 ; IMAGE WRITE & PROCEED
      IF(MODE.LE.0) K=32                   ; ASCII WRITE & PROCEED
      IF(LAST.EQ.CRLF.AND.MODE.EQ.0) POINTR=POINTR-2
       IF(POINTR.GT.0) CALL SYSIO(RBLK,K,FILE,DBUF,POINTR,0,0)
      POINTR=0
      RETURN
      END
$BEND
