KERMIT   TITLE     'KERMIT-CMS'
KERMIT   CSECT
* KERMIT   -
*
*  Kermit - KL10 Error-free Reciprocol Micro Interface Transfer
*  Version 1.0
*
*  This program is the IBM VM/CMS side of a file transfer system.
*  It can be used to transfer files between a micro and a system
*  running under VM/CMS.
*  See the KERMIT manual for the complete program specifications
*  to which this program and any other component of the system
*  must adhere.
*
*  Daphne Tzoar, Columbia University Center for Computing Activities
*  March 1982
*  Updates:
*    June: Only allow Kermit to run on an ASCII terminal.  Else, stop
*          execution.  Also, check padding when receiving file in
*          fixed format.  If only pad one character, pad the balance
*          via the "EX" option, else skip that command.
*  August: Change "FSREAD" when sending to allow a maximum of 133, not
*          the full buffer size since need two spaces for CRLF.
*  4/7/83: Fix maximum number of tries on init (to 16), set timeout
*          value to 8, and do "CTL" function to padding character
*          in SINIT (not CHAR).
*  2/1/84: Add fix so when receiving a file with RECFM = F, program
*          does not abort with DISK FULL error.  Changes are indicated
*          by the phrase '[edit]' in the comment.  Fix: Bill Small
*
*  Please address all comments and questions to:
*  716 Watson
*  612 W. 115th St.
*  NY,NY, 10025
*  (212) 280-3703
*
* Copyright (C) 1982 Columbia University
*
* Permission is granted to any individual or institution to copy
* or use this program, except for explicitly commercial purposes.
*
* Note that this is an experimental version; all changes should
* be forwarded to the author.
*
         EJECT
* REGISTER USAGE -
* R1 -
* R2 -
* R3 -
* R4 -
* R5 -
* R6 -
* R7 -
* R8 -
* R9 -
* R10 -
* R11 - BASE REGISTER FOR GLOBAL DATA AREA
* R12 - PROGRAM BASE
* R13 - SAVE AREA
* R14 - SUBROUTINE LINKAGE
* R15 - SUBROUTINE LINKAGE
*
* EXTERNAL MACROS/MODULES CALLED -
*  The following MACLIBs should be GLOBAL'd:
*       CMSBSE, CMSLIB
*
*  The following external routines are called:
*       NEXTFST ASSEMBLE
*       WILD ASSEMBLE
*
*
         SPACE
*        PRINT     NOGEN
         REGEQU
         FSTD      DSECT               WILL NEED FOR NEXTFST ROUTINE
         ADT       DSECT
         NUCON     DSECT               USE IN TOKENIZER ROUTINE
         EXTSECT   DSECT               USE WHEN TURNING BLIP OFF
         SPACE
SOH      EQU       X'01'               ^a FOR START OF HEADER CHAR
AD       EQU       68                  DATA PACKET (ASCII 'D')
AN       EQU       78                  NAK
AZ       EQU       90                  EOF PACKET
AS       EQU       83                  INIT PACKET
AY       EQU       89                  ACK
AF       EQU       70                  FILE PACKET
AB       EQU       66                  BREAK PACKET
AE       EQU       69                  ERROR PACKET
ERCOD    EQU       12                  MEANS EOF WITH 'FSREAD'
FLG1     EQU       X'80'               IS FILE THE FIRST OR NOT
FLG2     EQU       X'40'               OVERWRITE SENT FILENAME?
FLG3     EQU       X'20'               ONE = SENT ONLY PARTIAL RECORD
FLG4     EQU       X'10'               NAK FROM MICRO(0) OR RPACK(1)?
FLG5     EQU       X'08'               ALLOCATED MORE SPACE (DMSFREE)
         EJECT
KERMIT   CSECT
         STM       R14,R12,12(R13)
         BALR      R12,0
         USING     *,R12
         LA        R14,KSAVE
         ST        R13,4(R14)
         ST        R14,8(R13)
         LR        R13,R14
*
* USE R11 AS BASE REGISTER FOR THE SHARED DATA AREA
         L         R11,=A(PARMS)
         USING     PARMS,R11
         LR        R6,R1               HOLD ON TO CONSOLE BUFFER
         SR        R2,R2
         S         R2,ONE              GET INFO BY USING ADDR -1
         DC        X'83230024'         GET LINESIZE DATA - DIAG 24
         XC        TEMP,TEMP
         ST        R4,TEMP
         CLC       TEMP(2),=X'8020'    CHECK DEVICE TYPE
         BNE       BADDEV              MUST BE AN ASCII TERMINAL
         XC        LINSIZ,LINSIZ
         STC       R4,LINSIZ+3         SAVE THE LINESIZE
         LA        R7,=C'TERM LINES 130'
         LA        R8,14
         DIAG      7,8,8               SET TO HIGHEST POSSIBLE VALUE
         USING     NUCON,0             FOR TOKENIZER
         L         R7,AEXTSECT         LOC OF CMS ROUTINE EXTSECT
         USING     EXTSECT,R7
         MVC       BLIP(1),TIMCHAR     SAVE USER'S BLIP CHAR
         DMSEXS    MVI,TIMCHAR,X'00'   TURN OFF BLIP FOR NOW
         DROP      R7
         L         R15,=A(INIT)
         BALR      R14,R15             CALL THE INITIALIZATION
         SR        R15,R15             ZERO RC INITIALLY (IF EXIT)
         LA        R6,8(R6)
         CLC       0(8,R6),=8X'FF'     ALL COMMAND ON ONE LINE?
         BNE       NOPRO               NO PROMPT IF YES
PROMPT   WRTERM    'KERMIT-CMS>',EDIT=NO
         RDTERM    INPUT
         DMSKEY    NUCLEUS
         LA        R1,INPUT            R1 GETS ADDRESS OF STRING
         L         R0,=F'130'          R0 GETS THE LENGTH
         L         R15,ASCANN
         BALR      R14,R15             DO TOKENIZING
         LR        R6,R1               SAVE ADDR OF TOKENIZED LIST
         DMSKEY    RESET
NOPRO    MVI       ERRNUM,X'FF'        RESET ERROR FOR THIS TIME
         CLI       0(R6),C'E'          CHECK FOR 'EXIT' COMMAND
         BE        LEAVE
         CLI       0(R6),C'Q'          CHECK FOR 'QUIT' COMMAND
         BE        LEAVE
         CLC       0(8,R6),=8X'FF'     BARE CARRIAGE RETURN?
         BE        PROMPT              IGNORE IT
         CLI       0(R6),C'?'          NEED HELP ?
         BNE       SETCHK
         WRTERM    'Legal Commands are: '
         WRTERM    'Receive, Send, Help, Exit, Quit, Set, Status, Show,*
                CMS, CP'
         B         PROMPT
SETCHK   CLC       0(3,R6),=CL3'SET'   IS IT THE SET COMMAND ?
         BE        STSWITCH
         CLC       0(6,R6),=C'STATUS'  IS IT THE STATUS COMMAND?
         BE        STATSW
         CLC       0(3,R6),=C'SHO'     IS IT THE SHOW COMMAND?
         BE        SHOSW
         CLC       0(4,R6),=C'HELP'    NEED HELP ?
         BE        HELPSW
         CLC       0(3,R6),=C'CMS'     CMS COMMAND?
         BE        SYSCMD
         CLC       0(2,R6),=C'CP'      CP COMMAND?
         BE        SYSCMD
         OI        FLAGS,FLG1          SET FLG1 - IT'S THE FIRST FILE
         NI        FLAGS,X'FF'-FLG2    TURN OFF OVERWRITE FLAG (INIT)
         XC        NFSENT,NFSENT       NUMBER OF FILES SENT (= 0)
         CLC       0(3,R6),=C'REC'
         BNE       SS                  MAYBE IT'S A SEND COMMAND
         LA        R6,8(R6)            PICK UP NEXT TOKEN
         CLI       0(R6),C'?'          NEED HELP?
         BNE       RR2
         WRTERM    'Specify filename with format: [fn ft [fm]]'
         B         PROMPT
RR2      CLC       0(8,R6),=8X'FF'     NO MORE WORDS ?
         BE        RSWITCH             NO MORE, GO READ
         CLI       0(R6),C'='          IS IT "  = = FM" ?
         BNE       RREG
         CLI       8(R6),C'='          IS FT ALSO '=' ?
         BNE       BADFT               MUST BE AN '='
         CLI       16(R6),X'FF'        NO FM GIVEN - ASSUME A1
         BE        RSWITCH
         MVC       FM(2),16(R6)        USE FM THEY SPECIFIED
         B         RSWITCH
RREG     CLI       0(R6),C'*'          NO WILDCARDS HERE
         BNE       RR3
         WRTERM    'Illegal file name'
         B         PROMPT
RR3      MVC       FILNAM,=18X'20'     BLANK IT OUT
         MVC       FILNAM(8),0(R6)     GET FN
         LA        R6,8(R6)            GET NEXT TOKEN
         CLI       0(R6),C'*'          NOT ALLOWED
         BE        BADFT
         CLI       0(R6),C'='          NOT ALLOWED
         BE        BADFT
         CLC       0(8,R6),=8X'FF'     NO MORE ?
         BNE       RR
BADFT    WRTERM    'Illegal File Type'
         B         PROMPT
RR       MVC       FILNAM+8(8),0(R6)   GET FTYPE
         OI        FLAGS,FLG2          OVERWRITE RECEIVED FNAME
         MVC       FILNAM+16(2),DFM    DEFAULT FMODE,JUST IN CASE
         LA        R6,8(R6)            LOOK FOR FMODE
         CLC       0(8,R6),=8X'FF'     IS IT THERE ?
         BE        RSWITCH
         CLI       0(R6),C'*'          NOT ALLOWED IN FM
         BE        BADFM
         MVC       FILNAM+16(2),0(R6)  GET FMODE
         B         RSWITCH             GO TO READ PORTION
BADFM    WRTERM    'Illegal file mode'
         B         PROMPT
SS       CLC       0(3,R6),=C'SEN'
         BNE       ERR                 UNRECOGNIZED COMMAND
         LA        R6,8(R6)            PICK UP  NEXT WORD
         CLI       0(R6),C'?'          NEED HELP?
         BNE       SS2
         WRTERM    'Specify filename(s) with format: fn ft [fm]'
         B         PROMPT
SS2      CLC       0(8,R6),=8X'FF'     NO MORE DATA ?
         BNE       SNAM
         WRTERM    'Specify File Name'
         B         PROMPT              TRY AGAIN
SNAM     MVC       NAME,=18X'20'       BLANK IT  OUT
         MVC       FILNAM,=18X'20'     BLANK IT OUT TOO
         MVC       NAME(8),0(R6)       PICK UP THE FNAME
         LA        R6,8(R6)            MOVE TO NEXT TOKEN
         CLC       0(8,R6),=8X'FF'     NO MORE DATA ?
         BNE       STYP
         WRTERM    'Specify File Type'
         B         PROMPT
STYP     MVC       NAME+8(8),0(R6)     PICK UP THE FTYPE
         MVC       NAME+16(2),DFM      DEFAULT FMODE,JUST IN CASE
         LA        R6,8(R6)            LOOK FOR FMODE
         CLC       0(8,R6),=8X'FF'     IS IT THERE?
         BE        SSWITCH
         MVC       NAME+16(2),0(R6)    GET FMODE
         CLI       0(R6),C'*'          WAS IT A WILDCARD?
         BNE       SSWITCH             NO PROBLEM IF NOT
         CLI       1(R6),C' '          NEED "**" OR "*NUMBER"
         BNE       SSWITCH
         MVI       NAME+17,C'*'        SET "* " TO "**"
         B         SSWITCH
ERR      WRTERM    'Invalid command'
         B         PROMPT              INVALID COMMAND - TRY AGAIN
         SPACE     3
SSWITCH  EQU       *
         LA        1,=C'SET LINEDIT OFF'
         LA        0,15                15 CHAR COMMAND
         DIAG      1,0,8               SHOW IT'S A CP COMMAND
         L         R15,=A(SEND)
         BALR      R14,R15             CALL SEND PORTION
         LTR       R5,R15              CHECK RETURN CODE
         BNZ       LINON
         MVI       ERRNUM,X'FF'        WORKED OK
LINON    LA        1,=C'SET LINEDIT ON'
         LA        0,14
         DIAG      1,0,8
         MVC       OLDERR(1),ERRNUM    ERROR SETTING OF THIS RUN
         TM        FLAGS,FLG5          GOT EXTRA SPACE?
         BNO       SSW1                NOPE, JUST LEAVE
         LA        R0,4096/8           AMOUNT OF SPACE WE GOT
         L         R1,STORLOC          FIND IT & FREE IT
         DMSFRET   DWORDS=(0),LOC=(1),ERR=*,MSG=NO
         NI        FLAGS,X'FF'-FLG5    TURN OFF EXTRA SPACE FLAG
SSW1     LTR       R5,R5               CHECK THE RETCODE
         BZ        PROMPT              ALL OKAY
         WRTERM    'Error in sending file. Try again.'
         B         PROMPT              ERROR - TRY AGAIN
RSWITCH  EQU       *
         LA        1,=C'SET LINEDIT OFF'
         LA        0,15                15 CHAR COMMAND
         DIAG      1,0,8               SHOW IT'S A CP COMMAND
         L         R15,=A(RECEIVE)
         BALR      R14,R15             CALL RECEIVE PORTION
         LTR       R5,R15              CHECK RETURN CODE
         BNZ       LNON
         MVI       ERRNUM,X'FF'
LNON     LA        1,=C'SET LINEDIT ON'
         LA        0,14
         DIAG      1,0,8
         MVC       OLDERR(1),ERRNUM    ERROR SETTING OF THIS RUN
         LTR       R5,R5               CHECK THE RETCODE
         BZ        PROMPT              ALL OKAY
         WRTERM    'Error in receiving file. Try again.'
         B         PROMPT              ERROR - TRY AGAIN
STSWITCH EQU       *
         L         R15,=A(SET)
         BALR      R14,R15             CALL "SET" SUBROUTINE
         LTR       R15,R15             CHECK RETCODE
         BZ        PROMPT
         WRTERM    'Illegal Set Command'
         B         PROMPT
SHOSW    EQU       *
         L         R15,=A(SHOW)
         BALR      R14,R15             CALL "SHOW" SUBROUTINE
         LTR       R15,R15             CHECK RETCODE
         BZ        PROMPT
         WRTERM    'Illegal Show Command'
         B         PROMPT
STATSW   EQU       *
         CLI       8(R6),C'?'          NEED HELP?
         BNE       GIVSTAT
         WRTERM    'Confirm with a carriage return'
         B         PROMPT
GIVSTAT  CLI       OLDERR,X'FF'        WAS THERE AN ERROR LAST TIME?
         BNE       FAIL
         WRTERM    'Kermit completed successfully'
         B         PROMPT
FAIL     SR        R5,R5
         IC        R5,OLDERR           GET OFFSET INTO ERROR TABLE
         M         R4,=F'20'           OFFSET := ERRNUM * 20
         LA        R5,ERRTAB(R5)
         WRTERM    (R5),20             PRINT ERROR MSG ON SCREEN
         B         PROMPT              AND LEAVE
HELPSW   CLI       8(R6),C'?'          NEED HELP?
         BNE       GIVHLP
         WRTERM    'Confirm with a carriage return'
         B         PROMPT
GIVHLP   LA        R1,HLPMSG           GET LOCATION OF HELP MESSAGE
         SVC       202                 SUPERVISOR CALL
         DC        AL4(*+8)            PRINT ERR MSG IF FAILED
         B         PROMPT              RETURN IF NO
         WRTERM    'No help available'
         B         PROMPT
SYSCMD   CLI       8(R6),C'?'          NEED HELP?
         BNE       GIVSYS
         WRTERM    'Issue a CMS/CP command'
         B         PROMPT
GIVSYS   CLC       8(8,R6),=8X'FF'     ANY COMMAND?
         BE        SYSERR              DIE IF NO
         LA        R1,0(R6)            REST OF THE CMS COMMAND
         CLC       0(3,R6),=C'CMS'     CMS OR CP COMMAND?
         BNE       GIVSVC
         LA        R1,8(R6)            IGNORE THE "CMS" PART
GIVSVC   SVC       202                 ISSUE THE COMMAND
         DC        AL4(*+8)            PRINT ERR MSG IF FAILED
         B         PROMPT
         LR        R5,R15              GET RETCODE
         LINEDIT   TEXT='Command rc equals  ........',SUB=(DEC,(R5))
         B         PROMPT
SYSERR   WRTERM    'No command supplied'
         B         PROMPT
LEAVE    CLI       8(R6),C'?'          NEED HELP?
         BNE       KRET                NO, JUST LEAVE
         WRTERM    'Confirm with a carriage return'
         B         PROMPT
BADDEV   WRTERM    'An Ascii terminal must be used.'
         B         RET
KRET     EQU       *
         USING     NUCON,0             USE TO RESET BLIP
         L         R7,AEXTSECT         ADDR OF EXTSECT
         USING     EXTSECT,R7          RESTORE USER'S BLIP CHAR
         DMSEXS    MVC,TIMCHAR(1),BLIP
         DROP      R7
*  RESTORE USER'S TERMINAL LINESIZE
         LINEDIT   TEXT='TERM LINES ........',SUB=(DECA,LINSIZ),       *
               DOT=NO,DISP=CPCOMM
RET      EQU       *
         L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        R14
*
KSAVE    DS        18F                 KERMIT'S SAVE AREA
         LTORG
         DROP      R11
         DROP      R12                 NO LONGER NEED THEM
         EJECT
INIT     CSECT
         STM       R14,R12,12(R13)
         BALR      R12,0
         USING     *,R12
         LA        R14,ISAVE
         ST        R13,4(R14)
         ST        R14,8(R13)
         LR        R13,R14
*
* INITIALIZE VARIABLES THAT GET CHANGED DURING EXECUTION
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA LIST
         L         R11,=A(PARMS)
         USING     PARMS,R11
         XC        SNDPKT,SNDPKT       CLEAR OUT THESE BUFFERS
         XC        RECPKT,RECPKT
         XC        INPUT,INPUT
         LA        R0,BUF
         LA        R1,L'BUF            ; CLEAR OUT THE BUFFER.
         SR        R15,R15
         MVCL      R0,R14
         LA        R0,RBUF
         LA        R1,L'RBUF
         SR        R15,R15
         MVCL      R0,R14
         XC        FSENT,FSENT
         XC        SDAT,SDAT
         XC        RDAT,RDAT
         XC        N,N                 SET VARIABLES TO ZERO
         XC        NUM,NUM
         XC        LSDAT,LSDAT
         XC        LRDAT,LRDAT
         MVI       FLAGS,X'00'         CLEAR ALL FLAGS
         XC        SAVPL,SAVPL
         XC        RSAVPL,RSAVPL
         XC        NUMTRY,NUMTRY
         MVC       FILNAM,=18X'20'     BLANK OUT FILNAM & NAME
         MVC       NAME,=18X'20'
         MVI       PREV,X'00'
         MVI       ERRNUM,X'FF'        SET TO NO ERROR FOR NOW
         MVI       OLDERR,X'FF'        SAME HERE
         MVC       FST(4),=X'FF000000'
         MVC       ADT(4),=X'FF000000'
         XC        PKVAR,PKVAR         ZERO IT OUT
         XC        OLDTRY,OLDTRY
         XC        SPSIZ,SPSIZ
         XC        SIZE,SIZE
         XC        TEMP,TEMP
         XC        NFSENT,NFSENT       ZERO FILES SENT,INITIALLY
         XC        STORLOC,STORLOC
         MVC       LRECL(1),DLRECL     SET DEFAULTS, JUST IN CASE
         MVC       RFM(1),DRECFM
         MVC       FM(2),DFM
         MVC       QUOCHAR(1),DQUOTE
         MVC       RQUO(1),DQUOTE
         MVC       REOL(1),DEOL
         MVC       SEOL(1),DEOL
         MVI       STATE,C' '
         MVI       STYPE,C' '
         MVI       RTYPE,C' '
*
INITRET  L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        R14
ISAVE    DS        18F
         LTORG
         DROP      R11
         DROP      R12
         EJECT
PARMS    CSECT                         GLOBAL DATA LIST
SNDPKT   DS        CL130               SEND THIS TO MICRO
         ORG       SNDPKT
PHDR     DS        X
PLEN     DS        X
PNUM     DS        X
PTYPE    DS        X
PDATA    DS        0C
         ORG       ,
RECPKT   DS        CL130               RECEIVE THIS FROM MICRO
LSDAT    DS        F                   SEND PACKET SIZE
LRDAT    DS        F                   RECEIVE PACKET SIZE
FLAGS    DC        X'00'               USE TO TEST OUR FLAGS
FILINFO  DC        A(NAME)             DATA FOR "NEXTFST" ROUTINE
         DC        A(ADT)
         DC        X'80',AL3(FST)
HLPMSG   DC        CL8'HELP'           USE FOR CMS 'HELP' COMMAND
         DC        CL8'KERMIT'         TOKENIZE TO 8 CHARACTERS
         DC        8X'FF'              NO MORE INFO
NAME     DC        18X'20'             NAME OF FILE(S) TO SEND
         DS        0F
FST      DC        X'FF',AL3(0)        USE FOR "NEXTFST" ROUTINE
ADT      DC        X'FF',AL3(0)        THIS TOO
         DS        0F
INPUT    DS        CL130               INPUT BUFFER
         DS        0F
BUF      DS        CL260               FSREAD INTO HERE
RBUF     DS        CL260               FSWRITE FROM HERE
FSENT    DS        CL160               TABLE OF FILES SENT SO FAR
N        DC        F'0'                SEND PACKET NUMBER
NUM      DC        F'0'                RECEIVE PACKET NUMBER
NUMTRY   DC        F'0'                TRIAL COUNTER FOR TRANSFERS
OLDTRY   DS        F                   COUNTER FOR PREVIOUS PACKET
NFSENT   DC        F'0'                NUMBER OF FILES SENT
STORLOC  DS        F                   POINTER TO EXTRA STORAGE
MAXPACK  DC        F'94'               MAX PACKET SIZE
RECL     DS        F                   RECORD LEN (IF RECFM = V)
RPSIZ    DC        F'94'               MAX RECEIVE PACKET SIZE
DSSIZ    DC        F'40'               DEFAULT MAX SEND PACKET SIZE
SPSIZ    DS        F                   SEND PACKET SIZE
MAXTRY   DC        F'5'                NO. OF TIMES TO RETRY PACKET
IMXTRY   DC        F'16'               NO. OF INITIAL TRIALS ALLOWED
SIZE     DS        F                   MAX SIZE FOR SEND DATA
DEL      DC        F'127'              OCTAL 177 (DELETE CHAR)
ZERO     DC        F'0'
ONE      DC        F'1'
FIVE     DC        F'5'
TWO      DC        F'2'
SPACE    DC        F'32'               ASCII SPACE
O1H      DC        F'64'               OCTAL 100
O2H      DC        F'128'              OCTAL 200
SAVPL    DC        F'0'                POINTER WITHIN BUF,INIT=0
RSAVPL   DC        F'0'                POINTER IN 'PTCHR',INIT=0
DQUOTE   DC        X'23'               DEFAULT QUOTE CHARACTER = #
QUOCHAR  DS        X                   QOUTE CHAR WE'LL SEND
RQUO     DS        X                   MICRO'S QUOTE CHAR
TEMP     DS        F                   TEMPORARY SPACE
         DS        0D
PKVAR    DS        D                   USE FOR PICKING UP INTEGER
SDAT     DS        CL130               TEMP PLACE FOR SEND DATA
RDAT     DS        CL130               TEMP PLACE FOR RECEIVE DATA
FILNAM   DS        CL18                SEND/REC FILENAME
STATE    DS        C                   OUR CURRENT STATE
DFM      DC        CL2'A1'             DEFAULT FILEMODE
FM       DS        CL2                 FILEMODE USER WANTS
DEOL     DC        X'0D'               DEFAULT END OF PACKET (CR)
REOL     DS        X                   EOL CHAR I NEED (CR)
SEOL     DS        X                   EOL I'LL SEND
DLRECL   DC        X'50'               DEFAULT LRECL SIZE OF 80
LRECL    DS        X                   LRECL PROGRAM WILL USE
DRECFM   DC        C'V'                DEFAULT WITH VARIABLE RECFM
RFM      DS        C                   RECFM PROGRAM WILL USE
PREV     DS        C                   PREVIOUS CHAR REC (IN PTCHR)
BLIP     DS        X                   SAVE USER'S BLIP CHAR
LINSIZ   DS        F                   SAVE USER'S CONSOLE LINESIZE
ERRNUM   DS        X                   ERROR NUMBER,IN CASE WE DIE
OLDERR   DS        X                   ERROR OF PREVIOUS EXECUTION
STYPE    DS        C                   TYPE OF PACKET SENT
RTYPE    DS        C                   TYPE OF PACKET RECEIVED
* THIS IS THE ASCII TO EBCDIC TABLE
ATOE     DC        X'00010203372D2E2F1605250B0C0D0E0F'
         DC        X'101112133C3D322618193F271C1D1E1F'
         DC        X'405A7F7B5B6C507D4D5D5C4E6B604B61'
         DC        X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'
         DC        X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'
         DC        X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'
         DC        X'79818283848586878889919293949596'
         DC        X'979899A2A3A4A5A6A7A8A9C04FD0A107'
*THIS IS THE EBCDIC TO ASCII CONVERSION TABLE
*CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL
ETOA     DC        X'000102030009007F0000000B0C0D0E0F'
         DC        X'1011121300000800181900001C1D1E1F'
         DC        X'00000000000A171B0000000000050607'
         DC        X'0000160000000004000000001415001A'
         DC        X'20000000000000000000002E3C282B7C'
         DC        X'2600000000000000000021242A293B5E'
         DC        X'2D2F00000000000000007C2C255F3E3F'
         DC        X'000000000000000000603A2340273D22'
         DC        X'00616263646566676869007B00000000'
         DC        X'006A6B6C6D6E6F707172007D00000000'
         DC        X'007E737475767778797A0000005B0000'
         DC        X'000000000000000000000000005D0000'
         DC        X'7B414243444546474849000000000000'
         DC        X'7D4A4B4C4D4E4F505152000000000000'
         DC        X'5C00535455565758595A000000000000'
         DC        X'303132333435363738397C0000000000'
*
* TABLE OF ERROR MESSAGES (IN CASE WE ABORT)
ERRTAB   DC        CL20'Bad send-packet size'    ERR MSG #0
         DC        CL20'Bad message number'      ERR MSG #1
         DC        CL20'Unrecognized state'      ERR MSG #2
         DC        CL20'No SOH encountered'      ERR MSG #3
         DC        CL20'Bad character count'     ERR MSG #4
         DC        CL20'Bad checksum'            ERR MSG #5
         DC        CL20'Disk is full'            ERR MSG #6
         DC        CL20'Illegal packet type'     ERR MSG #7
         DC        CL20'Lost a packet'           ERR MSG #8
         DC        CL20'Micro sent a NAK'        ERR MSG #9
         DC        CL20'Micro aborted'           ERR MSG #10
         DC        CL20'Illegal file name'       ERR MSG #11
         DC        CL20'Invalid lrecl'           ERR MSG #12
         DC        CL20'Permanent I/O error'     ERR MSG #13
         DC        CL20'Disk is read-only'       ERR MSG #14
         DC        CL20'Recfm conflict'          ERR MSG #15
         DC        CL20'Err allocating space'    ERR MSG #16
         LTORG
         EJECT
SET      CSECT
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS
         BALR      R12,0               ESTABLISH ADDRESSABILITY
         USING     *,R12
         LA        R14,SETSAVE         ADDRESS OF MY SAVE AREA
         ST        R13,4(R14)          SAVE CALLER'S
         ST        R14,8(R13)
         LR        R13,R14
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
         L         R11,=A(PARMS)
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY
         LA        R6,8(R6)            PICK UP NEXT TOKEN
         CLI       0(R6),C'?'          NEED HELP ?
         BNE       NOQ
         WRTERM    'Recfm, End-of-Line, Quote, Lrecl, Packet-size'
         B         SETOK
NOQ      CLC       0(5,R6),=CL5'RECFM'
         BNE       NOREC
         LA        R6,8(R6)            PICK UP RECORD FORMAT
         CLI       0(R6),C'?'
         BNE       CHKFM
         WRTERM    'f or v (default of v)'
         B         SETOK
CHKFM    CLI       0(R6),C'V'          REDUNDANT
         BE        FMSET
         CLI       0(R6),C'F'          FIXED FORMAT?
         BNE       RECERR
FMSET    MVC       RFM(1),0(R6)        PICK UP RECFM
         B         SETOK
RECERR   WRTERM    'Fixed and variable files only'
         B         SETERR
NOREC    CLC       0(5,R6),=C'QUOTE'   QUOTE CHARACTER
         BNE       NOQUO
         LA        R6,8(R6)            GET NEXT TOKEN
         CLI       0(R6),X'FF'         VALUE NOT SUPPLIED?
         BNE       GIVQ
         WRTERM    '?not confirmed'
         B         SETERR
GIVQ     CLC       0(2,R6),=C'? '
         BNE       GETQUO
         WRTERM    'a single character'
         B         SETOK
GETQUO   MVC       QUOCHAR(1),0(R6)    SET NEW QUOTE CHAR
         TR        QUOCHAR(1),ETOA     GET ASCII FORM
         CLI       1(R6),C' '          IS IT ONLY ONE CHAR?
         BE        ISQOK
         WRTERM    'one character only'
         B         SETERR
ISQOK    CLI       QUOCHAR,X'21'       CAN'T BE LESS THAN 32
         BL        BADQUO
         CLI       QUOCHAR,X'7E'       CAN'T BE LARGER THAN 126
         BH        BADQUO
         CLI       QUOCHAR,X'3E'       HAS TO BE BETWEEN 32-62
         BNH       SETOK
         CLI       QUOCHAR,X'60'       OR BETWEEN 96-126
         BNL       SETOK
BADQUO   WRTERM    'Must fall between 41-76,140,or 173-176 (octal).'
         B         SETERR
NOQUO    CLC       0(5,R6),=C'LRECL'   LRECL SIZE
         BNE       NORCL
         LA        R6,8(R6)            PICK UP NEXT TOKEN
         CLI       0(R6),C'?'          HELP ?
         BNE       GETREC
         WRTERM    'Logical Record Length (default of 80).'
         B         SETOK
GETREC   CLI       0(R6),X'FF'         NO VALUE GIVEN
         BNE       CALC
         WRTERM    '?not confirmed'
         B         SETERR
CALC     CLI       0(R6),X'F0'         MUST BE >= TO 0
         BL        BADREC
         CLI       0(R6),X'F9'         MUST BE <= TO 9
         BH        BADREC
         XC        PKVAR,PKVAR         EMPTY IT OUT
         SR        R4,R4               LENGTH OF NUMBER
         CLI       1(R6),C' '          TWO DIGITS?
         BNE       CALC2
         EX        R4,PCK
         B         TST
CALC2    LA        R4,1(R4)            ADD ONE
         CLI       2(R6),C' '          THREE DIGITS?
         BNE       CALC3
         EX        R4,PCK
         B         TST
CALC3    LA        R4,1(R4)            IS THERE AN ERROR?
         CLI       3(R6),C' '
         BNE       BADREC
         EX        R4,PCK
TST      CVB       R7,PKVAR
         C         R7,=X'00000085'     MAX OF 133 FOR LRECL
         BH        BADREC
         STC       R7,LRECL            SET THE LRECL VALUE
         B         SETOK
BADREC   WRTERM    'A number with a maximum of 133.'
         B         SETERR
NORCL    CLC       0(3,R6),=C'END'     EOL CHARACTER
         BNE       NOEND
         LA        R6,8(R6)            NEXT TOKEN
         CLI       0(R6),X'FF'         NOT DATA
         BNE       EOLCHAR
         WRTERM    '?not confirmed'
         B         SETERR
EOLCHAR  CLI       0(R6),C'?'          NEED HELP?
         BNE       GETEOL
         WRTERM    'A two digit number between 00 and 31 (dec).'
         B         SETOK
GETEOL   CLI       0(R6),X'F0'         MUST BE >= TO 0
         BL        BADEOL
         CLI       0(R6),X'F9'         MUST BE <= TO 9
         BH        BADEOL
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS
         BE        BADEOL
         CLI       2(R6),C' '          TWO CHARS, AT MAX
         BNE       BADEOL
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARACTERS
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG
         C         R7,=X'0000001F'     MAX OF 31 DECIMAL
         BH        BADEOL
         STC       R7,SEOL             SET SEND EOL VALUE
         B         SETOK
BADEOL   WRTERM    'Must be a two digit value less than 31 (dec).'
         B         SETERR
NOEND    CLC       0(3,R6),=C'PAC'     CHANGE RECEIVE PACKET SIZE
         BNE       SETERR
         LA        R6,8(R6)            GET NEXT TOKEN
         CLI       0(R6),X'FF'         NO DATA
         BNE       GETPAC
         WRTERM    '?not confirmed'
         B         SETERR
GETPAC   CLI       0(R6),C'?'          NEED HELP?
         BNE       CALC4
         WRTERM    'Receive packet size (range: 26-94 decimal).'
         B         SETOK
CALC4    CLI       0(R6),X'F0'         MUST BE >= TO 0
         BL        BADPAC
         CLI       0(R6),X'F9'         MUST BE <= TO 9
         BH        BADPAC
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS
         BE        BADPAC
         CLI       2(R6),C' '          TWO CHARS, AT MAX
         BNE       BADPAC
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARS
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG
         C         R7,=F'26'           THIS IS MIN
         BL        BADPAC
         C         R7,MAXPACK          THIS IS THE MAX
         BH        BADPAC
         ST        R7,RPSIZ            USE THIS VALUE NOW
         B         SETOK
BADPAC   WRTERM    'Must be between 26-94 (decimal).'
SETERR   MVC       QUOCHAR(1),DQUOTE   RESET VALUE, JUST IN CASE
         LA        R15,4               SET A NON-ZERO RETCODE
         B         SETRET
SETOK    SR        R15,R15             RETCODE OF 0
*
SETRET   L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        R14
SETSAVE  DS        18F
PCK      PACK      PKVAR(8),0(0,R6)
         LTORG
         DROP      R11
         DROP      R12
         EJECT
SHOW     CSECT
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS
         BALR      R12,0               ESTABLISH ADDRESSABILITY
         USING     *,R12
         LA        R14,SHOWSAVE        ADDRESS OF MY SAVE AREA
         ST        R13,4(R14)          SAVE CALLER'S
         ST        R14,8(R13)
         LR        R13,R14
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
         L         R11,=A(PARMS)
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY
         LA        R6,8(R6)            PICK UP NEXT TOKEN
         CLI       0(R6),C'?'          NEED HELP ?
         BNE       SHOREC
         WRTERM    'Recfm, End-of-Line, Quote, Lrecl, Packet-size'
         B         SHOWOK
SHOREC   CLC       0(5,R6),=CL5'RECFM'
         BNE       SHOQUO
         LINEDIT   TEXT='The record format is ..',SUB=(CHARA,(RFM,1))
         B         SHOWOK
SHOQUO   CLC       0(5,R6),=C'QUOTE'
         BNE       SHORCL
         TR        QUOCHAR(1),ATOE     GET EBCDIC VERSION
         LINEDIT   TEXT='The quote character is ..',                   *
               SUB=(CHARA,(QUOCHAR,1))
         TR        QUOCHAR(1),ETOA     KEEP THE ASCII FORM AROUND
         B         SHOWOK
SHORCL   CLC       0(5,R6),=C'LRECL'
         BNE       SHOEND
         SR        R4,R4               ZERO IT OUT
         IC        R4,LRECL
         LINEDIT   TEXT='Lrecl is ........',SUB=(DEC,(R4))
         B         SHOWOK
SHOEND   CLC       0(3,R6),=C'END'
         BNE       SHOPAC
         SR        R4,R4               ZERO IT OUT
         IC        R4,SEOL
         LINEDIT   TEXT='End-of-Line character is ...... (decimal)',   *
               SUB=(DEC,(R4))
         B         SHOWOK
SHOPAC   CLC       0(3,R6),=C'PAC'     PACKET LENGTH ?
         BNE       SHOWERR
         LINEDIT   TEXT='Receive packet size is ........ (decimal)',   *
               SUB=(DECA,RPSIZ)
         B         SHOWOK
SHOWERR  LA        R15,4               SET A NON-ZERO RETCODE
         B         SHOWRET
SHOWOK   SR        R15,R15             ZERO RETCODE
*
SHOWRET  L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        R14
SHOWSAVE DS        18F
         LTORG
         DROP      R11
         DROP      R12
         EJECT
SEND     CSECT
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS
         BALR      R12,0               ESTABLISH ADDRESSABILITY
         USING     *,R12
         LA        R14,SENDSAVE        ADDRESS OF MY SAVE AREA
         ST        R13,4(R14)          SAVE CALLER'S
         ST        R14,8(R13)
         LR        R13,R14
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
         L         R11,=A(PARMS)
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY
         MVI       STATE,C'S'
         SR        R3,R3
         ST        R3,N
         ST        R3,NUMTRY
         MVC       FST(4),=X'FF000000' INITIALIZATION STUFF
         MVC       ADT(4),=X'FF000000' HERE TOO,IN CASE OF RETRY
NXTFIL   LA        R1,FILINFO          STUFF NEED TO GET FNAME(S)
         L         R15,=V(NEXTFST)
         BALR      R14,R15             GET NEXT/FIRST FILE
         LTR       R5,R15              COPY RETCODE
         BNZ       NOFIND              RETCODE OF ZERO = ALL OK
         L         R9,FST              GET INFO FROM FSTTABLE
         USING     FSTD,R9
         MVC       FILNAM(8),FSTFNAME  GET FNAME
         MVC       FILNAM+8(8),FSTFTYPE
         MVC       FILNAM+16(2),FSTFMODE
         L         R9,ADT
         USING     ADTSECT,R9
         LA        R5,ADTM
         MVC       FILNAM+16(1),0(R5)  GET CORRECT FMODE
         LA        R5,FSENT            TABLE W/FILES SENT SO FAR
         LR        R7,R5               KEEP TRACK OF TABLE
         LA        R7,160(R7)          HERE, WE'RE PAST THE TABLE
         L         R4,NFSENT           HOW MANY SENT SO FAR
FILLOOP  LTR       R4,R4
         BZ        OKSND
         BCTR      R4,0                DECREMENT COUNTER
         CLC       0(16,R5),FILNAM     SENT ALREADY?
         BE        NXTFIL              DON'T RESEND
         LA        R5,16(R5)           CHECK NEXT FILE
         CR        R5,R7
         BNE       FILLOOP
         L         R5,STORLOC          SEARCH HERE NOW
         B         FILLOOP
OKSND    TM        FLAGS,FLG1          IS THIS THE FIRST FILE?
         BNO       SLOOP               ONLY WAIT 10 SECS IF YES
         NI        FLAGS,X'FF'-FLG1    TURN OFF FIRST FILE FLAG
         LA        1,=C'SL 10 SEC'     SLEEP BEFORE SENDING
         LA        0,9                 COMMAND LENGTH IS 9
         DIAG      1,0,8               SHOW IT'S A CP COMMAND
SLOOP    CLI       STATE,C'D'          SEND DATA STATE
         BE        SDATA
         CLI       STATE,C'F'          SEND FILE STATE
         BE        SFILE
         CLI       STATE,C'S'          SEND INIT STATE
         BE        SINIT
         CLI       STATE,C'Z'          END OF FILE STATE
         BE        SEOF
         CLI       STATE,C'B'          SEND BREAK STATE
         BE        SBREAK
         CLI       STATE,C'C'          COMPLETE STATE
         BE        COMPLETE
         CLI       STATE,C'A'          ABORT STATE
         BE        ABORT               ERROR - GO TO ABORT STATE
         MVI       ERRNUM,X'02'        UNRECOGNIZED STATE
         B         ABORT               OTHERWISE, DIE
SINIT    CLC       NUMTRY,IMXTRY       SEE IF CAN SEND
         BL        OK1                 YES WE CAN
         MVI       STATE,C'A'          NOPE, GO INTO ABORT STATE
         B         SLOOP
OK1      L         R5,SPACE            MAKE CHARACTER PRINTABLE
         A         R5,RPSIZ            ADD REC PACKET SIZE
         STC       R5,SDAT             ADD SIZE INFO TO BUFFER
         L         R5,SPACE
         A         R5,=F'8'            8 FOR TIMEOUT
         STC       R5,SDAT+1
         L         R5,SPACE            SEND ZERO + " " FOR NPAD
         STC       R5,SDAT+2           WE'RE THE SLOW GUYS
         SR        R5,R5               PAD WITH NULLS
         L         R3,O1H
         XR        R5,R3               CTL FUNCTION (XOR WITH 64)
         STC       R5,SDAT+3           DON'T NEED PADCHAR EITHER
         SR        R5,R5               ZERO IT OUT FOR NEXT TWO GUYS
         IC        R5,REOL             EOL CHAR I NEED
         A         R5,SPACE            MAKE PRINTABLE
         STC       R5,SDAT+4
         IC        R5,QUOCHAR          MY QUOTE CHAR
         STC       R5,SDAT+5
         L         R3,NUMTRY
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER
         ST        R3,NUMTRY
         MVI       STYPE,AS            PACKET TYPE = SEND INITIATE
         MVC       LSDAT(4),=F'6'      BUFFER SIZE FOR THIS SEND
         L         R4,DSSIZ            GET DEFAULT SPSIZ
         S         R4,FIVE             FOR NOW, USE DEFAULT SPSIZ....
         ST        R4,SIZE             ....TO SET VALUE OF SIZE
         L         R15,=A(SPACK)       GET ADDRESS OF ROUTINE 'SPACK'
         BALR      14,15               SAVE * AND GO TO SPACK
         CLI       STATE,C'A'
         BE        ABORT
         L         15,=A(RPACK)        GET ADDRESS OF 'RPACK'
         BALR      14,15               SAVE * AND GO TO RPACK
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       Y1                  NO, THEN MAYBE AN ACK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          AND DIE
         B         SLOOP
Y1       CLI       RTYPE,AY            SEE IF GOT ACK
         BNE       N1                  MAYBE IT'S 'N'
         CLC       N,NUM               CHECK MESSAGE NUMBERS
         BE        AOK1
         MVI       ERRNUM,X'08'        PACKET LOST
         B         SLOOP
AOK1     SR        R4,R4               ZERO OUT REGISTER
         IC        R4,RDAT             USE SPSIZ THE MICRO WANTS
         S         R4,SPACE            SUBTRACT THE ' '
         C         R4,=F'26'           BUFFER HAS TO BE >= 26
         BNL       CH1                 SO FAR, SO GOOD
         MVI       STATE,C'A'          ABORT THEN
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR
         B         SLOOP
CH1      C         R4,MAXPACK          MAX PACKET SIZE
         BNH       CH2                 CONTINUE IF <= TO MAX
         MVI       STATE,C'A'          DIE
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR
         B         SLOOP
CH2      STC       R4,SPSIZ+3          USE SPSIZ THE MICRO WANTS
         S         R4,FIVE
         ST        R4,SIZE             SET SIZE TO SPSIZ-5
         CLC       LRDAT(4),=F'4'      USING DEFAULTS?
         BNH       NOCHG               YUP
         LA        R5,RDAT             POINTER TO THE BUFFER
         SR        R7,R7
         IC        R7,4(R5)            SEOL MICRO WANTS
         S         R7,SPACE            UNCHAR (IE - SUBTRACT SPACE)
         STC       R7,SEOL
NOCHG    MVI       STATE,C'F'          PUT INTO SEND FILE STATE
         XC        NUMTRY,NUMTRY       RESET TO ZERO
         L         R3,N
         LA        R3,1(R3)            ADD ONE
         ST        R3,N                STORE VALUE INCREMENTED BY 1
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         B         SLOOP
N1       CLI       RTYPE,AN            SEE IF IT'S 'N'
         BNE       AB1                 IF NOT, DIE
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID
         MVI       ERRNUM,X'09'        MICRO NAK'ED
         B         SLOOP
AB1      MVI       STATE,C'A'          ELSE, ABORT
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE
         B         SLOOP
SFILE    CLC       NUMTRY,MAXTRY       EXCEEDED NO. OF TRIES ALLOWED?
         BL        OK2                 NOPE, STILL OK
         MVI       STATE,C'A'          ABORT IF YES
         B         SLOOP
OK2      TR        FILNAM,ETOA
         LA        R4,FILNAM           BEGINNING OF BUFFER
         SR        R1,R1
         TRT       FILNAM(8),PARSE     SEND A DOT INSTEAD OF PARSES
         BNZ       SP
         L         R4,=F'8'            FUDGE THE LENGTH
         B         SP2
SP       SR        R1,R4               WHERE THE TRT STOPPED
         LR        R4,R1               HAVE LENGTH OF THE FN
SP2      LR        R5,R4               COUNTER FOR LENTH OF FILNAM
         BCTR      R4,0                ONE LESS FOR 'EX' COMMAND
         EX        R4,FIRST            PICK UP THE FN
         LA        R4,SDAT(R5)         PUT THE DOT HERE
         MVI       0(R4),X'2E'         ADD AN ASCII DOT
         LA        R5,1(R5)            ADD ONE TO COUNTER
         LA        R4,FILNAM
         LA        R4,8(R4)            NEXT AREA OF THE FILNAM
         SR        R1,R1
         TRT       FILNAM+8(8),PARSE
         BNZ       SP3
         L         R4,=F'8'            FUDGE THE LENGTH
         B         SP4
SP3      SR        R1,R4
         LR        R4,R1               WHERE WE STOPPED
SP4      LA        R7,SDAT(R5)         NEXT FREE SPOT
         AR        R5,R4               LENGTH OF NAME WITH DOT
         BCTR      R4,0                MINUS ONE FOR THE 'EX'
         EX        R4,SECOND           PICK UP FT
         L         R3,NUMTRY
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER
         ST        R3,NUMTRY
         MVI       STYPE,AF            PACKET TYPE = FILE HEADER
         ST        R5,LSDAT            SET BUFFER SIZE
         TR        FILNAM,ATOE
         L         R3,NFSENT
         LR        R4,R3               SAVE VALUE
         C         R4,=F'10'           NEED MORE SPACE?
         BE        ADDSP
         BH        ADDSP2
         M         R2,=F'16'           GET OFFSET INTO TABLE
         LA        R3,FSENT(R3)        POINTER INTO TABLE
         MVC       0(16,R3),FILNAM     SAVE FILENAME YOU'RE SENDING
         LA        R4,1(R4)            INCREMENT NUMBER OF FILES SENT
         ST        R4,NFSENT
         B         SNDFIL
ADDSP    LA        R0,4096/8           GET 4K BLOCK
         DMSFREE   DWORDS=(0),ERR=ERRSP,MSG=NO
         ST        R1,STORLOC          POINTS TO EXTRA DATA AREA
         OI        FLAGS,FLG5          GOT MORE SPACE (TURN ON FLAG)
ADDSP2   LR        R3,R4               GET CORRECT LENGTH AGAIN
         S         R3,=F'10'           GET PROPER POINTER
         M         R2,=F'16'           OFFSET INTO TABLE
         A         R3,STORLOC          LOC IN TABLE
         MVC       0(16,R3),FILNAM     SAVE FILENAME
         LA        R4,1(R4)            INCREMENT FILE COUNTER
         ST        R4,NFSENT
         B         SNDFIL
ERRSP    MVI       ERRNUM,X'10'        ERR ALLOCATING MORE SPACE
         MVI       STATE,C'A'          ABORT NOW
         B         SLOOP
SNDFIL   L         R15,=A(SPACK)       GET ADDRESS OF 'SPACK'
         BALR      14,15               SAVE * AND GO TO SPACK
         CLI       STATE,C'A'
         BE        ABORT
         L         15,=A(RPACK)        GET ADDRESS OF 'RPACK'
         BALR      14,15               SAVE * AND GO TO RPACK
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       Y2                  MAYBE AN ACK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          SO WE DO TOO
         B         SLOOP
Y2       CLI       RTYPE,AY            SEE IF GOT ACK
         BNE       N2                  MAYBE GOT AN 'N'
         CLC       N,NUM               DO WE HAVE THE CORRECT ACK?
         BE        AOK2
         MVI       ERRNUM,X'08'        MISSING A PACKET SOMEWHERE
         B         SLOOP
AOK2     MVI       STATE,C'D'          PREPARE FOR SEND-DATA STATE
         XC        NUMTRY,NUMTRY       RESET COUNTER
         L         R3,N
         LA        R3,1(R3)            ADD ONE
         ST        R3,N                STORE INCREMENTED VALUE
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         L         15,=A(GTCHR)
         BALR      14,15               DO GET-CHAR AND COME BACK
         B         SLOOP
N2       CLI       RTYPE,AN
         BNE       AB2                 ELSE, DIE
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID
         MVI       ERRNUM,X'09'        MICRO NAK'ED
         B         SLOOP
AB2      MVI       STATE,C'A'          ELSE, ABORT
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE
         B         SLOOP
SDATA    CLC       NUMTRY,MAXTRY       CAN WE DO IT?
         BL        OK4                 YES
         MVI       STATE,C'A'          ELSE ABORT
         B         SLOOP
OK4      L         R3,NUMTRY
         LA        R3,1(R3)            INCREMENT COUNTER
         ST        R3,NUMTRY
         MVI       STYPE,AD            PACKET TYPE = DATA
         L         R15,=A(SPACK)
         BALR      14,15               GO TO SPACK AND RETURN
         CLI       STATE,C'A'
         BE        ABORT
         L         15,=A(RPACK)
         BALR      14,15               SAME FOR RPACK
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       Y4                  MAYBE AN ACK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          SO WE DO TOO
         B         SLOOP
Y4       CLI       RTYPE,AY            SEE IF GOT 'ACK'
         BNE       N4                  SEE IF IT'S AN 'N'
         CLC       N,NUM               DO WE HAVE THE CORRECT ACK?
         BE        AOK4
         MVI       ERRNUM,X'08'        MISSING A PACKET
         B         SLOOP
AOK4     XC        NUMTRY,NUMTRY       RESET COUNTER
         L         R3,N
         LA        R3,1(R3)            INCREMENT COUNTER
         ST        R3,N
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         L         15,=A(GTCHR)
         BALR      14,15               DO GET-CHAR AND RETURN
         B         SLOOP
N4       CLI       RTYPE,AN
         BNE       AB4
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID
         MVI       ERRNUM,X'09'        MICRO NAK'ED
         B         SLOOP
AB4      MVI       STATE,C'A'
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE
         B         SLOOP
SEOF     CLC       NUMTRY,MAXTRY       CAN WE DO IT?
         BL        OK5                 BRANCH IF YES
         MVI       STATE,C'A'          ABORT IF NO
         B         SLOOP
OK5      L         R3,NUMTRY
         LA        R3,1(R3)            ADD ONE
         ST        R3,NUMTRY           STORE INCREMENTED COUNTER
         MVI       STYPE,AZ            PACKET TYPE = EOF
         XC        LSDAT,LSDAT         LENGTH OF ZERO
         L         R15,=A(SPACK)
         BALR      14,15               SAVE * AND GO TO SPACK
         CLI       STATE,C'A'
         BE        ABORT
         L         15,=A(RPACK)
         BALR      14,15               SAME FOR RPACK
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       Y5                  MAYBE AN ACK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          SO WE DO TOO
         B         SLOOP
Y5       CLI       RTYPE,AY            CHECK FOR 'ACK'
         BNE       N5                  MAYBE WAS A 'NAK'
         CLC       N,NUM               CORRECT ACK?
         BE        AOK5
         MVI       ERRNUM,X'08'        LOST A PACKET
         B         SLOOP
AOK5     L         R3,N
         LA        R3,1(R3)            ADD ONE
         ST        R3,N                STORE VALUE INCREMENTED BY 1
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         MVI       STATE,C'F'          SET TO SEND FILE FOR NOW
         B         NXTFIL              GET-NEXT-FILE
NOFIND   TM        FLAGS,FLG1          DID IT DIE ON FIRST TRY?
         BNO       DIEOK               NO ONES == NOT FIRST
         WRTERM    'File not found'
         MVI       STATE,C'A'          ABORT THIS ONE
         B         SLOOP
DIEOK    MVI       STATE,C'B'          BREAK CONNECTION
         B         SLOOP
N5       CLI       RTYPE,AN
         BNE       AB5                 DIE IF NOT A NAK
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID
         MVI       ERRNUM,X'09'        MICRO NAK'ED
         B          SLOOP
AB5      MVI       STATE,C'A'          ELSE, ABORT
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE
         B         SLOOP
SBREAK   CLC       NUMTRY,MAXTRY       OVER OUR LIMIT?
         BL        OK6                 BRANCH IF NO
         MVI       STATE,C'A'          ABORT IF YES
         B         SLOOP
OK6      L         R3,NUMTRY
         LA        R3,1(R3)            ADD ONE
         ST        R3,NUMTRY           INCREMEMTED TRIAL COUNTER
         MVI       STYPE,AB            PACKET TYPE = BREAK
         XC        LSDAT,LSDAT         LENGTH = ZERO
         L         R15,=A(SPACK)
         BALR      14,15               SAVE * AND GO TO SPACK
         CLI       STATE,C'A'
         BE        ABORT
         L         15,=A(RPACK)
         BALR      14,15               SAVE * AND GO TO RPACK
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       Y6                  MAYBE AN ACK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          THEN WE DO TOO
         B         SLOOP
Y6       CLI       RTYPE,AY            CHECK FOR ACK
         BNE       N6                  CHECK FOR 'N'
         CLC       N,NUM               CORRECT ACK?
         BE        AOK6
         MVI       ERRNUM,X'08'        LOST A PACKET
         B         SLOOP
AOK6     MVI       STATE,C'C'          COMPLETED STATE
         B         SLOOP
N6       CLI       RTYPE,AN            CHECK FOR 'N'
         BNE       AB6                 DIE IF NOT A NAK
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID
         MVI       ERRNUM,X'09'        MICRO NAK'ED
         B         SLOOP
AB6      MVI       STATE,C'A'          ELSE,ABORT
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE
         B         SLOOP
GTCHR    LA        R3,FILNAM           GET ADDRESS OF 'FILNAM'
         FSOPEN    (R3),FORM=E         OPEN FILE FOR I/O
         TM        FLAGS,FLG3          SEE IF THERE'S STUFF IN BUF
         BO        STUFF               ONES -> STUFF'S THERE
         FSREAD    (R3),BUFFER=BUF,BSIZE=256,FORM=E
         LTR       R4,R15              PUT RESULT OF READ IN R4
         BZ        OK8
         C         R4,=A(ERCOD)        RETCODE OF 12 MEANS EOF
         BNE       ERR1                TRY IT AGAIN
         MVI       STATE,C'Z'          MAKE TO EOF STATE
         FSCLOSE   (R3)                CLOSE FILE
         BR        R14
ERR1     MVI       STATE,C'A'          ABORT ON FILE SYSTEM ERROR
         MVI       ERRNUM,X'0C'        INVALID RECORD LENGTH
         C         R4,=F'8'            WAS OUR GUESS RIGHT?
         BER       R14                 IF YES, RETURN
         MVI       ERRNUM,X'0D'        ELSE, GOT AN I/O ERROR
         BR        R14
OK8      LR        R5,R0               GET NUMBER OF BYTES READ IN
         LR        R4,R5               SAVE ALSO IN R4
         BCTR      R4,0                SUBTRACT 1 FOR EX COMMAND
         EX        R4,TRANS            EBCDIC TO ASCII TRANSLATION
         LA        R8,BUF              GET LOCATION OF BUFFER INPUT
         LA        R9,BUF(R4)          LAST POSITION IN THAT BUFFER
X4       CLI       0(R9),X'20'         IS THIS A BLANK?
         BNE       X5                  NO, FOUND LAST CHAR OF LINE
         BCTR      R9,0
         CR        R9,R8
         BNL       X4                  FIND LAST CHAR
         SR        R5,R5               ALL BLANKS
         B         FOO
X5       SR        R9,R8
         LR        R5,R9               LENGTH OF LINE
         LA        R5,1(R5)            ADD ONE
FOO      LA        R9,BUF(R5)          FIRST BLANK SPACE AFTER DATA
         MVC       0(1,R9),=X'0D'      ADD ASCII CR
         LA        R9,1(R9)            INCREMENT POINTER
         MVC       0(1,R9),=X'0A'      AND ADD ASCII LF
         LA        R5,2(R5)            TWO EXTRA BYTES OF DATA NOW
         ST        R5,RECL             LRECL + 2 (FOR CRLF)
         SR        R8,R8               ZERO OUT INDEX FOR BUF
STUFF    SR        R9,R9               SAME FOR INDEX FOR SDAT
         SR        R10,R10             CHARACTER COUNTER
         SR        R5,R5               WILL HOLD QUOCHAR
         IC        R5,QUOCHAR
         L         R8,SAVPL            WHERE WE LEFT OFF
         C         R8,RECL             SEE IF ARE AT LIMIT
         BNL       FULL2               LEAVE IF REACHED OR EXCEEDED
         SR        R7,R7
LOOP     IC        R7,BUF(R8)          PICK UP BYTE
         CR        R7,R5               IS IT THE QUOTE CHARACTER?
         BE        SPECIAL
         C         R7,DEL              IS IT THE CHARDEL?
         BE        SPECIAL
         C         R7,SPACE            IS IT A CONTROL CHARACTER?
         BL        SPECIAL
         B         ADDIT
SPECIAL  L         R4,SIZE             MUNGE VALUE WHILE IN R4
         SR        R4,R10              FIND DIF BETWWEN THE TWO
         C         R4,TWO              SEE IF HAVE AT LEAST 2 BYTES
         BNL       ROOM                YES,CAN ADD
         STC       R10,LSDAT+3         SET LSDAT TO VAL OF COUNTER
         OI        FLAGS,FLG3          SET FLAG TO SHOW STUFF'S THERE
         ST        R8,SAVPL            SAVE PLACE IN BUF
         BR        14                  LEAVE THIS ROUTINE
ROOM     LA        R4,SDAT(R9)         WHERE IT'S GOING
         MVC       0(1,R4),QUOCHAR     MOVE QUOTE CHAR THERE
         LA        R9,1(R9)            INCREMENT SDAT COUNTER
         LA        R10,1(R10)          INCREMENT CHARACTER COUNTER
         CR        R7,R5               DON'T ADD ^O100 TO THIS
         BE        ADDIT               IT'S ALREADY PRINTABLE
         A         R7,O1H              ADD ^O100 TO CHAR
         N         R7,=X'0000007F'     GET MOD ^O200
ADDIT    STC       R7,SDAT(R9)         ADD THE CHARACTER
         LA        R9,1(R9)            INCREMENT SDAT COUNTER
         LA        R8,1(R8)            INCREMENT BUF COUNTER
         LA        R10,1(R10)          INCREMENT CHARACTER COUNTER
         C         R8,RECL             SEE IF REACHED LIMIT
         BNL       FULL2
         C         R9,SIZE             SEE IF REACHED LIMIT
         BNL       FULL
         B         LOOP
FULL     EQU       *
         STC       R10,LSDAT+3         THIS ONE TOO
         ST        R8,SAVPL            HERE TOO
         OI        FLAGS,FLG3          TURN ON FLAG - STUFF IN BUF
         BR        14
FULL2    EQU       *
         STC       R10,LSDAT+3         THIS ONE TOO
         XC        SAVPL,SAVPL         RESET THIS
         NI        FLAGS,X'FF'-FLG3    TURN OFF LEFTOVER DATA FLAG
         BR        14
*
ABORT    LA        R3,FILNAM
         FSCLOSE   (R3)                CLOSE THE FILE
         TM        FLAGS,FLG1          DYING ON FILE-NOT-FOUND?
         BO        NOERRP              IF SO, THEN NO ERROR PACKET
         CLI       ERRNUM,X'0A'        DID THE MICRO DIE?
         BE        NOERRP              NO ERROR PACKET IF SO
         MVI       STYPE,AE            ERROR PACKET
         MVC       LSDAT(4),=F'20'     ALL MSGS ARE THIS LONG
         MVC       N(4),NUM            SYNCH PACKET NUMBERS
         SR        R5,R5
         IC        R5,ERRNUM           GET RIGHT MESSAGE NUMBER
         M         R4,=F'20'           OFFSET := ERRNUM * 20
         LA        R5,ERRTAB(R5)
         MVC       SDAT(20),0(R5)      SPACK NEEDS THE DATA HERE
         TR        SDAT(20),ETOA
         L         R15,=A(SPACK)
         BALR      R14,R15             SEND ERROR PACKET & DIE
NOERRP   LA        R15,4               SET NON-ZERO RETCODE
         B         SENDRET             PREPARE TO LEAVE
COMPLETE SR        R15,R15             ZERO WILL BE RETCODE
SENDRET  L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        R14
SENDSAVE DS        18F
TRANS    TR        BUF(0),ETOA         EBCDIC TO ASCII TRANSLATION
TRNS     TR        SNDPKT(0),ATOE      BACK FROM ASCII TO EBCDIC
PARSE    DC        32X'00'
         DC        X'01'               STOP ON A SPACE
         DC        223X'00'
FIRST    MVC       SDAT(0),FILNAM      PICK UP THE FN
SECOND   MVC       0(0,R7),FILNAM+8    PICK UP FT
         LTORG
         DROP      R11
         DROP      R12                 DON'T NEED THEM ANYMORE
         EJECT
SPACK    CSECT
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS
         BALR      R12,0               ESTABLISH ADDRESSABILITY
         USING     *,R12
         LA        R14,SPSAVE          ADDRESS OF MY SAVE AREA
         ST        R13,4(R14)          SAVE CALLER'S
         ST        R14,8(R13)
         LR        R13,R14
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
         L         R11,=A(PARMS)
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY
         SR        R9,R9
         MVI       PHDR,SOH            ADD CONTROL-A TO PACKET
         CLC       LSDAT,SIZE          NEED DATA SIZE <= SPSIZ-5
         BNH       FINE
         MVI       ERRNUM,X'00'        DATA SIZE EXCEEDS MAX LIMIT
         MVI       STATE,C'A'          ABORT ON THIS
         B         SPRET
FINE     L         R4,=F'35'           USE ^o43 TO OFFSET DATA
         A         R4,LSDAT            ADD IT TO LSDAT
         STC       R4,PLEN
         AR        R9,R4               AND THEN ADD IT TO CHECKSUM
         CLC       N,ZERO              CHECK IF N IS VALID
         BNL       T1                  OK IF >= TO 0
         MVI       ERRNUM,X'01'        ILLEGAL MESSAGE NUMBER
         MVI       STATE,C'A'
         B         SPRET
T1       CLC       N,O1H               SEE IF IS <= OCTAL 100
         BNH       T2
         MVI       ERRNUM,X'01'        ILLEGAL MESSAGE NUMBER
         MVI       STATE,C'A'
         B         SPRET
T2       L         R4,SPACE            OFFSET THIS VALUE TOO
         A         R4,N                ADD IT TO N
         ST        R4,TEMP
         MVC       PNUM(1),TEMP+3
         A         R9,TEMP             AND ADD TO CHECKSUM
         CLI       STYPE,X'41'         ASCII 'A'
         BL        T3                  CAN'T BE LESS THAN THIS
         CLI       STYPE,X'5A'         ASCII 'Z'
         BNH       T4                  CAN'T BE GREATER
T3       MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE
         MVI       STATE,C'A'          DIE ON THIS
         B         SPRET
T4       MVC       PTYPE(1),STYPE      ADD MESSAGE TYPE
         SR        R2,R2               ZERO IT OUT
         IC        R2,STYPE
         AR        R9,R2               ADD TO CHECKSUM
         L         R6,LSDAT            HOW MUCH DATA
         LTR       R6,R6               TEST IT OUT
         BZ        NODAT
         SR        R5,R5               USE TO GET DATA
         SR        R3,R3               USE TO HOLD DATA
DATCHK   IC        R3,SDAT(R5)         PICK UP CHAR
         AR        R9,R3               ADD TO CHECKSUM
         LA        R5,1(R5)            BUMP POINTER
         BCTR      R6,0
         LTR       R6,R6               MORE DATA?
         BNZ       DATCHK
NODAT    L         R6,LSDAT            WILL NEED THIS LATER
         LR        R7,R6               MUNGE WHILE IN R7
         BCTR      R7,0                SUBTRACT 1 FOR EX FUNCTION
         EX        R7,MOVE             MOVE THE DATA TO SNDPKT
         ST        R9,TEMP             WE'LL NEED THIS SOON
         N         R9,=X'000000C0'     GET MOD 192
         M         R8,ONE              CARRY OVER THE SIGN BIT
         D         R8,O1H              GET MOD 64
         A         R9,TEMP             ADD THE TWO VALUES
         N         R9,=X'0000003F'     GET MOD 64 OF CHECKSUM
         A         R9,SPACE            ADD OFFSET
         STC       R9,PDATA(R6)        ADD CHECKSUM AFTER DATA
         LA        R6,1(R6)            MOVE POINTER
         IC        R9,SEOL             ADD SEND END OF PACKET CHAR
         STC       R9,PDATA(R6)
         LA        R6,5(R6)            VALUE OF LSDAT+5
         TR        SNDPKT(130),ATOE    SEND IN EBCDIC
         WRTERM    SNDPKT,(R6),EDIT=NO
SPRET    L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        14
SPSAVE   DS        18F
MOVE     MVC       PDATA(0),SDAT
         LTORG
         DROP      R11
         DROP      R12                 DON'T NEED THEM ANYMORE
         EJECT
RPACK    CSECT
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS
         BALR      R12,0               ESTABLISH ADDRESSABILITY
         USING     *,R12
         LA        R14,RPSAVE          ADDRESS OF MY SAVE AREA
         ST        R13,4(R14)          SAVE CALLER'S
         ST        R14,8(R13)
         LR        R13,R14
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA
         L         R11,=A(PARMS)
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY
         RDTERM    RECPKT,EDIT=NO
         TR        RECPKT(130),ETOA
         NI        FLAGS,X'FF'-FLG4    ASSUME MICRO'LL NAK-NOT RPACK
         SR        R8,R8               INDEX REG FOR RECPKT
         SR        R5,R5               CHECKSUM REGISTER
TRY      LA        R7,RECPKT(R8)       ADDRESS OF CHARACTER
         CLI       0(R7),SOH           IS IT CONTROL-A
         BE        READIN              YES; SO FAR, SO GOOD
         LA        R8,1(R8)            TRY NEXT CHARACTER
         C         R8,=F'130'          SEE IF EXCEED BUFFER
         BL        TRY
         MVI       ERRNUM,X'03'        NO "SOH" ERROR
         B         BADP
READIN   SR        R9,R9               ZERO OUT INDEX REG FOR RDAT
         LA        R8,1(R8)            INCREMENT COUNTER
         LA        R7,RECPKT(R8)       PICK UP LOC OF CHAR COUNT
         CLI       0(R7),SOH           IS IT CONTROL-A
         BE        READIN              START OVER
         CLC       0(1,R7),DQUOTE      COUNT+' '+3 AND ^d35
         BNL       CONT                CONTINUE IF >=
         MVI       ERRNUM,X'04'        BAD LENGTH ATTRIBUTE
         B         BADP
CONT     IC        R5,0(R7)            START CHECKSUM
         LR        R7,R5               MUNGE IN R7 TO GET LRDAT
         S         R7,=F'35'           LENGTH OF DATA
         STC       R7,LRDAT+3
         LA        R8,1(R8)            INCREMENT
         SR        R7,R7               ZERO IT OUT
         IC        R7,RECPKT(R8)       PICK UP PACKET NUMBER
         C         R7,=A(SOH)          IS IT CONTROL-A
         BE        READIN
         AR        R5,R7               ADD TO CHECKSUM
         S         R7,SPACE            SUBTRACT THE ' '
         STC       R7,NUM+3            NUM := RECEIVED PACKET NO.
         LA        R8,1(R8)            INCREMENT COUNTER
         IC        R7,RECPKT(R8)       PICK UP MESSAGE TYPE
         C         R7,=A(SOH)          IS IT CONTROL-A
         BE        READIN
         AR        R5,R7               ADD TO CHECKSUM
         STC       R7,RTYPE            PUT INTO RTYPE
         LA        R8,1(R8)            GO TO NEXT BYTE
         L         R4,LRDAT            COUNTER TO GET ALL DATA
LUP      C         R4,ZERO             SEE IF PICKED UP ALL DATA
         BE        FIN
         XC        TEMP,TEMP           ZERO IT OUT
         LA        R7,RECPKT(R8)       NEXT LOCATION IN BUFFER
         MVC       TEMP+3(1),0(R7)     PICK UP NEXT BYTE
         CLI       TEMP+3,SOH          IS IT CONTROL-A
         BE        READIN
         LA        R7,RDAT(R9)         WHERE THE DATA'S GOING
         MVC       0(1,R7),TEMP+3      AND MOVE IT
         A         R5,TEMP             ADD TO CHECKSUM
         LA        R8,1(R8)            ADD ONE
         LA        R9,1(R9)            ADD ONE
         BCTR      R4,0                DECREMENT COUNTER
         B         LUP
FIN      SR        R7,R7               ZERO OUT REGISTER
         IC        R7,RECPKT(R8)       GET CHECKSUM
         C         R7,=A(SOH)          IS IT CONTROL-A
         BE        READIN
         ST        R5,TEMP             WE'LL NEED THIS SOON
         N         R5,=X'000000C0'     GET MOD 192
         M         R4,ONE              CARRY OVER THE SIGN BIT
         D         R4,O1H              GET MOD 64
         A         R5,TEMP             ADD THE TWO VALUES
         N         R5,=X'0000003F'     GET MOD 64
         A         R5,SPACE            ADD OFFSET
         CR        R5,R7               COMPUTED VS RECEIVED CHECKSUM
         BE        RPRET
         MVI       ERRNUM,X'05'        BAD CHECKSUM ERROR
BADP     MVI       RTYPE,AN            RETURN A NAK
         OI        FLAGS,FLG4          RPACK NAK'ED THE PACKET
RPRET    L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        14
RPSAVE   DS        18F
         LTORG
         DROP      R11
         DROP      R12                 DON'T NEED THEM ANYMORE
         EJECT
RECEIVE  CSECT
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS
         BALR      R12,0               ESTABLISH ADDRESSABILITY
         USING     *,R12
         LA        R14,RECSAVE         ADDRESS OF MY SAVE AREA
         ST        R13,4(R14)          SAVE CALLER'S
         ST        R14,8(R13)
         LR        R13,R14
* USE R11 AS BASE REGISTER FOR THE GLOBAL DATA AREA, 'PARMS'
         L         R11,=A(PARMS)
         USING     PARMS,R11
         SR        R6,R6               GET ZERO
         ST        R6,NUMTRY           ZERO THIS OUT
         ST        R6,N                HERE TOO
         MVI       STATE,C'R'          SET TO RECEIVE STATE
RLOOP    CLI       STATE,C'D'          RECEIVE DATA STATE
         BE        RDATA
         CLI       STATE,C'F'          RECEIVE FILE STATE
         BE        RFILE
         CLI       STATE,C'R'          RECEIVE INIT STATE
         BE        RINIT
         CLI       STATE,C'C'          COMPLETE STATE
         BE        RCOMP
         CLI       STATE,C'A'          ABORT STATE
         BE        RABORT
         MVI       ERRNUM,X'02'        UNRECOGNIZED STATE
         B         RABORT              ELSE, DIE
RINIT    CLC       NUMTRY,IMXTRY       SEE IF CAN RECEIVE
         BL        ROK1                YES, WE CAN
         MVI       STATE,C'A'          NOPE, GO INTO ABORT STATE
         B         RLOOP
ROK1     L         R3,NUMTRY
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER
         ST        R3,NUMTRY
         L         R4,DSSIZ            DEFAULT SEND PACKET SIZE
         S         R4,FIVE             USE DEFAULT TO SET "SIZE"
         ST        R4,SIZE             IN CASE WE DIE BEFORE IT'S SET
         L         R15,=A(RPACK)       GET INIT INFORMATION
         BALR      R14,R15
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       RY1                 ALL OK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          SO WE DO TOO
         B         RLOOP
RY1      CLI       RTYPE,AS            IS IT A SEND-INIT PACKET
         BNE       RN1                 MAYBE IT GOT CLOBBERED
         SR        R4,R4               ZERO OUT REGISTER
         IC        R4,RDAT             GET FIRST CHARACTER
         S         R4,SPACE            SUBTRACT THE ' '
         C         R4,=F'26'           MIN SPACK SIZE
         BNL       RCH1                SO FAR, SO GOOD
         MVI       STATE,C'A'          ELSE, ABORT
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR
         B         RLOOP
RCH1     C         R4,MAXPACK          MAX PACKET SIZE
         BNH       RCH2
         MVI       STATE,C'A'          ABORT IF SIZE IS ILLEGAL
         MVI       ERRNUM,X'00'        BAD SEND DATA LENGTH
         B         RLOOP
RCH2     STC       R4,SPSIZ+3          USE THE VALUE AS SEND SIZE
         S         R4,FIVE
         ST        R4,SIZE             SET IT TO SPSIZ-5
         CLC       LRDAT(4),=F'4'      USING ALL DEFAULTS ?
         BNH       NOCH                YUP
         LA        R5,RDAT             POINT TO THE BUFFER
         SR        R7,R7
         IC        R7,4(R5)            SEOL THE MICRO WANTS
         S         R7,SPACE            UNCHAR (SUBTRACT ' ')
         STC       R7,SEOL
         CLC       LRDAT(4),FIVE       ANY MORE DATA?
         BNH       NOCH                JUST USE DEFAULTS
         MVC       RQUO(1),5(R5)       SET NEW QUOCHAR VALUE
NOCH     MVC       N(4),NUM            SYNCH PACKET NUMBERS
         MVI       STYPE,AY            SET MESSAGE TYPE TO ACK
         MVC       LSDAT(4),=F'6'      SET LENGTH OF DATA SENDING
         L         R5,SPACE            MAKE CHARACTER PRINTABLE
         A         R5,RPSIZ            ADD REC PACKET SIZE
         STC       R5,SDAT             ADD SIZE INFO TO BUFFER
         L         R5,SPACE
         A         R5,=F'8'            8 FOR TIMEOUT
         STC       R5,SDAT+1
         L         R5,SPACE            SEND ZERO + " " FOR NPAD
         STC       R5,SDAT+2           WE'RE THE SLOW GUYS
         SR        R5,R5               PAD WITH NULLS
         L         R3,O1H
         XR        R5,R3               CTL FUNCTION (XOR WITH 64)
         STC       R5,SDAT+3           DON'T NEED PADCHAR EITHER
         SR        R5,R5               ZERO IT OUT FOR NEXT TWO GUYS
         IC        R5,REOL             EOL CHAR I NEED
         A         R5,SPACE            MAKE PRINTABLE
         STC       R5,SDAT+4
         IC        R5,QUOCHAR          MY QUOTE CHAR
         STC       R5,SDAT+5
         L         R15,=A(SPACK)       ADDRESS OF SPACK
         BALR      R14,R15             SAVE * AND GO TO SPACK
         CLI       STATE,C'A'
         BE        RABORT
         MVI       STATE,C'F'          SET TO RECEIVE FILE STATE
         MVC       OLDTRY(4),NUMTRY    SAVE TRIAL COUNTER
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO
         L         R3,N
         LA        R3,1(R3)            ADD ONE
         ST        R3,N                STORE VALUE INCREMENTED BY 1
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         B         RLOOP
RN1      CLI       RTYPE,AN            MAYBE IT'S A NAK
         BNE       RSELSE
         MVI       STYPE,AN            SEND A NAK PACKET
         XC        LSDAT,LSDAT         NO DATA
         L         R15,=A(SPACK)
         BALR      R14,R15
         B         RLOOP
RSELSE   MVI       STATE,C'A'          ELSE,ABORT
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE
         B         RLOOP
RFILE    CLC       NUMTRY,MAXTRY       EXCEEDED NO. OF TRIALS ALLOWED
         BL        ROK2                NOPE, STILL OK
         MVI       STATE,C'A'          ABORT IF YES
         B         RLOOP
ROK2     L         R3,NUMTRY
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER
         ST        R3,NUMTRY
         L         R15,=A(RPACK)       GET ADDRESS OF RPACK
         BALR      R14,R15             GO THERE AND RETURN WHEN DONE
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       RY2                 MAYBE AN ACK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          SO WE DO TOO
         B         RLOOP
RY2      CLI       RTYPE,AS            STILL IN INIT STATE?
         BNE       RNZ                 TRY FOR AN EOF
         CLC       OLDTRY,MAXTRY       CAN WE TRY AGAIN?
         BL        ROLD
         MVI       STATE,C'A'          ELSE, ABORT
         B         RLOOP
ROLD     L         R3,OLDTRY
         LA        R3,1(R3)            INCREMENT COUNTER
         ST        R3,OLDTRY
         L         R3,N                GET PACKET NUMBER SENT
         BCTR      R3,0                SUBTRACT ONE FROM IT
         C         R3,NUM              NUM MUST EQUAL N-1
         BE        RNUM
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING
         B         RNAK                SEND A NAK
RNUM     MVI       STYPE,AY            ACK PACKET
         ST        R3,N                MAKE SEND SEQ NO. = N-1
         MVC       LSDAT(4),=F'6'      SET DATA LENGTH VARIABLE
         L         R15,=A(SPACK)
         BALR      R14,R15             GO TO SPACK AND RETURN
         CLI       STATE,C'A'
         BE        RABORT
         L         R4,N
         LA        R4,1(R4)            ADD ONE
         ST        R4,N                RESTORE N TO PROPER VALUE
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO
         B         RLOOP
RNZ      CLI       RTYPE,AZ
         BNE       RNF                 MAYBE IT'S AN 'F'
         CLC       OLDTRY,MAXTRY       CAN WE TRY AGAIN?
         BL        ROLD2
         MVI       STATE,C'A'          ELSE,ABORT
         B         RLOOP
ROLD2    L         R3,OLDTRY
         LA        R3,1(R3)            INCREMENT COUNTER
         ST        R3,OLDTRY
         L         R3,N                GET PACKET NUMBER SENT
         BCTR      R3,0                SUBTRACT ONE FROM IT
         C         R3,NUM              NUM MUST EQUAL N-1
         BE        RNUM2
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING
         B         RNAK                SEND A NAK
RNUM2    MVI       STYPE,AY            ACK PACKET
         ST        R3,N                SEND SEQ := N-1
         XC        LSDAT,LSDAT         NO DATA
         L         R15,=A(SPACK)
         BALR      R14,R15
         CLI       STATE,C'A'
         BE        RABORT
         L         R4,N
         LA        R4,1(R4)            ADD ONE
         ST        R4,N                RESTORE N TO PROPER VALUE
         LA        R3,FILNAM
         FSCLOSE   (R3)                CLOSE FILE WHEN DONE
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO
         B         RLOOP
RNF      CLI       RTYPE,AF
         BNE       RNB                 WELL, IT'S NOT A FNAME
         CLC       NUM,N               THEY HAVE TO BE EQUAL
         BE        RNUM3
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING
         B         RNAK                SEND A NAK
RNUM3    MVI       STYPE,AY            ACK PACKET
         XC        LSDAT,LSDAT         NO DATA
         TM        FLAGS,FLG2          OVERWRITE THE NAME SENT?
         BO        OVER                YUP,WE DO
         L         R5,LRDAT            GET SIZE OF FILNAM
         LTR       R5,R5               CHECK LENGTH
         BZ        SAYNO               DIE IF NO FILENAME
         SR        R9,R9               USE AS POINTER WITHIN BUFFER
         LA        R9,RDAT(R9)         GET LOC OF FIRST CHAR
         LR        R8,R9
REMDOT   CLC       0(1,R9),=X'2E'      LOOK FOR THE DOT
         BE        DOT                 FOUND IT
         LA        R9,1(R9)            NEXT POSITION
         LR        R10,R9
         SR        R10,R8              GET LENGTH OF NAME SO FAR
         CR        R10,R5              AT END OF FN?
         BL        REMDOT              NO,KEEP LOOKING
         B         SAYNO               DIE IF NO DOT AT ALL
DOT      LR        R5,R9               SAVE OUR PLACE
         LA        R5,1(R5)            NEXT CHARACTER
         SR        R9,R8               GET LENGTH OF FNAME
         LR        R4,R9               SAVE LENGTH ATTRIBUTE
         BCTR      R4,0
         C         R9,=F'8'            MAX OF 8 CHARACTERS
         BNH       DOT2
         L         R9,=F'8'            TRUNCATE EXTRA LETTERS
DOT2     BCTR      R9,0                FOR EX COMMAND
         LTR       R9,R9               CHECK LENGTH
         BM        SAYNO               DIE IF IT'S ZERO
         MVC       FILNAM,=18X'20'     INITIALIZE TO BLANKS
         EX        R9,GETFN            GET FILNAM
         L         R7,LRDAT            GET LENGTH OF WHOLE NAME
         SR        R7,R4               AND GET LENGTH OF FTYPE
         S         R7,=F'3'
         LTR       R7,R7               CHECK LENGTH
         BM        SAYNO               DIE IF ZERO
         C         R7,=F'7'            MAX IS 8 (7 + 1 FOR 'EX')
         BNH       DOT3
         L         R7,=F'7'            TRUNCATE EXTRA LETTERS
DOT3     EX        R7,GETFT            GET FTYPE
         TR        FILNAM(18),ATOE     NEED IT IN EBCDIC
         MVC       FILNAM+16(2),FM     ADD DEFAULT FMODE
OVER     L         R15,=A(SPACK)
         BALR      R14,R15             SEND ACK
         CLI       STATE,C'A'
         BE        RABORT
         OC        FILNAM,=CL18' '      UPPERCASE FILENAME
         LA        R3,FILNAM
         FSOPEN    (R3),FORM=E
         MVC       OLDTRY(4),NUMTRY    KEEP NUMTRY FOR LATER
         XC        NUMTRY,NUMTRY       RESET TO ZERO
         L         R3,N
         LA        R3,1(R3)            ADD ONE
         ST        R3,N                INCREMENT COUNTER
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         MVI       STATE,C'D'          DATA RECEIVE STATE
         B         RLOOP
RNB      CLI       RTYPE,AB            SEE IF IT'S A BREAK
         BNE       RNN                 MAYBE GOT A NAK
         CLC       NUM,N
         BE        RNUM4
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING
         B         RNAK                SEND A NAK
RNUM4    MVI       STYPE,AY            ACK PACKET
         XC        LSDAT,LSDAT         NO DATA
         L         R15,=A(SPACK)
         BALR      R14,R15
         CLI       STATE,C'A'
         BE        RABORT
         MVI       STATE,C'C'          COMPLETE STATE
         B         RLOOP
RNN      CLI       RTYPE,AN            SEE IF GOT A NAK
         BNE       RNELSE
RNAK     MVI       STYPE,AN            SEND A NAK PACKET
         XC        LSDAT,LSDAT         NO DATA
         L         R15,=A(SPACK)
         BALR      R14,R15
         B         RLOOP               DO NOTHING ON A NAK
RNELSE   MVI       STATE,C'A'          ABORT OTHERWISE
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE
         B         RLOOP
RDATA    CLC       NUMTRY,MAXTRY       HAVE WE EXCEEDED OUR LIMIT?
         BL        ROK3
         MVI       STATE,C'A'          ELSE, ABORT
         B         RLOOP
ROK3     L         R4,NUMTRY
         LA        R4,1(R4)            INCREMENT
         ST        R4,NUMTRY           SAVE INCREMENTED COUNTER
         L         R15,=A(RPACK)
         BALR      R14,R15             CALL RPACK
         CLI       RTYPE,AE            ERROR PACKET?
         BNE       RY3                 MAYBE AN ACK
         MVI       ERRNUM,X'0A'        MICRO DIED
         MVI       STATE,C'A'          WE ABORT TOO
         B         RLOOP
RY3      CLI       RTYPE,AD            IS THIS A DATA PACKET?
         BNE       RDF                 MAYBE IT'S AN FNAME PACKET
         CLC       N,NUM               CHECK FOR RIGHT PACKET
         BNE       DIF
         L         R15,=A(PTCHR)
         BALR      R14,R15             PUT CHARACTERS INTO FILE
         LTR       R7,R7               CHECK FOR NO ERROR
         BZ        OKWR                NO ERROR
         MVI       STATE,C'A'          ABORT ON FILE SYSTEM ERROR
         B         RLOOP
OKWR     MVI       STYPE,AY            ACK PACKET
         XC        LSDAT,LSDAT         NO DATA
         L         R15,=A(SPACK)
         BALR      R14,R15
         CLI       STATE,C'A'
         BE        RABORT
         MVC       OLDTRY(4),NUMTRY    SAVE NUMTRY'S VALUE IN OLDTRY
         XC        NUMTRY,NUMTRY       RESET NUMTRY
         L         R3,N
         LA        R3,1(R3)
         ST        R3,N                INCREMENT COUNTER
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         B         RLOOP
DIF      CLC       OLDTRY,MAXTRY       CAN WE DO IT?
         BL        DIFNUM
         MVI       STATE,C'A'          AND ABORT
         B         RLOOP
DIFNUM   L         R4,OLDTRY
         LA        R4,1(R4)
         ST        R4,OLDTRY           INCREMENT THIS COUNTER
         L         R4,N
         BCTR      R4,0
         C         R4,NUM              NUM MUST EQUAL N-1
         BE        DIFOK
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING
         B         RDN1                SEND A NAK
DIFOK    XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO
         MVI       STYPE,AY            ACK PACKET
         XC        LSDAT,LSDAT         NO DATA
         ST        R4,N                SET N TO N-1 TO RESEND PACKET
         L         R15,=A(SPACK)
         BALR      R14,R15             SEND THE PACKET
         CLI       STATE,C'A'
         BE        RABORT
         L         R4,N
         LA        R4,1(R4)            ADD ONE
         ST        R4,N                RESTORE N TO PROPER VALUE
         B         RLOOP               AND RETURN
RDF      CLI       RTYPE,AF            SENDING FILENAME AGAIN?
         BNE       RDZ
         CLC       OLDTRY,MAXTRY       CAN WE DO IT?
         BL        FILOVER             TRYING IT AGAIN
         MVI       STATE,C'A'          IF NO, ABORT
         B         RLOOP
FILOVER  L         R4,OLDTRY
         LA        R4,1(R4)
         ST        R4,OLDTRY           SAVE INCREMENTED VALUE
         L         R4,N
         BCTR      R4,0                NEED VALUE OF N-1
         C         R4,NUM              N-1 MUST EQUAL NUM
         BE        FILOK
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING
         B         RDN1                SEND A NAK
FILOK    XC        NUMTRY,NUMTRY       RESET TO ZERO
         XC        LSDAT,LSDAT         NO DATA
         MVI       STYPE,AY            ACK PACKET AGAIN
         ST        R4,N                SET N TO N-1 FOR NOW
         TM        FLAGS,FLG2          OVERWRITE THE NAME SENT?
         BO        OVRWRT              YUP, WE DO
         L         R5,LRDAT            GET SIZE OF FILNAM
         LTR       R5,R5               CHECK LENGTH
         BZ        SAYNO               DIE IF NO FILENAME
         SR        R9,R9               USE AS POINTER WITHIN BUFFER
         LA        R9,RDAT(R9)         GET LOC OF FIRST CHAR
         LR        R8,R9
RMDOT    CLC       0(1,R9),=X'2E'      LOOK FOR THE DOT
         BE        ADOT                FOUND IT
         LA        R9,1(R9)            NEXT POSITION
         LR        R10,R9
         SR        R10,R8              GET LENGTH OF NAME SO FAR
         CR        R10,R5              AT THE END OF THE FILNAM ?
         BL        RMDOT               NO,KEEP LOOKING
         B         SAYNO               DIE IF NO DOT AT ALL
ADOT     LR        R5,R9               SAVE OUR PLACE
         LA        R5,1(R5)            NEXT CHARACTER
         SR        R9,R8               GET LENGTH OF FNAME
         LR        R6,R9               SAVE LENGTH ATTRIBUTE
         BCTR      R6,0
         C         R9,=F'8'            MAX OF 8 CHARACTERS
         BNH       DT2
         L         R9,=F'8'            TRUNCATE EXTRA LETTERS
DT2      BCTR      R9,0                FOR EX COMMAND
         LTR       R9,R9               CHECK LENGTH
         BM        SAYNO               DIE IF IT'S ZERO
         MVC       FILNAM,=18X'20'     INITIALIZE TO BLANKS
         EX        R9,GETFN            GET FILNAM
         L         R7,LRDAT            GET LENGTH OF WHOLE NAME
         SR        R7,R6               AND GET LENGTH OF FTYPE
         S         R7,=F'3'
         LTR       R7,R7               CHECK LENGTH
         BM        SAYNO               DIE IF ZERO
         C         R7,=F'7'            MAX IS 8 (7 + 1 FOR 'EX')
         BNH       DT3
         L         R7,=F'7'            TRUNCATE EXTRA LETTERS
DT3      EX        R7,GETFT            GET FTYPE
         TR        FILNAM(18),ATOE     NEED IT IN EBCDIC
         MVC       FILNAM+16(2),FM     ADD DEFAULT FMODE
OVRWRT   L         R15,=A(SPACK)
         BALR      R14,R15
         CLI       STATE,C'A'
         BE        RABORT
         OC        FILNAM,=CL18' '     UPPERCASE FILENAME
         LA        R3,FILNAM           GET FILE NAME
         FSOPEN    (R3),FORM=E         OPEN FILE FOR WRITING
         L         R4,N
         LA        R4,1(R4)            ADD ONE
         ST        R4,N                RESTORE N TO PROPER VALUE
         B         RLOOP               AND RETURN
RDZ      CLI       RTYPE,AZ            IS THIS AN EOF PACKET?
         BNE       RDN
         CLC       N,NUM               ARE THEY EQUAL
         BE        RDOK
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING
         B         RDN1                SEND A NAK
RDOK     MVI       STYPE,AY            ACK THE PACKET
         XC        LSDAT,LSDAT         NO DATA
         L         R15,=A(SPACK)
         BALR      R14,R15
         LA        R3,FILNAM
         FSCLOSE   (R3)
         MVC       OLDTRY(4),NUMTRY    SAVE NUMTRY'S VALUE HERE
         XC        NUMTRY,NUMTRY       AND RESET COUNTER
         L         R3,N
         LA        R3,1(R3)
         ST        R3,N                STORE VALUE INCREMENTED BY 1
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64
         MVI       STATE,C'F'          TRY FOR ANOTHER FILE
         B         RLOOP
RDN      CLI       RTYPE,AN            DO WE NEED TO SEND A NAK?
         BNE       RDELSE
RDN1     MVI       STYPE,AN            SEND A NAK
         XC        LSDAT,LSDAT         NO DATA
         L         R15,=A(SPACK)
         BALR      R14,R15
         B         RLOOP
RDELSE   MVI       STATE,C'A'          UNRECOGNIZED PACKET - ABORT
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE
         B         RLOOP
SAYNO    MVI       STYPE,AN            SEND A NAK PACKET
         XC        LSDAT,LSDAT         NO DATA
         MVI       ERRNUM,X'0B'        ILLEGAL FILENAME ERROR
         L         R15,=A(SPACK)
         BALR      R14,R15
         B         RLOOP
PTCHR    SR        R4,R4               USE TO HOLD QUOCHAR
         SR        R6,R6               USE TO HOLD LRECL
         SR        R8,R8               COUNTER WITHIN RDAT
         L         R9,RSAVPL           COUNTER WITHIN RBUF
         IC        R4,RQUO
         IC        R6,LRECL
         L         R5,LRDAT            COUNTER TO GET ALL DATA
RLUP     SR        R7,R7               USE TO PICK UP CHAR
         LTR       R5,R5               MORE DATA LEFT?
         BNZ       MOR                 LEAVE IF ALL DONE
         CLI       PREV,X'4D'          ARE WE IN MIDDLE OF LINE?
         BER       R14                 LEAVE IF NOT
         ST        R9,RSAVPL           SAVE OUR PLACE
         SR        R7,R7               ZERO RETCODE
         BR        R14
MOR      BCTR      R5,0                DECREMENT CHAR COUNTER
         IC        R7,RDAT(R8)         GET DATA FROM RDAT
         CR        R7,R4               IS IT THE QUOTE CHARACTER?
         BNE       REGULAR
         BCTR      R5,0                DECREMENT CHAR COUNT
         LA        R8,1(R8)            MOVE POINTER
         IC        R7,RDAT(R8)         PICK UP SPECIAL CHAR
         C         R7,=X'0000004D'     IS IT A CR? (CHAR(CR))
         BNE       NOCR                WRITE OUT RECORD IF YES
         MVI       PREV,X'4D'          JUST HAD A CR
         LA        R8,1(R8)            IGNORE CONTROL CHAR
         B         RFIN
NOCR     C         R7,=X'0000004A'     HOW ABOUT A LF? (CHAR(LF))
         BNE       NOLF                IF YES, WRITE OUT RECORD
         LA        R8,1(R8)            IGNORE CONTROL CHAR
         CLI       PREV,X'4D'          WAS LAST THING CR?
         BNE       RFIN                NOPE, THEN KEEP ON
         B         RLUP                IGNORE LF IF PREV=CR
NOLF     CR        R7,R4               IS IT THE QUOCHAR
         BE        REGULAR             DON'T CONVERT IF IT IS
         A         R7,O1H              ADD ^O100
         N         R7,=X'0000007F'     GET MOD ^O200
REGULAR  STC       R7,RBUF(R9)         STORE CHAR IN RBUF
         LA        R9,1(R9)            MOVE RBUF COUNTER
         LA        R8,1(R8)            MOVE RDAT COUNTER
         MVI       PREV,X'00'          BLANK OUT CR IF WAS THERE
         C         R9,=F'255'          ONLY 256 CHARS ALLOWED
         BNH       RLUP                AND CONTINUE
         LR        R10,R9              USE MAX LENGTH OF 256
         B         WRFIL               AND WRITE TO FILE
RFIN     LTR       R10,R9              GET DATA SIZE
         BZ        FUDGE               GOTTA FAKE A BLANK LINE
         C         R7,=X'0000004D'     IS IT A CR?  (CHAR(CR))
         BE        WRFIL
         C         R7,=X'0000004A'     HOW ABOUT A LF? (CHAR(LF))
         BE        WRFIL
         ST        R10,RSAVPL          SAVE DATA RECEIVED SO FAR
         SR        R7,R7               ZERO RETCODE
         BR        14
FUDGE    MVI       RBUF,X'20'          MAKE FIRST CHAR A SPACE
         LA        R10,1(R10)          LENGTH OF ONE
WRFIL    XC        RSAVPL,RSAVPL       RESET THE POINTER
         TR        RBUF(256),ATOE      MAKE EBCDIC AGAIN
         LA        R3,FILNAM
         CLI       RFM,C'V'            IS IT VARIABLE FORMAT?
         BE        VAR
         CR        R10,R6
         BH        PUR                 IGNORE DATA AFTER LRECL VALUE
         CR        R10,R6              PAD OUT TO LRECL SIZE ?
         BE        VAR                 NOPE, IT'S OK.
         LR        R2,R6               GET LRECL SIZE
         SR        R2,R10              PAD WITH THIS MANY SPACES
         BCTR      R2,0                MINUS ONE FOR THE 'EX'
         LA        R9,RBUF(R10)        START PADDING HERE
         MVI       0(R9),C' '          PUT IN THE FIRST SPACE
         LTR       R2,R2
         BZ        PUR                 DON'T PAD IF SIZE DIF WAS ONE
         BCTR      R2,0                SUBRTRACT SPACE WE JUST ADDED
         EX        R2,PAD              PAD OUT BUFFER
PUR      LR        R10,R6              LENGTH HAS TO BE THIS SIZE
VAR      SR        R6,R6
         IC        R6,RFM              RECFM HAS TO BE IN A REGISTER
         FSWRITE   (R3),BUFFER=RBUF,BSIZE=(R10),RECFM=(R6),FORM=E
         LR        R7,R15              CHECK THE RETCODE
         SR        R9,R9               START AT BEGINNING OF RBUF
         SR        R6,R6               Zero it out. [edit]
         IC        R6,LRECL            Reset the LRECL value. [edit]
         LTR       R7,R7               CHECK RETCODE
         BZ        RLUP                GET NEXT LINE IF OK
         C         R7,=A(ERCOD)        IS THE DISK READ-ONLY?
         BNE       WRERR1
         MVI       ERRNUM,X'0E'
         BR        R14
WRERR1   MVI       ERRNUM,X'0F'        ASSUME A RECFM CONFLICT
         C         R7,=F'16'           FILE EXISTS W/DIF RECFM
         BER       R14
         MVI       ERRNUM,X'06'        DISK FULL ERROR
         BR        R14
*
RABORT   LA        R3,FILNAM
         FSCLOSE   (R3)                CLOSE OPEN FILE
         CLI       ERRNUM,X'0A'        DID THE MICRO DIE?
         BE        RNOERRP             NO ERROR PACKET IF SO
         MVI       STYPE,AE            ERROR PACKET
         MVC       LSDAT(4),=F'20'     ALL MSGS ARE THIS LONG
         MVC       N(4),NUM            SYNCH PACKET NUMBERS
         SR        R5,R5
         IC        R5,ERRNUM
         M         R4,=F'20'           OFFSET := ERRNUM * 20
         LA        R5,ERRTAB(R5)
         MVC       SDAT(20),0(R5)      SPACK NEEDS THE DATA HERE
         TR        SDAT(20),ETOA
         L         R15,=A(SPACK)
         BALR      R14,R15             SEND ERROR PACKET & DIE
RNOERRP  LA        R15,4               SET A NON-ZERO RETCODE
         B         RECRET              PREPARE TO LEAVE
RCOMP    SR        R15,R15             RETCODE OF ZERO
RECRET   L         R13,4(R13)
         L         R14,12(R13)
         LM        R0,R12,20(R13)
         BR        14
RECSAVE  DS        18F
GETFN    MVC       FILNAM(0),RDAT      PICK UP FNAME
GETFT    MVC       FILNAM+8(0),0(R5)   PICK UP FTYPE
PAD      MVC       1(0,R9),0(R9)       PAD OUT WITH SPACES
         LTORG
         DROP      R11
         DROP      R12                 DON'T NEED THEM ANYMORE
         END       KERMIT
