         PRINT ON,GEN                                                   00010000
KERMIT   TITLE     'KERMIT-EC'                                          00020003
         MACRO                                                          00030000
         REGISTER                                                       00040000
         LCLA  &N                                                       00050000
         SPACE                                                          00060000
*********************************************************************** 00070000
*              GENERAL REGISTER EQUATES                               * 00080000
*********************************************************************** 00090000
         SPACE                                                          00100000
&N       SETA  0                                                        00110000
.LOOP    ANOP                                                           00120000
R&N      EQU   &N                                                       00130000
         AIF   (&N EQ 15).OUT                                           00140000
&N       SETA  &N+1                                                     00150000
         AGO   .LOOP                                                    00160000
.OUT     ANOP                                                           00170000
         SPACE                                                          00180000
         MEND                                                           00190000
         MACRO                                                          00200000
&LABEL   BINCVRT &REG,&AREA,&DBLWRK                                     00210000
.*                                                                      00220000
.*  CONVERT THE CONTENTS OF &REG TO DECIMAL AND EDIT INTO &AREA.        00230000
.*  &AREA IS A FIELD OF LENGTH SIX THAT WILL CONTAIN THE INTEGER        00240000
.*  STRING WITH LEADING BLANKS SUPRESSED.  &DBLWRK IS A DOUBLE          00250000
.*  WORK SPACE.                                                         00260000
.*                                                                      00270000
&LABEL   CVD   &REG,&DBLWRK                                             00280000
         MVC   &AREA.(6),=X'402020202120'                               00290000
         ED    &AREA.(6),&DBLWRK+5                                      00300000
         MEND                                                           00310000
         MACRO                                                          00320000
****************************************************************        00330000
* üTA MAKPOKOMAHäA éúMEHEHA ðPéMEHéTEìøHO K COBETCKOMõ TSO SVS          00340000
****************************************************************        00350000
&LAB     WRTERM &MSG                                                    00360000
         LCLC   &MS                                                     00370000
         LCLA   &LN                                                     00380000
&MS      SETC  '&MSG'                                                   00390000
&LN      SETA  K'&MS                                                    00400000
&LN      SETA  &LN-2                                                    00410000
&LAB     B     IHBE&SYSNDX                                              00420000
IHBT&SYSNDX DC C&MS                                                     00430000
IHBE&SYSNDX DS   0H                                                     00440000
         TPUT  IHBT&SYSNDX,&LN                                          00450000
         MEND                                                           00460000
****************************************************************        00470000
* üTA MAKPOKOMAHäA éúMEHEHA ðPéMEHéTEìøHO K COBETCKOMõ TSO SVS          00480000
****************************************************************        00490000
         MACRO                                                          00500000
&LAB     PROMPT &MSG                                                    00510000
         LCLC   &MS                                                     00520000
         LCLA   &LN                                                     00530000
&MS      SETC  '&MSG'                                                   00540000
&LN      SETA  K'&MS                                                    00550000
&LN      SETA  &LN-2                                                    00560000
&LAB     B     IHBE&SYSNDX                                              00570000
IHBT&SYSNDX DC C&MS                                                     00580000
IHBE&SYSNDX DS   0H                                                     00590000
         TPUT  IHBT&SYSNDX,&LN,ASIS                                     00600000
         MEND                                                           00610000
         MACRO                                                          00620000
         RDTERM &BUFF                                                   00630000
         TGET &BUFF,130                                                 00640000
         MEND                                                           00650000
KERMIT   CSECT                                                          00660003
*                                                                       00670000
*         ----------------------------------------                      00680000
*                                                                       00690000
*  KERMIT/TSO   -                                                       00700003
*                                                                       00710000
*  KERMIT - KL10 ERROR-FREE RECIPROCOL MICRO INTERFACE TRANSFER         00720003
*  IBM VERSION 1.0                                                      00730000
*                                                                       00740000
*  THIS PROGRAM IS THE IBM MVS/TSO SIDE OF A FILE TRANSFER SYSTEM.      00750000
*  IT CAN BE USED TO TRANSFER FILES BETWEEN A MICRO AND A SYSTEM        00760000
*  RUNNING UNDER MVS/TSO. IT MUST BE RUN AS A COMMAND PROCESSOR.        00770000
*  SEE THE KERMIT MANUAL FOR THE COMPLETE PROGRAM SPECIFICATIONS        00780003
*  TO WHICH THIS PROGRAM AND ANY OTHER COMPONENT OF THE SYSTEM          00790000
*  MUST ADHERE.                                                         00800000
*                                                                       00810000
*  RONALD J. RUSNAK, UNIVERSITY OF CHICAGO COMPUTATION CENTER           00820000
*  BITNET ADDRESS, SYSRONR AT UCHIVM1                                   00830000
*  MAILNET ADDRESS, SYSTEMS.RON@UCHICAGO.MAILNET                        00840000
*  ARPA FORWARDING ADDRESS, SYSTEMS.RON%UCHICAGO@MIT-MULTICS.ARPA       00850000
*  MAY 1984                                                             00860000
*                                                                       00870000
*  DEVELOPED BY THE MODIFICATION OF THE IBM CMS VERSION WRITTEN BY      00880000
*  DAPHNE TZOAR, COLUMBIA UNIVERSITY CENTER FOR COMPUTING ACTIVITIES    00890000
*  MARCH 1982                                                           00900000
*                                                                       00910000
* COPYRIGHT (C) 1984 UNIVERSITY OF CHICAGO                              00920000
*                                                                       00930000
* PERMISSION IS GRANTED TO ANY INDIVIDUAL OR INSTITUTION TO COPY        00940000
* OR USE THIS PROGRAM, EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES.       00950000
*                                                                       00960000
*                                                                       00970000
*        THE FOLLOWING EXTERNAL SUBROUTINES ARE REQUIRED:               00980000
*          -DYNALC - MVS DYNAMIC ALLOCATION INTERFACE.                  00990000
*                                                                       01000000
*                                                                       01010000
*         ----------------------------------------                      01020000
*                                                                       01030000
* NOTE THAT THIS IS AN EXPERIMENTAL VERSION; ALL CHANGES SHOULD         01040000
* BE FORWARDED TO THE AUTHOR.                                           01050000
*                                                                       01060000
* ðPOçPAMMA MOäéæéãéPOBAHA ðPéMEHéTEìøHO K TSO SVS B.â.öOPHéãKéM        01070000
* çìABHùê  BùþéCìéTEìøHùê ãEHTP MðC, MOCKBA, 1986ç, OKTñâPø-HOñâPø      01080000
*                                                                       01090000
*                                                                       01100000
*  B ðPOçPAMMõ BHECEHù CìEäõàýéE OCHOBHùE éúMEHEHéñ:                    01110000
*  1. éúMEHEHù CéMBOìù HAþAìA úAçOìOBKA é KOHãA CTPOKé ðPéMEHéTEìøHO    01120000
*     K COBETCKOMõ TCAM äìñ Að/70.                                      01130000
*  2. OTKìàþEHA BOúMOöHOCTø éúMEHñTø SOH é EOL.                         01140000
*  3. BBEäEHA ðEPEäAþA æAêìOB TéðA BIN.                                 01150000
*  4. OâECðEþEHA ðPEæéKCAãéñ BOCøMOçO âéTA.                             01160000
*  5. éúMEHEHA OâPAâOTKA úAðPOCA HA âOìøûéE ðAKETù (âOìøûE 94).         01170000
*  6. OâECðEþEHA BOúMOöHOCTø úAçPõúKé ðOìøúOBATEìøCKéX TAâìéã           01180000
*     ðEPEKOäéPOBKé.                                                    01190000
*  7. OâECðEþEHA BOúMOöHOCTø COúäAHéñ KOMAHäHùX ðPOãEäõP.               01200000
*                                                                       01210000
*                                                                       01220000
         EJECT                                                          01230000
* REGISTER USAGE -                                                      01240000
* R1 -                                                                  01250000
* R2 -                                                                  01260000
* R3 -                                                                  01270000
* R4 -                                                                  01280000
* R5 -                                                                  01290000
* R6 -                                                                  01300000
* R7 -                                                                  01310000
* R8 -                                                                  01320000
* R9 -                                                                  01330000
* R10 -                                                                 01340000
* R11 - BASE REGISTER FOR GLOBAL DATA AREA                              01350000
* R12 - PROGRAM BASE                                                    01360000
* R13 - SAVE AREA                                                       01370000
* R14 - SUBROUTINE LINKAGE                                              01380000
* R15 - SUBROUTINE LINKAGE                                              01390000
*                                                                       01400000
         SPACE                                                          01410000
         REGISTER                                                       01420000
         IKJCPPL                                                        01430000
         IKJPSCB                       BCTABìEHO J                      01440000
         IKJUPT                                                         01450000
         IKJPGPB                       BCTABìEHO J                      01460000
         IKJIOPL                       BCTABìEHO J                      01470000
         SPACE                                                          01480000
AD       EQU       68                  DATA PACKET (ASCII 'D')          01490000
AN       EQU       78                  NAK                              01500000
AZ       EQU       90                  EOF PACKET                       01510000
AS       EQU       83                  INIT PACKET                      01520000
AY       EQU       89                  ACK                              01530000
AF       EQU       70                  FILE PACKET                      01540000
AB       EQU       66                  BREAK PACKET                     01550000
AE       EQU       69                  ERROR PACKET                     01560000
ERCOD    EQU       12                  MEANS EOF WITH 'FSREAD'          01570000
FLG1     EQU       X'80'               IS FILE THE FIRST OR NOT         01580000
FLG2     EQU       X'40'               OVERWRITE SENT FILENAME?         01590000
FLG3     EQU       X'20'               ONE = SENT ONLY PARTIAL RECORD   01600000
FLG4     EQU       X'10'               NAK FROM MICRO(0) OR RPACK(1)?   01610000
FLG5     EQU       X'08'               ALLOCATED MORE SPACE (DMSFREE)   01620000
BINF     EQU   X'04'                   EQU 1 - BINARY DATA     J        01630000
D8QUO    EQU   X'26'                   DEFAULT 8-BIT QUOTE  (C'&')    J 01640000
         EJECT                                                          01650000
         DCBD      DSORG=(PS)                                           01660000
         EJECT                                                          01670000
**********************************************************************  01680000
*                                                                    *  01690000
*        KERMIT-TSO PROGRAM                                          *  01700003
*                                                                    *  01710000
**********************************************************************  01720000
KERMIT   CSECT                                                          01730003
         STM       R14,R12,12(R13)                                      01740000
         BALR      R12,0                                                01750000
         USING     *,R12                                                01760000
         LA        R14,KSAVE                                            01770000
         ST        R13,4(R14)                                           01780000
         ST        R14,8(R13)                                           01790000
         LR        R13,R14                                              01800000
* USE R11 AS BASE REGISTER FOR THE SHARED DATA AREA                     01810000
         L         R11,=A(PARMS)                                        01820000
         USING     PARMS,R11                                            01830000
         TM        0(R1),X'80'     IS THIS A COMMAND PROCESSOR?         01840000
         BO        NOTCP           NO, THEN REFUSE USER                 01850000
*                                                                       01860000
* COLLECT USERS MVS-TSO PREFIX.                                         01870000
*                                                                       01880000
* üTO MECTO MOäéæéãéPOBAHO B CBñúé C   TEM, þTO B SVS HET ðPEæéKCA      01890000
* B KAþECTBE  ðPEæéKCA BùâéPAETCñ USERID                                01900000
*        L         R2,CPPLUPT-CPPL(,R1)  GET TO UPT âùìO                01910000
         L         R2,CPPLPSCB-CPPL(,R1)  GET TO PSCB  J                01920000
         XR        R3,R3                 CLEAR R3                       01930000
*        IC        R3,UPTPREFL-UPT(,R2)  GET LENGTH âùìO                01940000
         IC        R3,PSCBUSRL-PSCB(,R2)  GET LENGTH  J                 01950000
         BCTR      R3,0                                                 01960000
         ST        R3,PREFIXL  SAVE FOR LATER                           01970000
         MVC       PREFIX(*-*),PSCBUSER-PSCB(R2)  MOVE PREFIX MOä. J    01980000
         EX        R3,*-6                                               01990000
*                                      TO FILL IOPL          BEGIN J    02000000
         USING CPPL,R1                                                  02010000
         LA    14,IOPLL                IOPL ADDR.                       02020000
         USING IOPL,R14                                                 02030000
         L     R15,CPPLUPT             ADDR. OF UPT FROM CPPL           02040000
         ST    R15,IOPLUPT             TO IOPL                          02050000
         L     R15,CPPLECT             ADDR. OF ECT FROM CPPL           02060000
         ST    R15,IOPLECT             TO IOPL                          02070000
         LA    R15,ECBPTGT             ADDR. OF ECB                     02080000
         ST    R15,IOPLECB             TO IOPL                          02090000
         LA    R15,PUTGET              ADDR. OF MF=L FORM               02100000
         USING PGPB,R15                                                 02110000
         XC    PGPBIBUF(4),PGPBIBUF    FOR TEST FOR FIRST FREEMAIN J    02120000
         GTSIZE                                                         02130000
         LTR       R0,R0           IS THIS A GRAPHICS DEVICE?           02140000
 NOP 0   BNZ       BADDEV          YES, THEN REFUSE USER    BPEMEHHO    02150000
         L         R15,=A(INIT)                                         02160000
         BALR      R14,R15             CALL THE INITIALIZATION          02170000
         WRTERM    'KERMIT-TSO VERSION 3.06'                       R    02180003
         WRTERM    ' '                                                  02190000
**********************************************************************  02200000
*                                                                    *  02210000
*        MAIN COMMAND PROCESSING ROUTINE                             *  02220000
*                                                                    *  02230000
**********************************************************************  02240000
PROMPT   LA    R15,PUTGET              MF=L FORM           BEGIN   J    02250000
         L     R1,PGPBIBUF             ADDR OF INPUT BUFFER             02260000
         LTR   R1,R1                   BUFFER EXIST ?                   02270000
         BZ    IMADPROM                NO                               02280000
         LH    0,0(R1)                 GET LENGTH                       02290000
         FREEMAIN R,LV=(R0),A=(R1),SP=1 AND FREE OLD COM. BUFFER        02300000
IMADPROM DS    0H                      IMMADIATE PROMPT                 02310000
         PUTGET PARM=PUTGET,OUTPUT=(OLD,SINGLE,MODE),                  *02320000
               TERMPUT=(ASIS),MF=(E,IOPLL)                              02330000
         LA    R15,PUTGET                                               02340000
         L     R15,PGPBIBUF            ADDR OF NEW COMMAND              02350000
         LH    R1,0(R15)               LENGTH                           02360000
         BCTR  R1,0                    FOR EX COM.                      02370000
         MVI   INPUT,C' '              ZERO INPUT FIELD                 02380000
         MVC   INPUT+1(129),INPUT                                       02390000
         MVC   INPUT(0),4(R15)         MOVE COM. TO INPUT BUFFER        02400000
         EX    R1,*-6                                        END  J     02410000
*                                                                       02420000
         TR        INPUT,UPPER         UPPERCASE INPUT                  02430000
         LA        R1,INPUT            R1 GETS ADDRESS OF STRING        02440000
         L         R0,=F'130'          R0 GETS THE LENGTH               02450000
         L         R15,=A(PARSER)                                       02460000
         BALR      R14,R15             DO TOKENIZING                    02470000
*                                                                       02480000
         LM        R7,R9,PARSELST      SAVE ADDR OF TOKENIZED LIST      02490000
         L         R6,0(,R7)           GET THE PTR TO FIRST OPERAND     02500000
NOPRO    MVI       ERRNUM,X'FF'        RESET ERROR FOR THIS TIME        02510000
         CLI       0(R6),C' '          BARE CARRIAGE RETURN?            02520000
         BE        PROMPT              IGNORE IT                        02530000
         CLI       0(R6),C'E'          CHECK FOR 'EXIT' COMMAND         02540000
         BE        LEAVE                                                02550000
         CLI       0(R6),C'Q'          CHECK FOR 'QUIT' COMMAND         02560000
         BE        LEAVE                                                02570000
         CLI       0(R6),C'?'          NEED HELP ?                      02580000
         BNE       SETCHK                                               02590000
         WRTERM    'LEGAL COMMANDS ARE: '                               02600000
   WRTERM    'RECEIVE, SEND, HELP, EXIT, QUIT, SET, STATUS, SHOW .'     02610000
         B         PROMPT                                               02620000
SETCHK   CLC       =C'SET',0(R6)       IS IT THE SET COMMAND ?          02630000
         BE        STSWITCH                                             02640000
         CLC       =C'ST',0(R6)        IS IT THE STATUS COMMAND?        02650000
         BE        STATSW                                               02660000
         CLC       =C'SH',0(R6)        IS IT THE SHOW COMMAND?          02670000
         BE        SHOSW                                                02680000
         CLC       =C'HE',0(R6)        NEED HELP ?                      02690000
         BE        HELPSW                                               02700000
         OI        FLAGS,FLG1          SET FLG1 - IT'S THE FIRST FILE   02710000
         NI        FLAGS,X'FF'-FLG2    TURN OFF OVERWRITE FLAG (INIT)   02720000
         CLC       =C'RE',0(R6)                                         02730000
         BNE       SS                  MAYBE IT'S A SEND COMMAND        02740000
**********************************************************************  02750000
*        PROCESS RECEIVE COMMAND                                     *  02760000
**********************************************************************  02770000
         BXH       R7,R8,RR3           GET NEXT OPERAND                 02780000
         L         R6,0(,R7)           GET POINTER TO NEXT OPERAND      02790000
         CLI       0(R6),C'?'          NEED HELP?                       02800000
         BNE       RR2                                                  02810000
         WRTERM    'SPECIFY DSNAME TO BE CREATED FOR RECEIVE.'          02820000
         B         PROMPT                                               02830000
RR2      CLI       0(R6),C' '          MORE WORDS ?                     02840000
         BE        RR3                 NO, THEN PROMPT                  02850000
         MVC       DSNAMEX(80),=CL80' ' BLANK DSNAME                    02860000
         LA        R1,DSNAMEX          POINT TO DSNAME BUFFER           02870000
         LA        R2,44               MAX LENGTH OF DSNAME             02880000
         SR        R5,R5               ZERO THE LENGTH                  02890000
RR4      CLI       0(R6),C' '          IS THIS END OF FIELD             02900000
         BE        RR5                 YES, THEN PROCESS DSNAME         02910000
         MVC       0(1,R1),0(R6)       MOVE A CHARACTER                 02920000
         LA        R6,1(,R6)           MOVE ALONG INPUT BUFFER          02930000
         LA        R1,1(,R1)           MOVE ALONG DSNAME BUFFER         02940000
         LA        R5,1(,R5)           UP THE LENGTH COUNT              02950000
         BCT       R2,RR4              KEEP LOOKING FOR END             02960000
         WRTERM    'DSNAME TOO LONG'                                    02970000
*                                                                       02980000
*  ALLOCATE A NEW DATA SET FOR RECEIVE                                  02990000
*  DYNALOC WILL NOT PREFIX - SO WE HAVE TO DO THIS BY HAND.             03000000
*                                                                       03010000
RR3      WRTERM    'ENTER DATA SET NAME FOR RECEIVE.'                   03020000
         MVC       DSNAMEX(80),=CL80' '   BLANK FIELD                   03030000
         TGET      DSNAMEX,44           GET DSNAME                      03040000
         TR        DSNAMEX(80),UPPER    MAKE UPPER CASE DSN             03050000
         LR        R5,R1                  SAVE TGET LENGTH              03060000
RR5      LA        R6,DSNAMEX             SOURCE                        03070000
         MVC       DSNAME(44),=CL44' ' BLANK FIELD                      03080000
         LA        R2,DSNAME           PLACE TO STUFF DSNAME            03090000
         CLI       DSNAMEX,C''''       TEST IF QUOTED                   03100000
         BE        GBDSNQ1             BR IF SO                         03110000
*                                                                       03120000
*  WE'LL PREFIX THE DSNAME "BY HAND".                                   03130000
*                                                                       03140000
         L         R3,PREFIXL          ELSE GET EX LEN                  03150000
         MVC       0(*-*,R2),PREFIX    MOVE PREFIX TO BUFFER            03160000
         EX        R3,*-6              MOVE IT                          03170000
         LA        R2,1(R3,R2)         NEXT POS IN BUFFER               03180000
         MVI       0(R2),C'.'          PUT A DOT IN THERE               03190000
         LA        R2,1(,R2)           PLACE FOR REST OF DSNAME         03200000
         B         GBDSNQ2             CONTINUE                         03210000
GBDSNQ1  DS        0H                  X                                03220000
         LA        R6,1(,R6)           PAST QUOTE                       03230000
         S         R5,=F'2'            REDUCE LENGTH BY 2               03240000
*                                                                       03250000
*  BUILD THE PARM LIST TO THE MVS DYNALC ROUTINE.                       03260000
*                                                                       03270000
GBDSNQ2  DS        0H                                                   03280000
         BCTR      R5,0                DEC LEN FOR  EX                  03290000
         MVC       0(*-*,R2),0(R6)     COMPLETE DSNAME                  03300000
         EX        R5,*-6                                               03310000
         MVC       DDNAME(8),=CL8'KEROUT'                               03320000
         MVC       DISP1(4),=F'0'      A NEW DATA SET                   03330000
         MVC       DISP2(4),=F'1'      CATLG                            03340000
         MVC       INOUT(4),=F'1'      OUTPUT                           03350000
         MVC       RECFMX(4),=F'1'     FB DATA SET                      03360000
         MVC       TRACK(4),=F'5'      5 TRACK ALLOC                    03370000
*                                                                       03380000
* SELECT A MODEL DCB.  EITHER F OR V                                    03390000
*                                                                       03400000
         MVC       KEROUT(MODDCBFL),MODDCBF                             03410000
         CLI       RFM,C'F'           DOES USER WANT FB                 03420000
         BE        MAKDCB             YES                               03430000
         MVC       KEROUT(MODDCBVL),MODDCBV  USE V MODEL                03440000
MAKDCB   DS        0H                                                   03450000
*                                                                       03460000
* NOW CHECK THE LRECL AND BLKSIZE BEFORE OPEN                           03470000
*                                                                       03480000
         SR        R1,R1      CLEAR R1                                  03490000
         IC        R1,LRECL   GET LRECL                                 03500000
         SR        R2,R2               CLEAR R2                         03510000
         LH        R3,BLKSIZE GET BLKSIZE                               03520000
         CLI       RFM,C'V'            IS THIS VARIABLE                 03530000
         BE        CHKFIXD             NO, THEN CHECK AS IF FIXED       03540000
         DR        R2,R1               SEE IF BLKSIZE IS A MULTIPLE     03550000
         LTR       R2,R2                 OF THE LRECL                   03560000
         BNZ       CHKBLKER            YES, THEN SET LRECL AND BLKSIZE  03570000
         LH        R3,BLKSIZE          GET BLKSIZE                      03580000
         B         SETLB                                                03590000
CHKBLKER WRTERM    'BLKSIZE NOT MULTIPLE OF LRECL FOR RECFM=F'          03600000
         B         PROMPT                                               03610000
CHKFIXD  SH        R3,=H'4'            ADJUST BLKSIZE                   03620000
         CR        R1,R3               IS LRECL =< BLKSIZE - 4          03630000
         BNH       CHKFIXD2            YES, THEN SET LRECL AND BLKSIZE  03640000
         WRTERM    'LRECL NOT LESS THAN BLKSIZE - 4 FOR RECFM=V'        03650000
         B         PROMPT                                               03660000
CHKFIXD2 AH        R3,=H'4'            READJUST BLKSIZE                 03670000
SETLB    DS        0H                                                   03680000
         STH       R1,KEROUT+(DCBLRECL-IHADCB) STUFF IN DCB             03690000
         STH       R3,KEROUT+(DCBBLKSI-IHADCB)                          03700000
         ST        R3,BLKSIZEX             BLKSIZE                      03710000
         ST        R1,LRECLX               LRECL                        03720000
         LOCATE    DATASET                                              03730000
         LTR       R15,R15             DOES DATASET EXIST?              03740000
         BNZ       RRALOC              NO, THEN ALLOC A NEW ONE         03750000
         PROMPT    'DATASET EXISTS, REPLY "OK" TO OVERWRITE: '          03760000
         TGET      WRKBUFF,3                                            03770000
         OC        WRKBUFF(3),=CL80' '  UPPER CASE REPLY                03780000
         CLC       =C'OK',WRKBUFF                                       03790000
         BNE       PROMPT               BR, IF NOT OK                   03800000
         MVC       DISP1,=F'1'          MAKE DISP OLD                   03810000
         MVC       DISP2,=F'3'          KEEP                            03820000
RRALOC   L         R15,=V(DYNALC)      -> ENTRY POINT                   03830000
         LA        R1,DYNAPARM         PARMS FOR ALLOC                  03840000
         BALR      R14,R15             DO IT                            03850000
*                                                                       03860000
         ICM       R1,B'1111',DYNALCRC GET RETURN OCDE                  03870000
         BNZ       PROMPT              BR IF FAILURE                    03880000
*                                                                       03890000
* ... THEN WE'LL MERGE IN THESE DCB ATTRIBUTES                          03900000
*                                                                       03910000
MAKDCBX  DS        0H                                                   03920000
         OPEN      (KEROUT,(OUTPUT))                                    03930000
         TM        KEROUT+(DCBOFLGS-IHADCB),DCBOFOPN                    03940000
         BO        GBOPNA                                               03950000
         WRTERM    'OPEN FOR DATASET FAILED.'                           03960000
         B         PROMPT                                               03970000
*                                                                       03980000
*  A BREEZE...                                                          03990000
*                                                                       04000000
GBOPNA   DS        0H                                                   04010000
         WRTERM    'RECEIVE WAITING...'                                 04020000
         L         R15,=A(RECEIVE)                                      04030000
         BALR      R14,R15             CALL RECEIVE PORTION             04040000
         LTR       R5,R15              CHECK RETURN CODE                04050000
         BNZ       LNON                                                 04060000
         MVI       ERRNUM,X'FF'                                         04070000
LNON     DS        0H                                                   04080000
*                                                                       04090000
*  CLOSE ANY OPEN DATA SETS.                                            04100000
*                                                                       04110000
* ECìé æAêì  BIN, BùBOäéM ðOCìEäHéê âìOK , äOðOìHññ HõìñMé J BEGIN      04120000
         TM    FLAGS,BINF              IS FILE BIN ?                    04130000
         BZ    CLOSE                   NO = OK                          04140000
         ST    R6,SAVR6                FOR FUTURE USE                   04150000
         ST    R10,SAVR10                                               04160000
         SR    R6,R6                                                    04170000
         IC    R6,LRECL                LRECL                            04180000
         L     R10,RSAVPL              PART NOT WRITED                  04190000
         LTR   R10,R10                 HAVE SOMETHING                   04200000
         BZ    CLOSE                   NO - OK                          04210000
CRR10R6  CR    R10,R6                                                   04220000
         BNH   LA15RBU                                                  04230000
         ST    R10,RSAVPL                                               04240000
         LR    R10,R6                  LENGHTH=LRECL                    04250000
         L     R15,=A(WRITEX)                                           04260000
         BALR  R15,R15                 WRITE LAST RECORD                04270000
         L     R10,RSAVPL                                               04280000
         SR    R10,R6                                                   04290000
         BE    CLOSE                                                    04300000
         BCTR  R10,0                   FOR EX COM.                J     04310000
         LA    R15,RBUF(R6)                                       J     04320000
         MVC   RBUF(*-*),0(R15)        TO BEGIN OF BUF.           J     04330000
         EX    R10,*-6                                            J     04340000
         LA    R10,1(R10)              RETURN LEN                 J     04350000
         B     CRR10R6                 GRATER THEN LRECL ?        J     04360000
LA15RBU  LA    R15,RBUF(R6)                                             04370000
         LA    R10,RBUF(R10)                                            04380000
ZEROR    BCTR  R15,0                   FIRST SYMBOL FOR ZERO            04390000
         CR    R15,R10                                                  04400000
         BL    ZEROE                   ALL ZEROES ADDED                 04410000
         MVI   0(R15),0                                                 04420000
         B     ZEROR                                                    04430000
ZEROE    LR    R10,R6                  LENGHTH=LRECL                    04440000
         L     R15,=A(WRITEX)                                           04450000
         BALR  R15,R15                 WRITE LAST RECORD                04460000
         XC    RSAVPL(4),RSAVPL                                         04470000
         L     R6,SAVR6                                                 04480000
         L     R10,SAVR10                                  J  END       04490000
CLOSE    CLOSE     (KERIN,,KEROUT)                                      04500000
         MVC       OLDERR(1),ERRNUM    ERROR SETTING OF THIS RUN        04510000
         LTR       R5,R5               CHECK THE RETCODE                04520000
         BZ        PROMPT              ALL OKAY                         04530000
         WRTERM    'ERROR IN RECEIVING FILE. TRY AGAIN.'                04540000
         B         PROMPT              ERROR - TRY AGAIN                04550000
SS       CLC       =C'SEN',0(R6)                                        04560000
         BNE       ERR                 UNRECOGNIZED COMMAND             04570000
**********************************************************************  04580000
*        PROCESS SEND COMMAND                                        *  04590000
**********************************************************************  04600000
         BXH       R7,R8,SS3           NO MORE LEFT                     04610000
         L         R6,0(R7)            PICK UP  NEXT OPERAND            04620000
         CLI       0(R6),C'?'          NEED HELP?                       04630000
         BNE       SS2                                                  04640000
         WRTERM    'SPECIFY DATASET NAME.'                 [  ]         04650000
         B         PROMPT                                               04660000
SS2      CLI       0(R6),C' '          MORE DATA ?                      04670000
*                                                                       04680000
*  USER WANTS TO SEND A DATA SET - WELL...                              04690000
*                                                                       04700000
         BE        SS3                 NO, THEN PROMPT                  04710000
         MVC       DSNAMEX(80),=CL80' ' BLANK DSNAME                    04720000
         LA        R1,DSNAMEX          POINT TO DSNAME BUFFER           04730000
         LA        R2,44               MAX LENGTH OF DSNAME             04740000
         SR        R5,R5               CLEAR LENGTH                     04750000
SS4      CLI       0(R6),C' '          IS THIS END OF FIELD             04760000
         BE        SS5                 YES, THEN PROCESS DSNAME         04770000
         MVC       0(1,R1),0(R6)       MOVE A CHARACTER                 04780000
         LA        R6,1(,R6)           MOVE ALONG INPUT BUFFER          04790000
         LA        R1,1(,R1)           MOVE ALONG DSNAME BUFFER         04800000
         LA        R5,1(,R5)           UP THE LENGTH COUNT              04810000
         BCT       R2,SS4              KEEP LOOKING FOR END             04820000
         WRTERM    'DSNAME TOO LONG'                                    04830000
         B         PROMPT                                               04840000
SS3      WRTERM    'ENTER DATASET NAME TO SEND.'                        04850000
         MVC       DSNAMEX(80),=CL80' '   BLANK FIELD                   04860000
         TGET      DSNAMEX,44           GET DSNAME                      04870000
         TR        DSNAMEX(80),UPPER    MAKE UPPER CASE DSN             04880000
         LR        R5,R1                  SAVE TGET LENGTH              04890000
SS5      LA        R6,DSNAMEX             SOURCE                        04900000
         MVC       DSNAME(44),=CL44' ' BLANK FIELD                      04910000
         LA        R2,DSNAME           PLACE TO STUFF DSNAME            04920000
         CLI       DSNAMEX,C''''       TEST IF QUOTED                   04930000
         BE        GBDSNQ3             BR IF SO                         04940000
*                                                                       04950000
*  USER TESTS IF I KNOW HOW TO PREFIX A DSNAME.                         04960000
*                                                                       04970000
         L         R3,PREFIXL          ELSE GET EX LEN                  04980000
         MVC       0(*-*,R2),PREFIX    MOVE PREFIX TO BUFFER            04990000
         EX        R3,*-6              MOVE IT                          05000000
         LA        R2,1(R3,R2)         NEXT POS IN BUFFER               05010000
         MVI       0(R2),C'.'          PUT A DOT IN THERE               05020000
         LA        R2,1(,R2)           PLACE FOR REST OF DSNAME         05030000
         B         GBDSNQ4             CONTINUE                         05040000
GBDSNQ3  DS        0H                  X                                05050000
         LA        R6,1(,R6)           PAST QUOTE                       05060000
         S         R5,=F'2'            REDUCE LENGTH BY 2               05070000
*                                                                       05080000
*  BUILD A "CONTROL BLOCK"                                              05090000
*                                                                       05100000
GBDSNQ4  DS        0H                                                   05110000
         BCTR      R5,0                DEC LEN FOR  EX                  05120000
         MVC       0(*-*,R2),0(R6)     COMPLETE DSNAME                  05130000
         EX        R5,*-6                                               05140000
         LA        R5,DSNAME+43        POINT TO END OF DSNAME           05150000
         LA        R4,44               LENGTH OF DSNAME                 05160000
SSFINDL1 CLI       0(R5),C' '          IS IT BLANK?                     05170000
         BNE       SSFINDL2            NO, THEN FOUND END OF DSN        05180000
         BCTR      R5,0                DECREMENT PTR                    05190000
         BCT       R4,SSFINDL1         LOOP TILL FOUND                  05200000
         WRTERM    'DSNAME CANNOT BE ENTIRELY BLANK'                    05210000
         B         PROMPT                                               05220000
SSFINDL2 LR        R3,R5               REMEMBER END OF DSN              05230000
         LA        R2,2                TRY TO FIND 2 LEVELS             05240000
SSFINDL3 CLI       0(R5),C'.'          IS IT A DOT?                     05250000
         BE        SSFINDL4            YES, THEN HANDLE IT              05260000
SSFINDL5 BCTR      R5,0                DECREMENT PTR                    05270000
         BCT       R4,SSFINDL3         LOOP TILL FOUND                  05280000
         B         SSFINDE             BR IF FRONT OF DSN               05290000
SSFINDL4 BCT       R2,SSFINDL5         FIND ANOTHER LEVEL               05300000
SSFINDE  MVC       FILNAM,=CL80' '     BLANK FILNAM                     05310000
         LA        R5,1(,R5)           MOVE TO FRONT OF LEVEL           05320000
         SR        R3,R5               FIND LENGTH TO MOVE              05330000
         CH        R3,=H'17'           TRUNC IF TOO LONG                05340000
         BNH       *+8                 NOT TOO LONG                     05350000
         LA        R3,=H'17'           FORCE MAX LENGTH                 05360000
         MVC       FILNAM(*-*),0(R5)   MOVE INSTRUCTION FOR EXECUTE     05370000
         EX        R3,*-6              GO MOVE THE DATA                 05380000
         STH   R3,FILNAML          SAVE LENGTH - 1                      05390000
         MVC       DDNAME(8),=CL8'KERIN'                                05400000
         MVC       DISP1(4),=F'2'    DISP=SHR                           05410000
         MVC       DISP2(4),=F'3'    KEEP                               05420000
         MVC       INOUT(4),=F'0'  INPUT                                05430000
         LA        R1,DYNAPARM                                          05440000
         L         R15,=V(DYNALC)    GET EMTRY POINT                    05450000
         BALR      R14,R15           DO IT                              05460000
         ICM       R1,B'1111',DYNALCRC GET RETURN CODE                  05470000
         BNZ       PROMPT                                               05480000
*                                                                       05490000
*  OPEN THE USERS DATA SET                                              05500000
*                                                                       05510000
         OPEN      (KERIN,(INPUT))                                      05520000
         TM        KERIN+(DCBOFLGS-IHADCB),DCBOFOPN                     05530000
         BO        GBOPNB                                               05540000
         WRTERM    'OPEN FOR DATASET FAILED.'                           05550000
         B         PROMPT                                               05560000
GBOPNB   DS        0H                                                   05570000
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECV IS RECFM=V           05580000
         BO        SSDELAY         YES, THEN WAIT                       05590000
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECF IS RECFM=F           05600000
         BO        SSDELAY         YES, THEN WAIT                       05610000
         WRTERM    'INVALID RECFM, ONLY FIXED AND VARIABLE SUPPORTED'   05620000
         CLOSE     KERIN                                                05630000
         B         PROMPT                                               05640000
SSDELAY  DS        0H                                                   05650000
         MVC  WRKBUFF(37),=C'WAITING ..... SECONDS BEFORE SENDING.'     05660000
         L         R1,DELAY                                             05670000
         SR        R0,R0                                                05680000
         D         R0,=F'100'                                           05690000
         BINCVRT   R1,WRKBUFF+7,DBLWRK                                  05700000
         TPUT      WRKBUFF,37                                           05710000
         STIMER    WAIT,BINTVL=DELAY                                    05720000
         B         SSWITCH                                              05730000
ERR      WRTERM    'INVALID COMMAND'                                    05740000
         B         PROMPT              INVALID COMMAND - TRY AGAIN      05750000
         SPACE     3                                                    05760000
SSWITCH  EQU       *                                                    05770000
         L         R15,=A(SEND)                                         05780000
         BALR      R14,R15             CALL SEND PORTION                05790000
         LTR       R5,R15              CHECK RETURN CODE                05800000
         BNZ       LINON                                                05810000
         MVI       ERRNUM,X'FF'        WORKED OK                        05820000
LINON    DS        0H                                                   05830000
*                                                                       05840000
*  CLOSE ANY OPEN DATA SETS.                                            05850000
*                                                                       05860000
         CLOSE     (KERIN,,KEROUT)                                      05870000
         MVC       OLDERR(1),ERRNUM    ERROR SETTING OF THIS RUN        05880000
         LTR       R5,R5               CHECK THE RETCODE                05890000
         BZ        PROMPT              ALL OKAY                         05900000
         WRTERM    'ERROR IN SENDING FILE. TRY AGAIN.'                  05910000
         B         PROMPT              ERROR - TRY AGAIN                05920000
**********************************************************************  05930000
*        PROCESS SET COMMAND                                         *  05940000
**********************************************************************  05950000
STSWITCH EQU       *                                                    05960000
         L         R15,=A(SET)                                          05970000
         BALR      R14,R15             CALL "SET" SUBROUTINE            05980000
         LTR       R15,R15             CHECK RETCODE                    05990000
         BZ        PROMPT                                               06000000
         WRTERM    'ILLEGAL SET COMMAND'                                06010000
         B         PROMPT                                               06020000
**********************************************************************  06030000
*        PROCESS SHOW COMMAND                                        *  06040000
**********************************************************************  06050000
SHOSW    EQU       *                                                    06060000
         L         R15,=A(SHOW)                                         06070000
         BALR      R14,R15             CALL "SHOW" SUBROUTINE           06080000
         LTR       R15,R15             CHECK RETCODE                    06090000
         BZ        PROMPT                                               06100000
         WRTERM    'ILLEGAL SHOW COMMAND'                               06110000
         B         PROMPT                                               06120000
**********************************************************************  06130000
*        PROCESS STATUS COMMAND                                      *  06140000
**********************************************************************  06150000
STATSW   EQU       *                                                    06160000
         BXH       R7,R8,GIVSTAT       NO MORE LEFT                     06170000
         L         R6,0(R7)            PICK UP  NEXT OPERAND            06180000
         CLI       0(R6),C'?'          NEED HELP?                       06190000
         BNE       GIVSTAT                                              06200000
         WRTERM    'CONFIRM WITH A CARRIAGE RETURN'                     06210000
         B         PROMPT                                               06220000
GIVSTAT  CLI       OLDERR,X'FF'        WAS THERE AN ERROR LAST TIME?    06230000
         BNE       FAIL                                                 06240000
         WRTERM    'KERMIT COMPLETED SUCCESSFULLY'                      06250003
         B         PROMPT                                               06260000
FAIL     SR        R5,R5                                                06270000
         IC        R5,OLDERR           GET OFFSET INTO ERROR TABLE      06280000
         M         R4,=F'20'           OFFSET := ERRNUM * 20            06290000
         LA        R5,ERRTAB(R5)                                        06300000
*G       WRTERM    (R5),20             PRINT ERROR MSG ON SCREEN        06310000
         TPUT      (R5),20                                              06320000
         B         PROMPT              AND LEAVE                        06330000
**********************************************************************  06340000
*        PROCESS HELP COMMAND                                        *  06350000
**********************************************************************  06360000
HELPSW   BXH       R7,R8,GIVHLP        NO MORE LEFT                     06370000
         L         R6,0(R7)            PICK UP  NEXT OPERAND            06380000
         CLI       0(R6),C'?'          NEED HELP?                       06390000
         BNE       GIVHLP                                               06400000
         WRTERM    'CONFIRM WITH A CARRIAGE RETURN'                     06410000
         B         PROMPT                                               06420000
GIVHLP   DS        0H                                                   06430000
         WRTERM    'ENTER ? AT PROMPT TO RECEIVE LIST OF COMMANDS.'     06440000
         WRTERM  'ENTER ? AFTER A COMMAND TO RECEIVE LIST OF OPERANDS'  06450000
         B         PROMPT                                               06460000
**********************************************************************  06470000
*        PROCESS EXIT COMMAND                                        *  06480000
**********************************************************************  06490000
LEAVE    BXH       R7,R8,KRET        ANY MORE OPERANDS?                 06500000
         L         R6,0(,R7)           GET ADDRESS OF OPERAND           06510000
         CLI       0(R6),C'?'          NEED HELP?                       06520000
         BNE       KRET                NO, JUST LEAVE                   06530000
         WRTERM    'CONFIRM WITH A CARRIAGE RETURN'                     06540000
         B         PROMPT                                               06550000
BADDEV   WRTERM    'AN ASCII TERMINAL MUST BE USED.'                    06560000
         B         RET                                                  06570000
NOTCP    WRTERM    'KERMIT-TSO MUST BE RUNNING AS A COMMAND PROCESSOR'  06580003
         WRTERM    'CONTACT YOUR LOCAL SYSTEMS PROGRAMMER'              06590000
         B         RET                                                  06600000
KRET     EQU       *                                                    06610000
RET      EQU       *                                                    06620000
*                                                                       06630000
*  CLOSE ANY OPEN DATA SETS.                                            06640000
*  DYNALC HAS A FREE=CLOSE SO.....                                      06650000
*                                                                       06660000
         TM        KERIN+(DCBOFLGS-IHADCB),DCBOFOPN                     06670000
         BNO       RETGB1                                               06680000
         CLOSE     KERIN                                                06690000
RETGB1   DS        0H                                                   06700000
         TM        KEROUT+(DCBOFLGS-IHADCB),DCBOFOPN                    06710000
         BNO       RETGB2                                               06720000
         CLOSE     KEROUT                                               06730000
RETGB2   DS        0H                                                   06740000
         CLOSE     DEBUG                                                06750000
         L         R13,4(R13)                                           06760000
         L         R14,12(R13)                                          06770000
         LM        R0,R12,20(R13)                                       06780000
         BR        R14                                                  06790000
KSAVE    DS        18F                 KERMIT'S SAVE AREA               06800003
         LTORG                                                          06810000
         DROP      R11                                                  06820000
         DROP      R12                 NO LONGER NEED THEM              06830000
         EJECT                                                          06840000
**********************************************************************  06850000
*                                                                    *  06860000
*        ROUTINE TO PROCESS SET COMMAND                              *  06870000
*                                                                    *  06880000
**********************************************************************  06890000
SET      DS        0H                                                   06900000
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          06910000
         BALR      R12,0               ESTABLISH ADDRESSABILITY         06920000
         USING     *,R12                                                06930000
         LA        R14,SETSAVE         ADDRESS OF MY SAVE AREA          06940000
         ST        R13,4(R14)          SAVE CALLER'S                    06950000
         ST        R14,8(R13)                                           06960000
         LR        R13,R14                                              06970000
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 06980000
         L         R11,=A(PARMS)                                        06990000
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         07000000
         BXH       R7,R8,SETHLP                                         07010000
         L         R6,0(R7)            PICK UP NEXT OPERAND             07020000
         CLI       0(R6),C'?'          NEED HELP ?                      07030000
         BNE       NOQ                                                  07040000
SETHLP   WRTERM 'BLKSIZE, DEBUG, DELAY, TRT, LRECL, FILE'        J      07050000
         WRTERM    'QUOTE, PACKET-SIZE, RECFM, SPACE'            J      07060000
         B         SETOK                                                07070000
**********************************************************************  07080000
*                           SET RECFM                                *  07090000
**********************************************************************  07100000
NOQ      CLC       =C'RE',0(R6)                                         07110000
         BNE       NOREC                                                07120000
         BXH       R7,R8,SETNFM        MORE OPERANDS?                   07130000
         L         R6,0(R7)            PICK UP RECORD FORMAT            07140000
         CLI       0(R6),C'?'                                           07150000
         BNE       CHKFM                                                07160000
         WRTERM    'F OR V (DEFAULT OF V)'                              07170000
         B         SETOK                                                07180000
CHKFM    CLI       0(R6),C'V'          REDUNDANT                        07190000
         BE        FMSET                                                07200000
         CLI       0(R6),C'F'          FIXED FORMAT?                    07210000
         BNE       RECERR                                               07220000
FMSET    MVC       RFM(1),0(R6)        PICK UP RECFM                    07230000
         B         SETOK                                                07240000
RECERR   WRTERM    'FIXED AND VARIABLE FILES ONLY'                      07250000
         B         SETERR                                               07260000
**********************************************************************  07270000
*                         SET QUOTE                                  *  07280000
**********************************************************************  07290000
NOREC    CLC       =C'QU',0(R6)        QUOTE CHARACTER                  07300000
         BNE       NOQUO                                                07310000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                07320000
         L         R6,0(R7)            GET NEXT TOKEN                   07330000
         CLI       0(R6),C' '          VALUE NOT SUPPLIED?              07340000
         BNE       GIVQ                                                 07350000
SETNFM   WRTERM    '?NOT CONFIRMED'                                     07360000
         B         SETERR                                               07370000
GIVQ     CLC       =C'? ',0(R6)                                         07380000
         BNE       GETQUO                                               07390000
         WRTERM    'A SINGLE CHARACTER'                                 07400000
         B         SETOK                                                07410000
GETQUO   MVC       QUOCHAR(1),0(R6)    SET NEW QUOTE CHAR               07420000
         TR        QUOCHAR(1),ETOA     GET ASCII FORM                   07430000
         CLI       1(R6),C' '          IS IT ONLY ONE CHAR?             07440000
         BE        ISQOK                                                07450000
         WRTERM    'ONE CHARACTER ONLY'                                 07460000
         B         BADQUO                                               07470000
ISQOK    CLI       QUOCHAR,X'21'       CAN'T BE LESS THAN 32            07480000
         BL        BADQUO                                               07490000
         CLI       QUOCHAR,X'7E'       CAN'T BE LARGER THAN 126         07500000
         BH        BADQUO                                               07510000
         CLI       QUOCHAR,X'3E'       HAS TO BE BETWEEN 32-62          07520000
         BNH       SETOK                                                07530000
         CLI       QUOCHAR,X'60'       OR BETWEEN 96-126                07540000
         BNL       SETOK                                                07550000
BADQUO   WRTERM    'MUST FALL BETWEEN 41-76,140,OR 173-176 (OCTAL).'    07560000
         MVC       QUOCHAR(1),DQUOTE   RESET VALUE, JUST IN CASE        07570000
         B         SETERR                                               07580000
**********************************************************************  07590000
*                         SET LRECL                                  *  07600000
**********************************************************************  07610000
NOQUO    CLC       =C'LR',0(R6)        LRECL SIZE                       07620000
         BNE       SETBLK                                               07630000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                07640000
         L         R6,0(R7)            GET NEXT TOKEN                   07650000
         CLI       0(R6),C'?'          HELP ?                           07660000
         BNE       GETREC                                               07670000
         WRTERM    'LOGICAL RECORD LENGTH (DEFAULT OF 80).'             07680000
         B         SETOK                                                07690000
GETREC   CLI       0(R6),C' '          NO VALUE GIVEN                   07700000
         BNE       CALC                                                 07710000
         WRTERM    '?NOT CONFIRMED'                                     07720000
         B         SETERR                                               07730000
CALC     CLI       0(R6),X'F0'         MUST BE >= TO 0                  07740000
         BL        BADREC                                               07750000
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  07760000
         BH        BADREC                                               07770000
         XC        PKVAR,PKVAR         EMPTY IT OUT                     07780000
         SR        R4,R4               LENGTH OF NUMBER                 07790000
         CLI       1(R6),C' '          TWO DIGITS?                      07800000
         BNE       CALC2                                                07810000
         EX        R4,PCK                                               07820000
         B         TST                                                  07830000
CALC2    LA        R4,1(R4)            ADD ONE                          07840000
         CLI       2(R6),C' '          THREE DIGITS?                    07850000
         BNE       CALC3                                                07860000
         EX        R4,PCK                                               07870000
         B         TST                                                  07880000
CALC3    LA        R4,1(R4)            IS THERE AN ERROR?               07890000
         CLI       3(R6),C' '                                           07900000
         BNE       BADREC                                               07910000
         EX        R4,PCK                                               07920000
TST      CVB       R7,PKVAR                                             07930000
         C         R7,=F'255'          MAX OF 255 FOR LRECL             07940000
         BH        BADREC                                               07950000
         STC       R7,LRECL            SET THE LRECL VALUE              07960000
         B         SETOK                                                07970000
BADREC   WRTERM    'A NUMBER WITH A MAXIMUM OF 255.'                    07980000
         B         SETERR                                               07990000
**********************************************************************  08000000
*                         SET BLKSIZE                                *  08010000
**********************************************************************  08020000
SETBLK   CLC       =C'BL',0(R6)        BLOCK SIZE                       08030000
         BNE       SETSPACE                                             08040000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                08050000
         L         R6,0(R7)            GET NEXT TOKEN                   08060000
         CLI       0(R6),C'?'          HELP ?                           08070000
         BNE       GETBLK                                               08080000
         WRTERM    'BLOCKSIZE (DEFAULT OF 80).'                         08090000
         B         SETOK                                                08100000
GETBLK   CLI       0(R6),C' '          NO VALUE GIVEN                   08110000
         BNE       BLKCALC                                              08120000
         WRTERM    '?NOT CONFIRMED'                                     08130000
         B         SETERR                                               08140000
BLKCALC  XC        PKVAR,PKVAR         EMPTY IT OUT                     08150000
         SR        R4,R4               LENGTH OF NUMBER                 08160000
         LA        R7,5                MAX LENGTH OF NUMBER             08170000
         LR        R5,R6               SAVE START OF STRING             08180000
BLKCALC1 CLI       0(R6),X'F0'         MUST BE >= TO 0                  08190000
         BL        BADBLK                                               08200000
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  08210000
         BH        BADBLK                                               08220000
         CLI       1(R6),C' '          FOUND LAST DIGIT?                08230000
         BE        BLKCALC2                                             08240000
         LA        R4,1(R4)            COUNT NUMBER OF DIGITS           08250000
         LA        R6,1(R6)            POINT TO NEXT DIGIT              08260000
         BCT       R7,BLKCALC1         KEEP CHECKING                    08270000
         B         BADBLK                                               08280000
BLKCALC2 EX        R4,BLKPCK                                            08290000
         B         BLKTST                                               08300000
BLKTST   CVB       R7,PKVAR                                             08310000
         C         R7,=F'32767'        MAX OF 32767 FOR BLKSIZE         08320000
         BH        BADBLK                                               08330000
         STH       R7,BLKSIZE          SET THE BLKSIZE                  08340000
         B         SETOK                                                08350000
BADBLK   WRTERM    'A NUMBER WITH A MAXIMUM OF 32767'                   08360000
         B         SETERR                                               08370000
**********************************************************************  08380000
*                         SET TRACK ALLOCATION                       *  08390000
**********************************************************************  08400000
SETSPACE CLC       =C'SP',0(R6)        BLOCK SIZE                       08410000
         BNE       SETEOL                                               08420000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                08430000
         L         R6,0(R7)            GET NEXT TOKEN                   08440000
         CLI       0(R6),C'?'          HELP ?                           08450000
         BNE       GETSPC                                               08460000
         WRTERM    'DATASET SPACE ALLOCATION (DEFAULT OF 5 TRACKS).'    08470000
         B         SETOK                                                08480000
GETSPC   CLI       0(R6),C' '          NO VALUE GIVEN                   08490000
         BNE       SPCCALC                                              08500000
         WRTERM    '?NOT CONFIRMED'                                     08510000
         B         SETERR                                               08520000
SPCCALC  XC        PKVAR,PKVAR         EMPTY IT OUT                     08530000
         SR        R4,R4               LENGTH OF NUMBER                 08540000
         LA        R7,5                MAX LENGTH OF NUMBER             08550000
         LR        R5,R6               SAVE START OF STRING             08560000
SPCCALC1 CLI       0(R6),X'F0'         MUST BE >= TO 0                  08570000
         BL        BADSPC                                               08580000
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  08590000
         BH        BADSPC                                               08600000
         CLI       1(R6),C' '          FOUND LAST DIGIT?                08610000
         BE        SPCCALC2                                             08620000
         LA        R4,1(R4)            COUNT NUMBER OF DIGITS           08630000
         LA        R6,1(R6)            POINT TO NEXT DIGIT              08640000
         BCT       R7,SPCCALC1         KEEP CHECKING                    08650000
         B         BADSPC                                               08660000
SPCCALC2 EX        R4,SPCPCK                                            08670000
         B         SPCTST                                               08680000
SPCTST   CVB       R7,PKVAR                                             08690000
         C         R7,=F'99999'        MAX OF 99999 FOR SPACE           08700000
         BH        BADSPC                                               08710000
         ST        R7,TRACK            SET THE ALLOCATION               08720000
         B         SETOK                                                08730000
BADSPC   WRTERM    'A NUMBER WITH A MAXIMUM OF 99999'                   08740000
         B         SETERR                                               08750000
**********************************************************************  08760000
*                         SET END-OF-LINE CHARACTER                  *  08770000
**********************************************************************  08780000
SETEOL   CLC       =C'EN',0(R6)        EOL CHARACTER                    08790000
         BNE       NOEND                                                08800000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                08810000
         L         R6,0(R7)            GET NEXT TOKEN                   08820000
         CLI       0(R6),C' '          NOT DATA                         08830000
         BNE       EOLCHAR                                              08840000
         WRTERM    '?NOT CONFIRMED'                                     08850000
         B         SETERR                                               08860000
EOLCHAR  CLI       0(R6),C'?'          NEED HELP?                       08870000
         BNE       GETEOL                                               08880000
         WRTERM    'A TWO DIGIT NUMBER BETWEEN 00 AND 31 (DEC).'        08890000
         B         SETOK                                                08900000
GETEOL   CLI       0(R6),X'F0'         MUST BE >= TO 0                  08910000
         BL        BADEOL                                               08920000
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  08930000
         BH        BADEOL                                               08940000
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE             08950000
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS          08960000
         BE        BADEOL                                               08970000
         CLI       2(R6),C' '          TWO CHARS, AT MAX                08980000
         BNE       BADEOL                                               08990000
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARACTERS           09000000
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG      09010000
         C         R7,=F'31'           MAX OF 31 DECIMAL                09020000
         BH        BADEOL                                               09030000
         STC       R7,SEOL             SET SEND EOL VALUE               09040000
         B         SETOK                                                09050000
BADEOL   WRTERM    'MUST BE A TWO DIGIT VALUE LESS THAN 31 (DEC).'      09060000
         B         SETERR                                               09070000
**********************************************************************  09080000
*                         SET PACKET-SIZE                            *  09090000
**********************************************************************  09100000
NOEND    CLC       =C'PA',0(R6)        CHANGE RECEIVE PACKET SIZE       09110000
         BNE       NOPAC                                                09120000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                09130000
         L         R6,0(R7)            GET NEXT TOKEN                   09140000
         CLI       0(R6),C' '          NO DATA                          09150000
         BNE       GETPAC                                               09160000
         WRTERM    '?NOT CONFIRMED'                                     09170000
         B         SETERR                                               09180000
GETPAC   CLI       0(R6),C'?'          NEED HELP?                       09190000
         BNE       CALC4                                                09200000
         WRTERM    'RECEIVE PACKET SIZE (RANGE: 26-94 DECIMAL).'        09210000
         B         SETOK                                                09220000
CALC4    CLI       0(R6),X'F0'         MUST BE >= TO 0                  09230000
         BL        BADPAC                                               09240000
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  09250000
         BH        BADPAC                                               09260000
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE             09270000
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS          09280000
         BE        BADPAC                                               09290000
         CLI       2(R6),C' '          TWO CHARS, AT MAX                09300000
         BNE       BADPAC                                               09310000
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARS                09320000
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG      09330000
         C         R7,=F'26'           THIS IS MIN                      09340000
         BL        BADPAC                                               09350000
         C         R7,MAXPACK          THIS IS THE MAX                  09360000
         BH        BADPAC                                               09370000
         ST        R7,RPSIZ            USE THIS VALUE NOW               09380000
         B         SETOK                                                09390000
BADPAC   WRTERM    'MUST BE BETWEEN 26-94 (DECIMAL).'                   09400000
         B         SETERR                                               09410000
**********************************************************************  09420000
*                         SET DEBUG ON\OFF                           *  09430000
**********************************************************************  09440000
NOPAC    CLC       =C'DEB',0(R6)      IS THIS DEBUG?                    09450000
         BNE       SETSOH              NO, THEN SEE IF SET SOH          09460000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                09470000
         L         R6,0(R7)            GET NEXT TOKEN                   09480000
         CLI       0(R6),C' '          IS THERE AN OPERAND?             09490000
         BE        DEBERR              NO, THEN ASK FOR ONE.            09500000
         CLC       =C'ON',0(R6)        IS IT TIME TO TURN ON            09510000
         BE        DEBON               YES, OPEN FILE                   09520000
         CLC       =C'OF',0(R6)       IS IT TIME TO TURN OFF            09530000
         BE        DEBOFF              YES, CLOSE FILE                  09540000
         B         DEBERR              YES, GIVE MESSAGE                09550000
DEBERR   WRTERM    'COMMAND IS SET DEBUG ON \ OFF'                      09560000
         B         SETERR                                               09570000
DEBON    OPEN      (DEBUG,(OUTPUT))                                     09580000
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        09590000
         BO        SETOK                                                09600000
         WRTERM    'UNABLE TO OPEN DEBUG FILE, DEBUG DISABLED.'         09610000
         B         SETERR                                               09620000
DEBOFF   CLOSE     DEBUG                                                09630000
         B         SETOK                                                09640000
**********************************************************************  09650000
*                         SET START-OF-HEADER CHARACTER              *  09660000
**********************************************************************  09670000
SETSOH   B     NOSOH                  SOH CHARACTER                J    09680000
         CLC       =C'ST',0(R6)       SOH CHARACTER                     09690000
         BNE       NOSOH               NO, THEN TRY DELAY               09700000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                09710000
         L         R6,0(R7)            GET NEXT TOKEN                   09720000
         CLI       0(R6),C' '          NOT DATA                         09730000
         BNE       SOHCHAR                                              09740000
         WRTERM    '?NOT CONFIRMED'                                     09750000
         B         SETERR                                               09760000
SOHCHAR  CLI       0(R6),C'?'          NEED HELP?                       09770000
         BNE       GETSOH                                               09780000
         WRTERM    'A TWO DIGIT NUMBER BETWEEN 00 AND 31 (DEC).'        09790000
         B         SETOK                                                09800000
GETSOH   CLI       0(R6),X'F0'         MUST BE >= TO 0                  09810000
         BL        BADSOH                                               09820000
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  09830000
         BH        BADSOH                                               09840000
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE             09850000
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS          09860000
         BE        BADSOH                                               09870000
         CLI       2(R6),C' '          TWO CHARS, AT MAX                09880000
         BNE       BADSOH                                               09890000
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARACTERS           09900000
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG      09910000
         C         R7,=F'31'           MAX OF 31 DECIMAL                09920000
         BH        BADSOH              ERROR, TOO BIG                   09930000
         STC       R7,SSOH             SET SEND SOH VALUE               09940000
         STC       R7,RSOH             SET RECEIVE SOH VALUE            09950000
         B         SETOK                                                09960000
BADSOH   WRTERM    'MUST BE A TWO DIGIT VALUE LESS THAN 31 (DEC).'      09970000
         B         SETERR                                               09980000
**********************************************************************  09990000
*                      SET DELAY VALUE                               *  10000000
**********************************************************************  10010000
NOSOH    CLC       =C'DEL',0(R6)       CHANGE RECEIVE PACKET SIZE       10020000
         BNE       SETFILE             J                                10030000
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                10040000
         L         R6,0(R7)            GET NEXT TOKEN                   10050000
         CLI       0(R6),C' '          NO DATA                          10060000
         BNE       GETDELAY                                             10070000
         WRTERM    '?NOT CONFIRMED'                                     10080000
         B         SETERR                                               10090000
GETDELAY CLI       0(R6),C'?'          NEED HELP?                       10100000
         BNE       DLYCALC                                              10110000
         WRTERM    'RECEIVE PACKET SIZE (RANGE: 26-94 DECIMAL).'        10120000
         B         SETOK                                                10130000
DLYCALC  XC        PKVAR,PKVAR         EMPTY IT OUT                     10140000
         SR        R4,R4               LENGTH OF NUMBER                 10150000
         LA        R7,5                MAX LENGTH OF NUMBER             10160000
         LR        R5,R6               SAVE START OF STRING             10170000
DLYCALC1 CLI       0(R6),X'F0'         MUST BE >= TO 0                  10180000
         BL        BADDELAY                                             10190000
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  10200000
         BH        BADDELAY                                             10210000
         CLI       1(R6),C' '          FOUND LAST DIGIT?                10220000
         BE        DLYCALC2                                             10230000
         LA        R4,1(R4)            COUNT NUMBER OF DIGITS           10240000
         LA        R6,1(R6)            POINT TO NEXT DIGIT              10250000
         BCT       R7,DLYCALC1         KEEP CHECKING                    10260000
         B         BADDELAY                                             10270000
DLYCALC2 EX        R4,DLYPCK                                            10280000
         B         DLYTST                                               10290000
DLYTST   CVB       R7,PKVAR                                             10300000
         LTR       R7,R7               THIS IS MIN                      10310000
         BNP       BADDELAY                                             10320000
         C         R7,=F'99999'        THIS IS THE MAX                  10330000
         BH        BADDELAY                                             10340000
         MH        R7,=H'100'          MAKE IT 100THS OF SECONDS        10350000
         ST        R7,DELAY            USE THIS VALUE NOW               10360000
         B         SETOK                                                10370000
BADDELAY WRTERM    'MUST BE BETWEEN 1-99999 (DECIMAL).'                 10380000
         B         SETERR                                               10390000
**********************************************************************  10400000
*                      SET FILE TYPE                                 *  10410000
**********************************************************************  10420000
SETFILE  CLC   =C'FI',0(R6)                                 J (BEGIN)   10430000
         BNE   SETTRT                                                   10440000
         BXH   R7,R8,SETNFM                                             10450000
         L     R6,0(R7)                                                 10460000
         CLI   0(R6),C'?'                                               10470000
         BNE   FICONT                                                   10480000
         WRTERM 'BINARY OR TEXT (DEFAULT IS TEXT)'                      10490000
         B     SETOK                                                    10500000
FICONT   CLI   0(R6),C' '                                               10510000
         BE    FIERR                                                    10520000
         CLC   =C'BI',0(R6)                                             10530000
         BNE   FITEX                                                    10540000
         OI    FLAGS,BINF                                               10550000
         B     SETOK                                                    10560000
FITEX    NI    FLAGS,X'FF'-BINF                                         10570000
         B     SETOK                                                    10580000
FIERR    WRTERM 'COMMAND IZ SET FILE BINARY / TEXT'                     10590000
         B     SETERR                                       J (END)     10600000
**********************************************************************  10610000
*                  SET  TRT TABLE NAME                               *  10620000
**********************************************************************  10630000
SETTRT   CLC   =C'TRT',0(R6)                                J (BEGIN)   10640000
         BNE   SETERR                                                   10650000
         BXH   R7,R8,SETNFM                                             10660000
         L     R6,0(R7)                                                 10670000
         CLI   0(R6),C'?'                                               10680000
         BNE   TRTCONT                                                  10690000
        WRTERM 'ONE SYMBOL AS A LAST CHAR OF NAME CTRT? OR S FOR STANDA*10700000
               RT TABLE'                                                10710000
         B     SETOK                                                    10720000
TRTCONT  CLI   0(R6),C' '                                               10730000
         BE    SETERR                                                   10740000
         CLI   0(R6),C'S'                                               10750000
         BNE   TRTCLC                                                   10760000
TRTSST   MVC   TRTNAME,=CL8'STANDARD'                                   10770000
         LA    R15,ATOE8                                                10780000
         ST    R15,TRTADDR                                              10790000
         B     SETOK                                                    10800000
TRTCLC   CLC   TRTNAME,=CL8'STANDARD'                                   10810000
         BE    TRTMVC                                                   10820000
         DELETE EPLOC=TRTNAME                                           10830000
TRTMVC   MVC   TRTNAME,=CL8'CTRT'                                       10840000
         MVC   TRTNAME+4(1),0(R6)                                       10850000
         BLDL  0,TRTBLDL                                                10860000
         LTR   R15,R15                                                  10870000
         BZ    TRTLOAD                                                  10880000
         MVC   WRKBUFF(41),=CL41'TABLE XXXXXXXX NOT FOUND, STANDARD IS *10890000
               SET'                                                     10900000
         MVC   WRKBUFF+6(8),TRTNAME                                     10910000
         TPUT  WRKBUFF,41                                               10920000
         B     TRTSST                                                   10930000
TRTLOAD  LOAD  EPLOC=TRTNAME                                            10940000
         ST    R0,TRTADDR                                               10950000
         B     SETOK                                           END J    10960000
**********************************************************************  10970000
SETERR   LA        R15,4               SET A NON-ZERO RETCODE           10980000
         B         SETRET                                               10990000
SETOK    SR        R15,R15             RETCODE OF 0                     11000000
*                                                                       11010000
SETRET   L         R13,4(R13)                                           11020000
         L         R14,12(R13)                                          11030000
         LM        R0,R12,20(R13)                                       11040000
         BR        R14                                                  11050000
SETSAVE  DS        18F                                                  11060000
PCK      PACK      PKVAR(8),0(0,R6)                                     11070000
BLKPCK   PACK      PKVAR(8),0(0,R5)                                     11080000
SPCPCK   PACK      PKVAR(8),0(0,R5)                                     11090000
DLYPCK   PACK      PKVAR(8),0(0,R5)                                     11100000
         LTORG                                                          11110000
         DROP      R11                                                  11120000
         DROP      R12                                                  11130000
         EJECT                                                          11140000
**********************************************************************  11150000
*                                                                    *  11160000
*        ROUTINE TO PROCESS SHOW COMMAND                             *  11170000
*                                                                    *  11180000
**********************************************************************  11190000
SHOW     DS        0H                                                   11200000
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          11210000
         BALR      R12,0               ESTABLISH ADDRESSABILITY         11220000
         USING     *,R12                                                11230000
         LA        R14,SHOWSAVE        ADDRESS OF MY SAVE AREA          11240000
         ST        R13,4(R14)          SAVE CALLER'S                    11250000
         ST        R14,8(R13)                                           11260000
         LR        R13,R14                                              11270000
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 11280000
         L         R11,=A(PARMS)                                        11290000
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         11300000
         BXH       R7,R8,SHONFM        ANY MORE OPERANDS                11310000
         L         R6,0(R7)            GET NEXT TOKEN                   11320000
         CLI       0(R6),C'?'          NEED HELP ?                      11330000
         BNE       SHOREC                                               11340000
         WRTERM    'STATE'                                              11350000
         B         SHOWOK                                               11360000
SHONFM   WRTERM    '?NOT CONFIRMED'                                     11370000
         B         SHOWERR                                              11380000
SHOREC   CLI       0(R6),C'S'          IS THIS SHOW STATE               11390000
         BNE       SHOWERR                                              11400000
         TM    FLAGS,BINF                                               11410000
         BZ    TEXTF                                                    11420000
         WRTERM 'FILE IS BINARY'       J (BEGIN)                        11430000
         B     S#1                                                      11440000
TEXTF    WRTERM 'FILE IS TEXT'                                          11450000
S#1      DS    0H                      J (END)                          11460000
         MVC       WRKBUFF(18),=C'RECORD FORMAT IS .'                   11470000
         MVC       WRKBUFF+17(1),RFM                                    11480000
         TPUT      WRKBUFF,18                                           11490000
         TR        QUOCHAR(1),ATOE     GET EBCDIC VERSION               11500000
         MVC       WRKBUFF(20),=C'QUOTE CHARACTER IS .'                 11510000
         MVC       WRKBUFF+19(1),QUOCHAR                                11520000
         TPUT      WRKBUFF,20                                           11530000
         MVC   WRKBUFF(26),=C'8-BIT QUOTE CHARACTER IS X'       J       11540000
         MVC   WRKBUFF+25(1),EBQUOT                             J       11550000
         TR    WRKBUFF+25(1),ATOE      TRANSLATE TO EBCDIC      J       11560000
         TPUT  WRKBUFF,26                                       J       11570000
         TR        QUOCHAR(1),ETOA     KEEP THE ASCII FORM AROUND       11580000
         SR        R4,R4               ZERO IT OUT                      11590000
         IC        R4,LRECL                                             11600000
         MVC       WRKBUFF(8),=C'LRECL IS'                              11610000
         BINCVRT   R4,WRKBUFF+8,DBLWRK                                  11620000
         TPUT      WRKBUFF,14                                           11630000
         LH        R4,BLKSIZE                                           11640000
         MVC       WRKBUFF(10),=C'BLKSIZE IS'                           11650000
         BINCVRT   R4,WRKBUFF+10,DBLWRK                                 11660000
         TPUT      WRKBUFF,16                                           11670000
         L         R4,TRACK                                             11680000
         MVC       WRKBUFF(32),=C'SPACE ALLOCATION IS ..... TRACKS'     11690000
         BINCVRT   R4,WRKBUFF+19,DBLWRK                                 11700000
         TPUT      WRKBUFF,32                                           11710000
         SR        R4,R4               ZERO IT OUT                      11720000
         IC        R4,SSOH                                              11730000
       MVC WRKBUFF(44),=C'START-OF-HEADER CHARACTER IS ..... (DECIMAL)' 11740000
         BINCVRT   R4,WRKBUFF+28,DBLWRK                                 11750000
******   TPUT      WRKBUFF,44                                   J       11760000
         SR        R4,R4               ZERO IT OUT                      11770000
         IC        R4,SEOL                                              11780000
         MVC WRKBUFF(40),=C'END-OF-LINE CHARACTER IS ..... (DECIMAL)'   11790000
         BINCVRT   R4,WRKBUFF+24,DBLWRK                                 11800000
*****    TPUT      WRKBUFF,40                                   J       11810000
         MVC WRKBUFF(38),=C'RECEIVE PACKET SIZE IS ..... (DECIMAL)'     11820000
         L         R1,RPSIZ                                             11830000
         BINCVRT   R1,WRKBUFF+22,DBLWRK                                 11840000
         TPUT      WRKBUFF,38                                           11850000
         MVC       WRKBUFF(28),=C'DELAY VALUE IS ..... SECONDS'         11860000
         L         R1,DELAY                                             11870000
         SR        R0,R0                                                11880000
         D         R0,=F'100'                                           11890000
         BINCVRT   R1,WRKBUFF+14,DBLWRK                                 11900000
         TPUT      WRKBUFF,28                                           11910000
         MVC       WRKBUFF(9),=C'DEBUG IS '                             11920000
         MVC       WRKBUFF+9(3),=C'OFF'                                 11930000
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        11940000
         BZ        SHOWDBG                                              11950000
         MVC       WRKBUFF+9(3),=C'ON '                                 11960000
SHOWDBG  TPUT      WRKBUFF,12                                           11970000
         MVC   WRKBUFF(27),=CL27'TRANSLATE TABLE IS XXXXXXXX'           11980000
         MVC   WRKBUFF+19(8),TRTNAME                                    11990000
         TPUT  WRKBUFF,27                                               12000000
         B         SHOWOK                                               12010000
SHOWERR  LA        R15,4               SET A NON-ZERO RETCODE           12020000
         B         SHOWRET                                              12030000
SHOWOK   SR        R15,R15             ZERO RETCODE                     12040000
*                                                                       12050000
SHOWRET  L         R13,4(R13)                                           12060000
         L         R14,12(R13)                                          12070000
         LM        R0,R12,20(R13)                                       12080000
         BR        R14                                                  12090000
SHOWSAVE DS        18F                                                  12100000
         LTORG                                                          12110000
         DROP      R11                                                  12120000
         DROP      R12                                                  12130000
*                                                                       12140000
         EJECT                                                          12150000
**********************************************************************  12160000
*                                                                    *  12170000
*        ROUTINE TO INITIALIZE PARAMETER AREA                        *  12180000
*                                                                    *  12190000
**********************************************************************  12200000
INIT     DS        0H                                                   12210000
         STM       R14,R12,12(R13)                                      12220000
         BALR      R12,0                                                12230000
         USING     *,R12                                                12240000
         LA        R14,ISAVE                                            12250000
         ST        R13,4(R14)                                           12260000
         ST        R14,8(R13)                                           12270000
         LR        R13,R14                                              12280000
*                                                                       12290000
* INITIALIZE VARIABLES THAT GET CHANGED DURING EXECUTION                12300000
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA LIST                 12310000
         L         R11,=A(PARMS)                                        12320000
         USING     PARMS,R11                                            12330000
         XC        SNDPKT,SNDPKT       CLEAR OUT THESE BUFFERS          12340000
         XC        RECPKT,RECPKT                                        12350000
         XC        INPUT,INPUT                                          12360000
         LA        R0,BUF                                               12370000
         LA        R1,L'BUF            ; CLEAR OUT THE BUFFER.          12380000
         SR        R15,R15                                              12390000
         MVCL      R0,R14                                               12400000
         LA        R0,RBUF                                              12410000
         LA        R1,L'RBUF                                            12420000
         SR        R15,R15                                              12430000
         MVCL      R0,R14                                               12440000
         XC        SDAT,SDAT                                            12450000
         XC        RDAT,RDAT                                            12460000
         XC        N,N                 SET VARIABLES TO ZERO            12470000
         XC        NUM,NUM                                              12480000
         XC        LSDAT,LSDAT                                          12490000
         XC        LRDAT,LRDAT                                          12500000
         MVI       FLAGS,X'00'         CLEAR ALL FLAGS                  12510000
         XC        SAVPL,SAVPL                                          12520000
         XC        RSAVPL,RSAVPL                                        12530000
         XC        NUMTRY,NUMTRY                                        12540000
         MVC       FILNAM,=18X'20'     BLANK OUT FILNAM & NAME          12550000
         MVC       NAME,=18X'20'                                        12560000
         MVI       PREV,X'00'                                           12570000
         MVI       ERRNUM,X'FF'        SET TO NO ERROR FOR NOW          12580000
         MVI       OLDERR,X'FF'        SAME HERE                        12590000
         XC        PKVAR,PKVAR         ZERO IT OUT                      12600000
         XC        OLDTRY,OLDTRY                                        12610000
         XC        SPSIZ,SPSIZ                                          12620000
         XC        SIZE,SIZE                                            12630000
         XC        TEMP,TEMP                                            12640000
         XC        STORLOC,STORLOC                                      12650000
         MVC       DELAY,DDELAY        SET DEFAULT DELAY                12660000
         MVC       LRECL(1),DLRECL     SET DEFAULTS, JUST IN CASE       12670000
         MVC       BLKSIZE(2),DBLKSIZE SET DEFAULTS, JUST IN CASE       12680000
         MVC       TRACK,DTRACK        DEFAULT SPACE OF 5 TRACKS        12690000
         MVC       RFM(1),DRECFM                                        12700000
         MVC       QUOCHAR(1),DQUOTE                                    12710000
         MVC       RQUO(1),DQUOTE                                       12720000
         MVC       REOL(1),DEOL                                         12730000
         MVC       SEOL(1),DEOL                                         12740000
         MVC       SSOH(1),DSOH                                         12750000
         MVC       RSOH(1),DSOH                                         12760000
         MVI   EBQUOT,D8QUO            8-BIT QUOT     J                 12770000
         MVI   ORIG8Q,D8QUO            8-BIT QUOT     J                 12780000
         MVI       STATE,C' '                                           12790000
         MVI       STYPE,C' '                                           12800000
         MVI       RTYPE,C' '                                           12810000
*                                                                       12820000
INITRET  L         R13,4(R13)                                           12830000
         L         R14,12(R13)                                          12840000
         LM        R0,R12,20(R13)                                       12850000
         BR        R14                                                  12860000
ISAVE    DS        18F                                                  12870000
         LTORG                                                          12880000
         DROP      R11                                                  12890000
         DROP      R12                                                  12900000
         EJECT                                                          12910000
**********************************************************************  12920000
*                                                                    *  12930000
*        ROUTINE TO PROCESS SEND COMMAND                             *  12940000
*                                                                    *  12950000
**********************************************************************  12960000
SEND     DS        0H                                                   12970000
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          12980000
         BALR      R12,0               ESTABLISH ADDRESSABILITY         12990000
         USING     *,R12                                                13000000
         LA        R14,SENDSAVE        ADDRESS OF MY SAVE AREA          13010000
         ST        R13,4(R14)          SAVE CALLER'S                    13020000
         ST        R14,8(R13)                                           13030000
         LR        R13,R14                                              13040000
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 13050000
         L         R11,=A(PARMS)                                        13060000
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         13070000
         MVC   EBQUOT(1),ORIG8Q        IF CHANGED IN LAST X-FER     J   13080000
         MVI       STATE,C'S'                                           13090000
         SR        R3,R3                                                13100000
         ST        R3,N                                                 13110000
         ST        R3,NUMTRY                                            13120000
OKSND    TM        FLAGS,FLG1          IS THIS THE FIRST FILE?          13130000
         BNO       SLOOP                                                13140000
         NI        FLAGS,X'FF'-FLG1    TURN OFF FIRST FILE FLAG         13150000
**********************************************************************  13160000
*        MAIN SEND LOOP                                              *  13170000
**********************************************************************  13180000
SLOOP    CLI       STATE,C'D'          SEND DATA STATE                  13190000
         BE        SDATA                                                13200000
         CLI       STATE,C'F'          SEND FILE STATE                  13210000
         BE        SFILE                                                13220000
         CLI       STATE,C'S'          SEND INIT STATE                  13230000
         BE        SINIT                                                13240000
         CLI       STATE,C'Z'          END OF FILE STATE                13250000
         BE        SEOF                                                 13260000
         CLI       STATE,C'B'          SEND BREAK STATE                 13270000
         BE        SBREAK                                               13280000
         CLI       STATE,C'C'          COMPLETE STATE                   13290000
         BE        COMPLETE                                             13300000
         CLI       STATE,C'A'          ABORT STATE                      13310000
         BE        ABORT               ERROR - GO TO ABORT STATE        13320000
         MVI       ERRNUM,X'02'        UNRECOGNIZED STATE               13330000
         B         ABORT               OTHERWISE, DIE                   13340000
**********************************************************************  13350000
*        CREATE AND SEND INITIALIZATION PACKET                       *  13360000
**********************************************************************  13370000
SINIT    CLC       NUMTRY,IMXTRY       SEE IF CAN SEND                  13380000
         BL        OK1                 YES WE CAN                       13390000
         MVI       STATE,C'A'          NOPE, GO INTO ABORT STATE        13400000
         B         SLOOP                                                13410000
OK1      L         R5,SPACE            MAKE CHARACTER PRINTABLE         13420000
         A         R5,RPSIZ            ADD REC PACKET SIZE              13430000
         STC       R5,SDAT             ADD SIZE INFO TO BUFFER          13440000
         L         R5,SPACE                                             13450000
         A         R5,=F'10'           10 FOR TIMEOUT                   13460000
         STC       R5,SDAT+1                                            13470000
*        L         R5,SPACE            SEND ZERO + " " FOR NPAD       Z 13480000
         MVI       SDAT+2,X'21'        SEND ONE (!) FOR NPAD          Z 13490000
*        SR        R5,R5               PAD WITH NULLS                 Z 13500000
*        L         R3,O1H                                             Z 13510000
*        XR        R5,R3               CTL FUNCTION (XOR WITH 64)Z      13520000
         MVI       SDAT+3,X'42'        SEND CTL B FOR PADCHAR         Z 13530000
         SR        R5,R5               ZERO IT OUT FOR NEXT TWO GUYS    13540000
         IC        R5,REOL             EOL CHAR I NEED                  13550000
         A         R5,SPACE            MAKE PRINTABLE                   13560000
         STC       R5,SDAT+4                                            13570000
         IC        R5,QUOCHAR          MY QUOTE CHAR                    13580000
         STC       R5,SDAT+5                                            13590000
         IC    R5,EBQUOT               8-BIT QUOTE CHAR               J 13600000
         STC   R5,SDAT+6                                              J 13610000
         L         R3,NUMTRY                                            13620000
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          13630000
         ST        R3,NUMTRY                                            13640000
         MVI       STYPE,AS            PACKET TYPE = SEND INITIATE      13650000
         MVC       LSDAT(4),=F'7'     BUFFER SIZE FOR THIS SEND       J 13660000
         L         R4,DSSIZ            GET DEFAULT SPSIZ                13670000
         S         R4,FIVE             FOR NOW, USE DEFAULT SPSIZ....   13680000
         ST        R4,SIZE             ....TO SET VALUE OF SIZE         13690000
         L         R15,=A(SPACK)       GET ADDRESS OF ROUTINE 'SPACK'   13700000
         BALR      14,15               SAVE * AND GO TO SPACK           13710000
         CLI       STATE,C'A'                                           13720000
         BE        ABORT                                                13730000
         L         15,=A(RPACK)        GET ADDRESS OF 'RPACK'           13740000
         BALR      14,15               SAVE * AND GO TO RPACK           13750000
         CLI       RTYPE,AE            ERROR PACKET?                    13760000
         BNE       Y1                  NO, THEN MAYBE AN ACK            13770000
         MVI       ERRNUM,X'0A'        MICRO DIED                       13780000
         MVI       STATE,C'A'          AND DIE                          13790000
         B         SLOOP                                                13800000
Y1       CLI       RTYPE,AY            SEE IF GOT ACK                   13810000
         BNE       N1                  MAYBE IT'S 'N'                   13820000
         CLC       N,NUM               CHECK MESSAGE NUMBERS            13830000
         BE        AOK1                                                 13840000
         MVI       ERRNUM,X'08'        PACKET LOST                      13850000
         B         SLOOP                                                13860000
AOK1     SR        R4,R4               ZERO OUT REGISTER                13870000
         IC        R4,RDAT             USE SPSIZ THE MICRO WANTS        13880000
         S         R4,SPACE            SUBTRACT THE ' '                 13890000
         C         R4,=F'26'           BUFFER HAS TO BE >= 26           13900000
         BNL       CH1                 SO FAR, SO GOOD                  13910000
         MVI       STATE,C'A'          ABORT THEN                       13920000
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR   13930000
         B         SLOOP                                                13940000
CH1      C         R4,MAXPACK          MAX PACKET SIZE                  13950000
         BNH       CH2                 CONTINUE IF <= TO MAX            13960000
         MVI       STATE,C'A'          DIE                              13970000
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR   13980000
         B         SLOOP                                                13990000
CH2      STC       R4,SPSIZ+3          USE SPSIZ THE MICRO WANTS        14000000
         S         R4,FIVE                                              14010000
         ST        R4,SIZE             SET SIZE TO SPSIZ-5              14020000
         CLC       LRDAT(4),=F'4'      USING DEFAULTS?                  14030000
         BNH       NOCHG               YUP                              14040000
         LA        R5,RDAT             POINTER TO THE BUFFER            14050000
         SR        R7,R7                                                14060000
         IC        R7,4(R5)            SEOL MICRO WANTS                 14070000
         S         R7,SPACE            UNCHAR (IE - SUBTRACT SPACE)     14080000
         STC       R7,SEOL                                              14090000
NOCHG    MVI       STATE,C'F'          PUT INTO SEND FILE STATE         14100000
         XC        NUMTRY,NUMTRY       RESET TO ZERO                    14110000
         L         R3,N                                                 14120000
         LA        R3,1(R3)            ADD ONE                          14130000
         ST        R3,N                STORE VALUE INCREMENTED BY 1     14140000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               14150000
         B         SLOOP                                                14160000
N1       CLI       RTYPE,AN            SEE IF IT'S 'N'                  14170000
         BNE       AB1                 IF NOT, DIE                      14180000
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     14190000
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     14200000
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     14210000
         B         SLOOP                                                14220000
AB1      MVI       STATE,C'A'          ELSE, ABORT                      14230000
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         14240000
         B         SLOOP                                                14250000
**********************************************************************  14260000
*        CREATE AND SEND FILE PACKET                                 *  14270000
**********************************************************************  14280000
SFILE    CLC       NUMTRY,MAXTRY       EXCEEDED NO. OF TRIES ALLOWED?   14290000
         BL        OK2                 NOPE, STILL OK                   14300000
         MVI       STATE,C'A'          ABORT IF YES                     14310000
         B         SLOOP                                                14320000
OK2      DS        0H                                                   14330000
         TR        FILNAM,ETOA                                          14340000
         LH    R5,FILNAML          GET LENGTH OF FILENAME - 1           14350000
         MVC   SDAT(*-*),FILNAM    USE FOR EXECUTE                      14360000
         EX    R5,*-6              GO MOVE FILENAME TO BUFFER           14370000
         LA    R5,1(,R5)           UP THE FILE LENGTH TO BE EXACT       14380000
         L         R3,NUMTRY                                            14390000
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          14400000
         ST        R3,NUMTRY                                            14410000
         MVI       STYPE,AF            PACKET TYPE = FILE HEADER        14420000
         ST        R5,LSDAT            SET BUFFER SIZE                  14430000
         TR        FILNAM,ATOE                                          14440000
SNDFIL   L         R15,=A(SPACK)       GET ADDRESS OF 'SPACK'           14450000
         BALR      14,15               SAVE * AND GO TO SPACK           14460000
         CLI       STATE,C'A'                                           14470000
         BE        ABORT                                                14480000
         L         15,=A(RPACK)        GET ADDRESS OF 'RPACK'           14490000
         BALR      14,15               SAVE * AND GO TO RPACK           14500000
         CLI       RTYPE,AE            ERROR PACKET?                    14510000
         BNE       Y2                  MAYBE AN ACK                     14520000
         MVI       ERRNUM,X'0A'        MICRO DIED                       14530000
         MVI       STATE,C'A'          SO WE DO TOO                     14540000
         B         SLOOP                                                14550000
Y2       CLI       RTYPE,AY            SEE IF GOT ACK                   14560000
         BNE       N2                  MAYBE GOT AN 'N'                 14570000
         CLC       N,NUM               DO WE HAVE THE CORRECT ACK?      14580000
         BE        AOK2                                                 14590000
         MVI       ERRNUM,X'08'        MISSING A PACKET SOMEWHERE       14600000
         B         SLOOP                                                14610000
AOK2     MVI       STATE,C'D'          PREPARE FOR SEND-DATA STATE      14620000
         XC        NUMTRY,NUMTRY       RESET COUNTER                    14630000
         L         R3,N                                                 14640000
         LA        R3,1(R3)            ADD ONE                          14650000
         ST        R3,N                STORE INCREMENTED VALUE          14660000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               14670000
         L         15,=A(GTCHR)                                         14680000
         BALR      14,15               DO GET-CHAR AND COME BACK        14690000
         B         SLOOP                                                14700000
N2       CLI       RTYPE,AN                                             14710000
         BNE       AB2                 ELSE, DIE                        14720000
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     14730000
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     14740000
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     14750000
         B         SLOOP                                                14760000
AB2      MVI       STATE,C'A'          ELSE, ABORT                      14770000
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         14780000
         B         SLOOP                                                14790000
**********************************************************************  14800000
*        CREATE AND SEND DATA PACKETS                                *  14810000
**********************************************************************  14820000
SDATA    CLC       NUMTRY,MAXTRY       CAN WE DO IT?                    14830000
         BL        OK4                 YES                              14840000
         MVI       STATE,C'A'          ELSE ABORT                       14850000
         B         SLOOP                                                14860000
OK4      L         R3,NUMTRY                                            14870000
         LA        R3,1(R3)            INCREMENT COUNTER                14880000
         ST        R3,NUMTRY                                            14890000
         MVI       STYPE,AD            PACKET TYPE = DATA               14900000
         L         R15,=A(SPACK)                                        14910000
         BALR      14,15               GO TO SPACK AND RETURN           14920000
         CLI       STATE,C'A'                                           14930000
         BE        ABORT                                                14940000
         L         15,=A(RPACK)                                         14950000
         BALR      14,15               SAME FOR RPACK                   14960000
         CLI       RTYPE,AE            ERROR PACKET?                    14970000
         BNE       Y4                  MAYBE AN ACK                     14980000
         MVI       ERRNUM,X'0A'        MICRO DIED                       14990000
         MVI       STATE,C'A'          SO WE DO TOO                     15000000
         B         SLOOP                                                15010000
Y4       CLI       RTYPE,AY            SEE IF GOT 'ACK'                 15020000
         BNE       N4                  SEE IF IT'S AN 'N'               15030000
         CLC       N,NUM               DO WE HAVE THE CORRECT ACK?      15040000
         BE        AOK4                                                 15050000
         MVI       ERRNUM,X'08'        MISSING A PACKET                 15060000
         B         SLOOP                                                15070000
AOK4     XC        NUMTRY,NUMTRY       RESET COUNTER                    15080000
         L         R3,N                                                 15090000
         LA        R3,1(R3)            INCREMENT COUNTER                15100000
         ST        R3,N                                                 15110000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               15120000
         L         15,=A(GTCHR)                                         15130000
         BALR      14,15               DO GET-CHAR AND RETURN           15140000
         B         SLOOP                                                15150000
N4       CLI       RTYPE,AN                                             15160000
         BNE       AB4                                                  15170000
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     15180000
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     15190000
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     15200000
         B         SLOOP                                                15210000
AB4      MVI       STATE,C'A'                                           15220000
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              15230000
         B         SLOOP                                                15240000
**********************************************************************  15250000
*        CREATE AND SEND EOF PACKET                                  *  15260000
**********************************************************************  15270000
SEOF     CLC       NUMTRY,MAXTRY       CAN WE DO IT?                    15280000
         BL        OK5                 BRANCH IF YES                    15290000
         MVI       STATE,C'A'          ABORT IF NO                      15300000
         B         SLOOP                                                15310000
OK5      L         R3,NUMTRY                                            15320000
         LA        R3,1(R3)            ADD ONE                          15330000
         ST        R3,NUMTRY           STORE INCREMENTED COUNTER        15340000
         MVI       STYPE,AZ            PACKET TYPE = EOF                15350000
         XC        LSDAT,LSDAT         LENGTH OF ZERO                   15360000
         L         R15,=A(SPACK)                                        15370000
         BALR      14,15               SAVE * AND GO TO SPACK           15380000
         CLI       STATE,C'A'                                           15390000
         BE        ABORT                                                15400000
         L         15,=A(RPACK)                                         15410000
         BALR      14,15               SAME FOR RPACK                   15420000
         CLI       RTYPE,AE            ERROR PACKET?                    15430000
         BNE       Y5                  MAYBE AN ACK                     15440000
         MVI       ERRNUM,X'0A'        MICRO DIED                       15450000
         MVI       STATE,C'A'          SO WE DO TOO                     15460000
         B         SLOOP                                                15470000
Y5       CLI       RTYPE,AY            CHECK FOR 'ACK'                  15480000
         BNE       N5                  MAYBE WAS A 'NAK'                15490000
         CLC       N,NUM               CORRECT ACK?                     15500000
         BE        AOK5                                                 15510000
         MVI       ERRNUM,X'08'        LOST A PACKET                    15520000
         B         SLOOP                                                15530000
AOK5     L         R3,N                                                 15540000
         LA        R3,1(R3)            ADD ONE                          15550000
         ST        R3,N                STORE VALUE INCREMENTED BY 1     15560000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               15570000
         MVI       STATE,C'F'          SET TO SEND FILE FOR NOW         15580000
*                                                                       15590000
*                                                                       15600000
*  WE JUST PROCESS ONE FILE FOR NOW.                                    15610000
*                                                                       15620000
DIEOK    MVI       STATE,C'B'          BREAK CONNECTION                 15630000
         B         SLOOP                                                15640000
N5       CLI       RTYPE,AN                                             15650000
         BNE       AB5                 DIE IF NOT A NAK                 15660000
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     15670000
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     15680000
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     15690000
         B         SLOOP                                                15700000
AB5      MVI       STATE,C'A'          ELSE, ABORT                      15710000
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         15720000
         B         SLOOP                                                15730000
**********************************************************************  15740000
*        CREATE AND SEND BREAK PACKET                                *  15750000
**********************************************************************  15760000
SBREAK   CLC       NUMTRY,MAXTRY       OVER OUR LIMIT?                  15770000
         BL        OK6                 BRANCH IF NO                     15780000
         MVI       STATE,C'A'          ABORT IF YES                     15790000
         B         SLOOP                                                15800000
OK6      L         R3,NUMTRY                                            15810000
         LA        R3,1(R3)            ADD ONE                          15820000
         ST        R3,NUMTRY           INCREMEMTED TRIAL COUNTER        15830000
         MVI       STYPE,AB            PACKET TYPE = BREAK              15840000
         XC        LSDAT,LSDAT         LENGTH = ZERO                    15850000
         L         R15,=A(SPACK)                                        15860000
         BALR      14,15               SAVE * AND GO TO SPACK           15870000
         CLI       STATE,C'A'                                           15880000
         BE        ABORT                                                15890000
         L         15,=A(RPACK)                                         15900000
         BALR      14,15               SAVE * AND GO TO RPACK           15910000
         CLI       RTYPE,AE            ERROR PACKET?                    15920000
         BNE       Y6                  MAYBE AN ACK                     15930000
         MVI       ERRNUM,X'0A'        MICRO DIED                       15940000
         MVI       STATE,C'A'          THEN WE DO TOO                   15950000
         B         SLOOP                                                15960000
Y6       CLI       RTYPE,AY            CHECK FOR ACK                    15970000
         BNE       N6                  CHECK FOR 'N'                    15980000
         CLC       N,NUM               CORRECT ACK?                     15990000
         BE        AOK6                                                 16000000
         MVI       ERRNUM,X'08'        LOST A PACKET                    16010000
         B         SLOOP                                                16020000
AOK6     MVI       STATE,C'C'          COMPLETED STATE                  16030000
         B         SLOOP                                                16040000
N6       CLI       RTYPE,AN            CHECK FOR 'N'                    16050000
         BNE       AB6                 DIE IF NOT A NAK                 16060000
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     16070000
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     16080000
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     16090000
         B         SLOOP                                                16100000
AB6      MVI       STATE,C'A'          ELSE,ABORT                       16110000
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         16120000
         B         SLOOP                                                16130000
**********************************************************************  16140000
*        CREATE AND SEND ABORT PACKET                                *  16150000
**********************************************************************  16160000
ABORT    DS        0H                                                   16170000
         TM        FLAGS,FLG1          DYING ON FILE-NOT-FOUND?         16180000
         BO        NOERRP              IF SO, THEN NO ERROR PACKET      16190000
         CLI       ERRNUM,X'0A'        DID THE MICRO DIE?               16200000
         BE        NOERRP              NO ERROR PACKET IF SO            16210000
         MVI       STYPE,AE            ERROR PACKET                     16220000
         MVC       LSDAT(4),=F'20'     ALL MSGS ARE THIS LONG           16230000
         MVC       N(4),NUM            SYNCH PACKET NUMBERS             16240000
         SR        R5,R5                                                16250000
         IC        R5,ERRNUM           GET RIGHT MESSAGE NUMBER         16260000
         M         R4,=F'20'           OFFSET := ERRNUM * 20            16270000
         LA        R5,ERRTAB(R5)                                        16280000
         MVC       SDAT(20),0(R5)      SPACK NEEDS THE DATA HERE        16290000
         TR        SDAT(20),ETOA                                        16300000
         L         R15,=A(SPACK)                                        16310000
         BALR      R14,R15             SEND ERROR PACKET & DIE          16320000
NOERRP   LA        R15,4               SET NON-ZERO RETCODE             16330000
         B         SENDRET             PREPARE TO LEAVE                 16340000
**********************************************************************  16350000
*        PROCESS COMPLETE                                            *  16360000
**********************************************************************  16370000
COMPLETE SR        R15,R15             ZERO WILL BE RETCODE             16380000
SENDRET  L         R13,4(R13)                                           16390000
         L         R14,12(R13)                                          16400000
         LM        R0,R12,20(R13)                                       16410000
         BR        R14                                                  16420000
         EJECT                                                          16430000
**********************************************************************  16440000
*                                                                    *  16450000
*  ROUTINE TO GET A CHARACTER FROM INPUT BUFFER WILL READ DISK TO    *  16460000
*        FILL THE BUFFER.                                            *  16470000
*                                                                    *  16480000
**********************************************************************  16490000
GTCHR    DS        0H                                                   16500000
         TM        FLAGS,FLG3          SEE IF THERE'S STUFF IN BUF      16510000
         BO        STUFF               ONES -> STUFF'S THERE            16520000
*                                                                       16530000
*  GO TO COMMON ROUTINE TO READ SOME BYTES                              16540000
*                                                                       16550000
         LA        R15,READX                                            16560000
         BALR      R15,R15                                              16570000
*                                                                       16580000
         LTR       R4,R1               PUT RESULT OF READ IN R4         16590000
         BZ        OK8                                                  16600000
         C         R4,=A(ERCOD)        RETCODE OF 12 MEANS EOF          16610000
         BNE       ERR1                TRY IT AGAIN                     16620000
         MVI       STATE,C'Z'          MAKE TO EOF STATE                16630000
         BR        R14                                                  16640000
ERR1     MVI       STATE,C'A'          ABORT ON FILE SYSTEM ERROR       16650000
         MVI       ERRNUM,X'0C'        INVALID RECORD LENGTH            16660000
         C         R4,=F'8'            WAS OUR GUESS RIGHT?             16670000
         BER       R14                 IF YES, RETURN                   16680000
         MVI       ERRNUM,X'0D'        ELSE, GOT AN I/O ERROR           16690000
         BR        R14                                                  16700000
OK8      LR        R5,R0               GET NUMBER OF BYTES READ IN      16710000
         LR        R4,R5               SAVE ALSO IN R4                  16720000
         BCTR      R4,0                SUBTRACT 1 FOR EX COMMAND        16730000
         TM    FLAGS,BINF              IZ FLILE BINARY?        J        16740000
         BNZ   SAMETRAN                YES - NO TRANSLATE      J        16750000
         L     R15,TRTADDR             CURRENT TRT TAB ADDR    J        16760000
         EX        R4,TRANS            EBCDIC TO ASCII TRANSLATION      16770000
SAMETRAN LA        R8,BUF              GET LOCATION OF BUFFER INPUT     16780000
         LA        R9,BUF(R4)          LAST POSITION IN THAT BUFFER     16790000
         TM    FLAGS,BINF              IS FILE BINARY ?        J        16800000
         BZ    X4                      NO,CONTINUE             J        16810000
         B     ST5R                    SKEEP BLANKS ADD        J        16820000
X4       CLI       0(R9),X'20'         IS THIS A BLANK?                 16830000
         BNE       X5                  NO, FOUND LAST CHAR OF LINE      16840000
         BCTR      R9,0                                                 16850000
         CR        R9,R8                                                16860000
         BNL       X4                  FIND LAST CHAR                   16870000
         SR        R5,R5               ALL BLANKS                       16880000
         B         FOO                                                  16890000
X5       SR        R9,R8                                                16900000
         LR        R5,R9               LENGTH OF LINE                   16910000
         LA        R5,1(R5)            ADD ONE                          16920000
FOO      LA        R9,BUF(R5)          FIRST BLANK SPACE AFTER DATA     16930000
         MVC       0(1,R9),=X'0D'      ADD ASCII CR                     16940000
         LA        R9,1(R9)            INCREMENT POINTER                16950000
         MVC       0(1,R9),=X'0A'      AND ADD ASCII LF                 16960000
         LA        R5,2(R5)            TWO EXTRA BYTES OF DATA NOW      16970000
ST5R     ST        R5,RECL             LRECL + 2 (FOR CRLF)             16980000
         SR        R8,R8               ZERO OUT INDEX FOR BUF           16990000
STUFF    SR        R9,R9               SAME FOR INDEX FOR SDAT          17000000
         SR        R10,R10             CHARACTER COUNTER                17010000
         SR        R5,R5               WILL HOLD QUOCHAR                17020000
         IC        R5,QUOCHAR                                           17030000
         L         R8,SAVPL            WHERE WE LEFT OFF                17040000
         C         R8,RECL             SEE IF ARE AT LIMIT              17050000
         BNL       FULL2               LEAVE IF REACHED OR EXCEEDED     17060000
         SR        R7,R7                                                17070000
LOOP     IC        R7,BUF(R8)          PICK UP BYTE                     17080000
         CLI   EBQUOT,AN               DOING 8-BIT QUOTING ? **BEGIN J  17090000
         BE    TESTSPE                                                  17100000
         CLI   EBQUOT,AY               CAN DO IT BUT AREN'T             17110000
         BE    TESTSPE                                                  17120000
         LR    R1,R7                                                    17130000
         N     R1,=X'00000080'                                          17140000
         LTR   R1,R1                                                    17150000
         BZ    TESTSPE                                                  17160000
         N     R7,=X'0000007F'                                          17170000
         L     R4,SIZE                                                  17180000
         SR    R4,R10                                                   17190000
         C     R4,=F'3'                J                                17200000
         BL    SAMEEND                                                  17210000
         LA    R4,SDAT(R9)                                              17220000
         MVC   0(1,R4),EBQUOT                                           17230000
         LA    R9,1(R9)                                                 17240000
         LA    R10,1(R10)                                               17250000
TESTSPE  SR    R1,R1                                                    17260000
         CLI   EBQUOT,AN                                                17270000
         BE    TESTSPC                                                  17280000
         CLI   EBQUOT,AY                                                17290000
         BE    TESTSPC                                                  17300000
         IC    R1,EBQUOT                                                17310000
         CR    R7,R1                                                    17320000
         BE    SPECIAL                                                  17330000
TESTSPC  CR        R7,R5               IS IT THE QUOTE CHARACTER? ENDJ  17340000
         BE        SPECIAL                                              17350000
         C         R7,DEL              IS IT THE CHARDEL?               17360000
         BE        SPECIAL                                              17370000
         C         R7,SPACE            IS IT A CONTROL CHARACTER?       17380000
         BL        SPECIAL                                              17390000
         B         ADDIT                                                17400000
SPECIAL  L         R4,SIZE             MUNGE VALUE WHILE IN R4          17410000
         SR        R4,R10              FIND DIF BETWWEN THE TWO         17420000
         C         R4,=F'2'            SEE IF HAVE AT LEAST 2 BYTES =R= 17430000
         BNL       ROOM                YES,CAN ADD                      17440000
SAMEEND  STC       R10,LSDAT+3         SET LSDAT TO VAL OF COUNTER    J 17450000
         OI        FLAGS,FLG3          SET FLAG TO SHOW STUFF'S THERE   17460000
         ST        R8,SAVPL            SAVE PLACE IN BUF                17470000
         BR        14                  LEAVE THIS ROUTINE               17480000
ROOM     LA        R4,SDAT(R9)         WHERE IT'S GOING                 17490000
         MVC       0(1,R4),QUOCHAR     MOVE QUOTE CHAR THERE            17500000
         LA        R9,1(R9)            INCREMENT SDAT COUNTER           17510000
         LA        R10,1(R10)          INCREMENT CHARACTER COUNTER      17520000
         CR        R7,R5               DON'T ADD  O100 TO THIS          17530000
         BE        ADDIT               IT'S ALREADY PRINTABLE           17540000
         LTR       R1,R1                                        J       17550000
         BZ        AR7                                          J       17560000
         CR        R1,R7                                        J       17570000
         BE        ADDIT                                        J       17580000
AR7      A         R7,O1H              ADD  0100 TO CHAR        J       17590000
         N         R7,=X'0000007F'     GET MOD  O200                    17600000
ADDIT    STC       R7,SDAT(R9)         ADD THE CHARACTER                17610000
         LA        R9,1(R9)            INCREMENT SDAT COUNTER           17620000
         LA        R8,1(R8)            INCREMENT BUF COUNTER            17630000
         LA        R10,1(R10)          INCREMENT CHARACTER COUNTER      17640000
         C         R8,RECL             SEE IF REACHED LIMIT             17650000
         BNL       FULL2                                                17660000
         C         R9,SIZE             SEE IF REACHED LIMIT             17670000
         BNL       FULL                                                 17680000
         B         LOOP                                                 17690000
FULL     EQU       *                                                    17700000
         STC       R10,LSDAT+3         THIS ONE TOO                     17710000
         ST        R8,SAVPL            HERE TOO                         17720000
         OI        FLAGS,FLG3          TURN ON FLAG - STUFF IN BUF      17730000
         BR        14                                                   17740000
FULL2    EQU       *                                                    17750000
         STC       R10,LSDAT+3         THIS ONE TOO                     17760000
         XC        SAVPL,SAVPL         RESET THIS                       17770000
         NI        FLAGS,X'FF'-FLG3    TURN OFF LEFTOVER DATA FLAG      17780000
         BR        14                                                   17790000
SENDSAVE DS        18F                                                  17800000
TRANS    TR        BUF(0),256(R15)     EBCDIC TO ASCII TRANSLATION      17810000
PARSE    DC        32X'00'                                              17820000
         DC        X'01'               STOP ON A SPACE                  17830000
         DC        223X'00'                                             17840000
FIRST    MVC       SDAT(0),FILNAM      PICK UP THE FN                   17850000
SECOND   MVC       0(0,R7),FILNAM+8    PICK UP FT                       17860000
         LTORG                                                          17870000
         DROP      R11                                                  17880000
         DROP      R12                 DON'T NEED THEM ANYMORE          17890000
         EJECT                                                          17900000
**********************************************************************  17910000
*                                                                    *  17920000
*        ROUTINE TO PROCESS SEND PACKET REQUEST                      *  17930000
*                                                                    *  17940000
**********************************************************************  17950000
SPACK    DS        0H     CSECT                                         17960000
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          17970000
         BALR      R12,0               ESTABLISH ADDRESSABILITY         17980000
         USING     *,R12                                                17990000
         LA        R14,SPSAVE          ADDRESS OF MY SAVE AREA          18000000
         ST        R13,4(R14)          SAVE CALLER'S                    18010000
         ST        R14,8(R13)                                           18020000
         LR        R13,R14                                              18030000
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 18040000
         L         R11,=A(PARMS)                                        18050000
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         18060000
         SR        R9,R9                                                18070000
*        MVC       PHDR,SSOH           ADD SOH TO PACKET             Z  18080000
         CLC       LSDAT,SIZE          NEED DATA SIZE <= SPSIZ-5        18090000
         BNH       FINE                                                 18100000
         MVI       ERRNUM,X'00'        DATA SIZE EXCEEDS MAX LIMIT      18110000
         MVI       STATE,C'A'          ABORT ON THIS                    18120000
         B         SPRET                                                18130000
FINE     L         R4,=F'35'           USE  O43 TO OFFSET DATA          18140000
         A         R4,LSDAT            ADD IT TO LSDAT                  18150000
         STC       R4,PLEN                                              18160000
         AR        R9,R4               AND THEN ADD IT TO CHECKSUM      18170000
         CLC       N,ZERO              CHECK IF N IS VALID              18180000
         BNL       T1                  OK IF >= TO 0                    18190000
         MVI       ERRNUM,X'01'        ILLEGAL MESSAGE NUMBER           18200000
         MVI       STATE,C'A'                                           18210000
         B         SPRET                                                18220000
T1       CLC       N,O1H               SEE IF IS <= OCTAL 100           18230000
         BNH       T2                                                   18240000
         MVI       ERRNUM,X'01'        ILLEGAL MESSAGE NUMBER           18250000
         MVI       STATE,C'A'                                           18260000
         B         SPRET                                                18270000
T2       L         R4,SPACE            OFFSET THIS VALUE TOO            18280000
         A         R4,N                ADD IT TO N                      18290000
         ST        R4,TEMP                                              18300000
         MVC       PNUM(1),TEMP+3                                       18310000
         A         R9,TEMP             AND ADD TO CHECKSUM              18320000
         CLI       STYPE,X'41'         ASCII 'A'                        18330000
         BL        T3                  CAN'T BE LESS THAN THIS          18340000
         CLI       STYPE,X'5A'         ASCII 'Z'                        18350000
         BNH       T4                  CAN'T BE GREATER                 18360000
T3       MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              18370000
         MVI       STATE,C'A'          DIE ON THIS                      18380000
         B         SPRET                                                18390000
T4       MVC       PTYPE(1),STYPE      ADD MESSAGE TYPE                 18400000
         SR        R2,R2               ZERO IT OUT                      18410000
         IC        R2,STYPE                                             18420000
         AR        R9,R2               ADD TO CHECKSUM                  18430000
         L         R6,LSDAT            HOW MUCH DATA                    18440000
         LTR       R6,R6               TEST IT OUT                      18450000
         BZ        NODAT                                                18460000
         SR        R5,R5               USE TO GET DATA                  18470000
         SR        R3,R3               USE TO HOLD DATA                 18480000
DATCHK   IC        R3,SDAT(R5)         PICK UP CHAR                     18490000
         AR        R9,R3               ADD TO CHECKSUM                  18500000
         LA        R5,1(R5)            BUMP POINTER                     18510000
         BCTR      R6,0                                                 18520000
         LTR       R6,R6               MORE DATA?                       18530000
         BNZ       DATCHK                                               18540000
NODAT    L         R6,LSDAT            WILL NEED THIS LATER             18550000
         LR        R7,R6               MUNGE WHILE IN R7                18560000
         BCTR      R7,0                SUBTRACT 1 FOR EX FUNCTION       18570000
         EX        R7,MOVE             MOVE THE DATA TO SNDPKT          18580000
         ST        R9,TEMP             WE'LL NEED THIS SOON             18590000
         N         R9,=X'000000C0'     GET MOD 192                      18600000
         M         R8,ONE              CARRY OVER THE SIGN BIT          18610000
         D         R8,O1H              GET MOD 64                       18620000
         A         R9,TEMP             ADD THE TWO VALUES               18630000
         N         R9,=X'0000003F'     GET MOD 64 OF CHECKSUM           18640000
         A         R9,SPACE            ADD OFFSET                       18650000
         STC       R9,PDATA(R6)        ADD CHECKSUM AFTER DATA          18660000
         LA        R6,1(R6)            MOVE POINTER                     18670000
*        IC        R9,SEOL             ADD SEND END OF PACKET CHAR    Z 18680000
*        STC       R9,PDATA(R6)                                       Z 18690000
         LA        R6,3(R6)            VALUE OF LSDAT+3 -SOH-EOL      Z 18700000
*** ZINOVIEV  IS SHURE NEXT COMAND IS RIGHT                           J 18710000
         TR        SNDPKT(130),ATOE    SEND IN EBCDIC                   18720000
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        18730000
         BZ        SPNODEB                                              18740000
         MVC       WRKBUFF(2),=H'20'                                    18750000
         XC        WRKBUFF+2(2),WRKBUFF+2                               18760000
         MVC       WRKBUFF+4(16),=CL16'TPUT SEND PACKET'                18770000
         PUT       DEBUG,WRKBUFF                                        18780000
         LA        R1,4(,R6)           ADJUST LENGTH                    18790000
         STH       R1,WRKBUFF          SET RDW                          18800000
         EX        R6,DBGMVC1          MOVE IN DATA                     18810000
         PUT       DEBUG,WRKBUFF                                        18820000
SPNODEB  TPUT      SNDPKT,(R6),FULLSCR âùìO CONTROL J                   18830000
         LTR       R15,R15             WAS THERE ANY ERROR?             18840000
         BZ        SPRET               NO, THEN JUST RETURN             18850000
         MVI       ERRNUM,10           SET MICRO DIED                   18860000
         MVI       STATE,C'A'          ABORT ON THIS                    18870000
SPRET    L         R13,4(R13)                                           18880000
         L         R14,12(R13)                                          18890000
         LM        R0,R12,20(R13)                                       18900000
         BR        14                                                   18910000
SPSAVE   DS        18F                                                  18920000
MOVE     MVC       PDATA(0),SDAT                                        18930000
DBGMVC1  MVC       WRKBUFF+4(*-*),SNDPKT                                18940000
         LTORG                                                          18950000
         DROP      R11                                                  18960000
         DROP      R12                 DON'T NEED THEM ANYMORE          18970000
         EJECT                                                          18980000
**********************************************************************  18990000
*                                                                    *  19000000
*        ROUTINE TO PROCESS RECEIVE PACKET REQUEST                   *  19010000
*                                                                    *  19020000
**********************************************************************  19030000
RPACK    DS        0H                                                   19040000
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          19050000
         BALR      R12,0               ESTABLISH ADDRESSABILITY         19060000
         USING     *,R12                                                19070000
         LA        R14,RPSAVE          ADDRESS OF MY SAVE AREA          19080000
         ST        R13,4(R14)          SAVE CALLER'S                    19090000
         ST        R14,8(R13)                                           19100000
         LR        R13,R14                                              19110000
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 19120000
         L         R11,=A(PARMS)                                        19130000
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         19140000
         TGET      RECPKT,130,ASIS                                      19150000
         LTR       R15,R15             WAS THERE AN ERROR?              19160000
         BZ        RPTSTDB             NO, THEN TEST FOR DEBUG          19170000
         MVI       RTYPE,AE            SET AN ERROR                     19180000
         B         RPRET                                                19190000
RPTSTDB  TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        19200000
         BZ        RDNODEB                                              19210000
         LA        R8,4(,R1)       SAVE LENGTH                          19220000
         MVC       WRKBUFF(2),=H'19'                                    19230000
         XC        WRKBUFF+2(2),WRKBUFF+2                               19240000
         MVC       WRKBUFF+4(15),=CL15'TGET REC PACKET'                 19250000
         PUT       DEBUG,WRKBUFF                                        19260000
         STH       R8,WRKBUFF          SET RDW                          19270000
         EX        R8,DBGMVC2          MOVE IN DATA                     19280000
         PUT       DEBUG,WRKBUFF                                        19290000
*** ZINOVIEV  IS SHURE NEXT COMAND IS RIGHT                           J 19300000
RDNODEB  TR        RECPKT(130),ETOA                                     19310000
         NI        FLAGS,X'FF'-FLG4    ASSUME MICRO'LL NAK-NOT RPACK    19320000
         SR        R8,R8               INDEX REG FOR RECPKT             19330000
         SR        R5,R5               CHECKSUM REGISTER                19340000
TRY      LA        R7,RECPKT(R8)       ADDRESS OF CHARACTER             19350000
*        CLC       RSOH,0(R7)          IS IT START OF HEADER        Z   19360000
         SR        R9,R9               ZERO OUT INDEX REG FOR RDAT  Z   19370000
         B         READIS              GOTO CONTINUE                 Z  19380000
*        BE        READIN              YES; SO FAR, SO GOOD          Z  19390000
         LA        R8,1(R8)            TRY NEXT CHARACTER               19400000
         C         R8,=F'130'          SEE IF EXCEED BUFFER             19410000
         BL        TRY                                                  19420000
         MVI       ERRNUM,X'03'        NO "SOH" ERROR                   19430000
         B         BADP                                                 19440000
READIN   SR        R9,R9               ZERO OUT INDEX REG FOR RDAT      19450000
         LA        R8,1(R8)            INCREMENT COUNTER                19460000
         LA        R7,RECPKT(R8)       PICK UP LOC OF CHAR COUNT        19470000
         CLC       RSOH,0(R7)          IS IT START OF HEADER?           19480000
         BE        READIN              START OVER                       19490000
READIS   CLC       0(1,R7),DQUOTE      COUNT+' '+3 AND  D35          Z  19500000
         BNL       CONT                CONTINUE IF >=                   19510000
         MVI       ERRNUM,X'04'        BAD LENGTH ATTRIBUTE             19520000
         B         BADP                                                 19530000
CONT     IC        R5,0(R7)            START CHECKSUM                   19540000
         LR        R7,R5               MUNGE IN R7 TO GET LRDAT         19550000
         S         R7,=F'35'           LENGTH OF DATA                   19560000
         STC       R7,LRDAT+3                                           19570000
         LA        R8,1(R8)            INCREMENT                        19580000
         SR        R7,R7               ZERO IT OUT                      19590000
         IC        R7,RECPKT(R8)       PICK UP PACKET NUMBER            19600000
         CLM       R7,B'0001',RSOH     IS IT START OF HEADER            19610000
         BE        READIN                                               19620000
         AR        R5,R7               ADD TO CHECKSUM                  19630000
         S         R7,SPACE            SUBTRACT THE ' '                 19640000
         STC       R7,NUM+3            NUM := RECEIVED PACKET NO.       19650000
         LA        R8,1(R8)            INCREMENT COUNTER                19660000
         IC        R7,RECPKT(R8)       PICK UP MESSAGE TYPE             19670000
         CLM       R7,B'0001',RSOH     IS IT START OF HEADER?           19680000
         BE        READIN                                               19690000
         AR        R5,R7               ADD TO CHECKSUM                  19700000
         STC       R7,RTYPE            PUT INTO RTYPE                   19710000
         LA        R8,1(R8)            GO TO NEXT BYTE                  19720000
         L         R4,LRDAT            COUNTER TO GET ALL DATA          19730000
LUP      C         R4,ZERO             SEE IF PICKED UP ALL DATA        19740000
         BE        FIN                                                  19750000
         XC        TEMP,TEMP           ZERO IT OUT                      19760000
         LA        R7,RECPKT(R8)       NEXT LOCATION IN BUFFER          19770000
         MVC       TEMP+3(1),0(R7)     PICK UP NEXT BYTE                19780000
         CLC       RSOH,TEMP+3         IS IT START OF HEADER            19790000
         BE        READIN                                               19800000
         LA        R7,RDAT(R9)         WHERE THE DATA'S GOING           19810000
         MVC       0(1,R7),TEMP+3      AND MOVE IT                      19820000
         A         R5,TEMP             ADD TO CHECKSUM                  19830000
         LA        R8,1(R8)            ADD ONE                          19840000
         LA        R9,1(R9)            ADD ONE                          19850000
         BCTR      R4,0                DECREMENT COUNTER                19860000
         B         LUP                                                  19870000
FIN      SR        R7,R7               ZERO OUT REGISTER                19880000
         IC        R7,RECPKT(R8)       GET CHECKSUM                     19890000
         CLM       R7,B'0001',RSOH     IS IT START OF HEADER            19900000
         BE        READIN                                               19910000
         ST        R5,TEMP             WE'LL NEED THIS SOON             19920000
         N         R5,=X'000000C0'     GET MOD 192                      19930000
         M         R4,ONE              CARRY OVER THE SIGN BIT          19940000
         D         R4,O1H              GET MOD 64                       19950000
         A         R5,TEMP             ADD THE TWO VALUES               19960000
         N         R5,=X'0000003F'     GET MOD 64                       19970000
         A         R5,SPACE            ADD OFFSET                       19980000
         CR        R5,R7               COMPUTED VS RECEIVED CHECKSUM    19990000
         BE        RPRET                                                20000000
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN                     20010000
         BZ        NODEBG2                                              20020000
         MVC       WRKBUFF(2),=H'18'                                    20030000
         XC        WRKBUFF+2(2),WRKBUFF+2                               20040000
         MVC       WRKBUFF+4(14),=CL14'CHECKSUM ERROR'                  20050000
         PUT       DEBUG,WRKBUFF                                        20060000
NODEBG2  MVI       ERRNUM,X'05'        BAD CHECKSUM ERROR               20070000
BADP     MVI       RTYPE,AN            RETURN A NAK                     20080000
         OI        FLAGS,FLG4          RPACK NAK'ED THE PACKET          20090000
RPRET    L         R13,4(R13)                                           20100000
         L         R14,12(R13)                                          20110000
         LM        R0,R12,20(R13)                                       20120000
         BR        14                                                   20130000
DBGMVC2  MVC       WRKBUFF+4(*-*),RECPKT                                20140000
RPSAVE   DS        18F                                                  20150000
         LTORG                                                          20160000
         DROP      R11                                                  20170000
         DROP      R12                 DON'T NEED THEM ANYMORE          20180000
         EJECT                                                          20190000
**********************************************************************  20200000
*                                                                    *  20210000
*  DISK FILE READ ROUTE WITH DEBUGGING CODE                          *  20220000
*                                                                    *  20230000
**********************************************************************  20240000
READX    DS        0H                                                   20250000
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         20260000
         STM       R12,R15,READSAVE                                     20270000
         BALR      R12,0                                                20280000
         USING     *,R12                                                20290000
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECV  VARIABLE?           20300000
         BO        RDVAR                                                20310000
         GET       KERIN,BUF                                            20320000
         B         RDTSTDB                                              20330000
RDVAR    GET       KERIN,BUF-4                                          20340000
RDTSTDB  TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        20350000
         BZ        RDNODBG                                              20360000
         MVC       WRKBUFF(2),=H'12'                                    20370000
         XC        WRKBUFF+2(2),WRKBUFF+2                               20380000
         MVC       WRKBUFF+4(8),=CL8'QSAM GET'                          20390000
         PUT       DEBUG,WRKBUFF                                        20400000
         LH        R1,KERIN+(DCBLRECL-IHADCB)                           20410000
         STH       R1,WRKBUFF                                           20420000
         EX        R1,DBGMVC3                                           20430000
         PUT       DEBUG,WRKBUFF                                        20440000
RDNODBG  XR        R1,R1               SET RETURN CODE                  20450000
         LH        R0,KERIN+(DCBLRECL-IHADCB)  GET RECORD LENGTH        20460000
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECV  VARIABLE?           20470000
         BZ        *+12                NO, THEN SKIP                    20480000
         LH        R0,BUF-4            GET LENGTH FROM RDW              20490000
         SH        R0,=H'4'            REMOVE RDW LENGTH                20500000
         LM        R12,R15,READSAVE                                     20510000
         BR        R15                                                  20520000
DBGMVC3  MVC       WRKBUFF+4(*-*),KERIN                                 20530000
*                                                                       20540000
INEOF    DS        0H                                                   20550000
         LA        R1,12                                                20560000
         XR        R0,R0                                                20570000
         LM        R12,R15,READSAVE                                     20580000
         BR        R15                                                  20590000
         LTORG                                                          20600000
         DROP      R11                                                  20610000
         DROP      R12                                                  20620000
         EJECT                                                          20630000
**********************************************************************  20640000
*                                                                    *  20650000
*        ROUTINE TO PROCESS RECEIVE COMMAND                          *  20660000
*                                                                    *  20670000
**********************************************************************  20680000
RECEIVE  DS        0H                                                   20690000
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          20700000
         BALR      R12,0               ESTABLISH ADDRESSABILITY         20710000
         USING     *,R12                                                20720000
         LA        R14,RECSAVE         ADDRESS OF MY SAVE AREA          20730000
         ST        R13,4(R14)          SAVE CALLER'S                    20740000
         ST        R14,8(R13)                                           20750000
         LR        R13,R14                                              20760000
* USE R11 AS BASE REGISTER FOR THE GLOBAL DATA AREA, 'PARMS'            20770000
         L         R11,=A(PARMS)                                        20780000
         USING     PARMS,R11                                            20790000
         MVC   EBQUOT(1),ORIG8Q                                       J 20800000
         SR        R6,R6               GET ZERO                         20810000
         ST        R6,NUMTRY           ZERO THIS OUT                    20820000
         ST        R6,N                HERE TOO                         20830000
         MVI       STATE,C'R'          SET TO RECEIVE STATE             20840000
**********************************************************************  20850000
*        MAIN RECEIVE PROCESSING LOOP                                *  20860000
**********************************************************************  20870000
RLOOP    CLI       STATE,C'D'          RECEIVE DATA STATE               20880000
         BE        RDATA                                                20890000
         CLI       STATE,C'F'          RECEIVE FILE STATE               20900000
         BE        RFILE                                                20910000
         CLI       STATE,C'R'          RECEIVE INIT STATE               20920000
         BE        RINIT                                                20930000
         CLI       STATE,C'C'          COMPLETE STATE                   20940000
         BE        RCOMP                                                20950000
         CLI       STATE,C'A'          ABORT STATE                      20960000
         BE        RABORT                                               20970000
         MVI       ERRNUM,X'02'        UNRECOGNIZED STATE               20980000
         B         RABORT              ELSE, DIE                        20990000
**********************************************************************  21000000
*        PROCESS INITIALIZATION PACKET                               *  21010000
**********************************************************************  21020000
RINIT    CLC       NUMTRY,IMXTRY       SEE IF CAN RECEIVE               21030000
         BL        ROK1                YES, WE CAN                      21040000
         MVI       STATE,C'A'          NOPE, GO INTO ABORT STATE        21050000
         B         RLOOP                                                21060000
ROK1     L         R3,NUMTRY                                            21070000
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          21080000
         ST        R3,NUMTRY                                            21090000
         L         R4,DSSIZ            DEFAULT SEND PACKET SIZE         21100000
         S         R4,FIVE             USE DEFAULT TO SET "SIZE"        21110000
         ST        R4,SIZE             IN CASE WE DIE BEFORE IT'S SET   21120000
         L         R15,=A(RPACK)       GET INIT INFORMATION             21130000
         BALR      R14,R15                                              21140000
         CLI       RTYPE,AE            ERROR PACKET?                    21150000
         BNE       RY1                 ALL OK                           21160000
         MVI       ERRNUM,X'0A'        MICRO DIED                       21170000
         MVI       STATE,C'A'          SO WE DO TOO                     21180000
         B         RLOOP                                                21190000
RY1      CLI       RTYPE,AS            IS IT A SEND-INIT PACKET         21200000
         BNE       RN1                 MAYBE IT GOT CLOBBERED           21210000
         SR        R4,R4               ZERO OUT REGISTER                21220000
         IC        R4,RDAT             GET FIRST CHARACTER              21230000
         S         R4,SPACE            SUBTRACT THE ' '                 21240000
         C         R4,=F'26'           MIN SPACK SIZE                   21250000
         BNL       RCH1                SO FAR, SO GOOD                  21260000
         L     R4,=F'80'               ELSE, USE DEFAULT          J     21270000
         B         RCH2                                           J     21280000
RCH1     C         R4,MAXPACK          MAX PACKET SIZE                  21290000
         BNH       RCH2                                                 21300000
         MVI       STATE,C'A'          ABORT IF SIZE IS ILLEGAL         21310000
         MVI       ERRNUM,X'00'        BAD SEND DATA LENGTH             21320000
         B         RLOOP                                                21330000
RCH2     STC       R4,SPSIZ+3          USE THE VALUE AS SEND SIZE       21340000
         S         R4,FIVE                                              21350000
         ST        R4,SIZE             SET IT TO SPSIZ-5                21360000
         CLC       LRDAT(4),=F'4'      USING ALL DEFAULTS ?             21370000
         BNH       NOCH                YUP                              21380000
         LA        R5,RDAT             POINT TO THE BUFFER              21390000
         SR        R7,R7                                                21400000
         IC        R7,4(R5)            SEOL THE MICRO WANTS             21410000
         S         R7,SPACE            UNCHAR (SUBTRACT ' ')            21420000
         STC       R7,SEOL                                              21430000
         CLC       LRDAT(4),FIVE       ANY MORE DATA?                   21440000
         BNH       NOCH                JUST USE DEFAULTS                21450000
         MVC       RQUO(1),5(R5)       SET NEW QUOCHAR VALUE            21460000
NOCH     CLC   LRDAT(4),=F'6'                               J (BEGIN)   21470000
         BL    NOCH                                                     21480000
         L     R15,=A(DOQUO)                                            21490000
         BALR  R14,R15                 SET 8-BIT QUOTE CHAR  J (END)    21500000
         MVC       N(4),NUM            SYNCH PACKET NUMBERS             21510000
         MVI       STYPE,AY            SET MESSAGE TYPE TO ACK          21520000
         MVC       LSDAT(4),=F'7'     SET LENGTH OF DATA SENDING      J 21530000
         L         R5,SPACE            MAKE CHARACTER PRINTABLE         21540000
         A         R5,RPSIZ            ADD REC PACKET SIZE              21550000
         STC       R5,SDAT             ADD SIZE INFO TO BUFFER          21560000
         L         R5,SPACE                                             21570000
         A         R5,=F'10'            10  FOR TIMEOUT                 21580000
         STC       R5,SDAT+1                                            21590000
*        L         R5,SPACE            SEND ZERO + " " FOR NPAD         21600000
         MVI       SDAT+2,X'21'        SEND ONE (!) FOR NPAD         Z  21610000
*        SR        R5,R5               PAD WITH NULLS                Z  21620000
*        L         R3,O1H                                            Z  21630000
*        XR        R5,R3               CTL FUNCTION (XOR WITH 64)    Z  21640000
         MVI       SDAT+3,X'42'        SEND CTL B FOR PADCHAR        Z  21650000
         SR        R5,R5               ZERO IT OUT FOR NEXT TWO GUYS    21660000
         IC        R5,REOL             EOL CHAR I NEED                  21670000
         A         R5,SPACE            MAKE PRINTABLE                   21680000
         STC       R5,SDAT+4                                            21690000
         IC        R5,QUOCHAR          MY QUOTE CHAR                    21700000
         STC       R5,SDAT+5                                            21710000
         IC    R5,EBQUOT               8-BIT QUOTE CHAR               J 21720000
         STC   R5,SDAT+6               TO PACKET                      J 21730000
         L         R15,=A(SPACK)       ADDRESS OF SPACK                 21740000
         BALR      R14,R15             SAVE * AND GO TO SPACK           21750000
         CLI       STATE,C'A'                                           21760000
         BE        RABORT                                               21770000
         MVI       STATE,C'F'          SET TO RECEIVE FILE STATE        21780000
         MVC       OLDTRY(4),NUMTRY    SAVE TRIAL COUNTER               21790000
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            21800000
         L         R3,N                                                 21810000
         LA        R3,1(R3)            ADD ONE                          21820000
         ST        R3,N                STORE VALUE INCREMENTED BY 1     21830000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               21840000
         B         RLOOP                                                21850000
RN1      CLI       RTYPE,AN            MAYBE IT'S A NAK                 21860000
         BNE       RSELSE                                               21870000
         MVI       STYPE,AN            SEND A NAK PACKET                21880000
         XC        LSDAT,LSDAT         NO DATA                          21890000
         L         R15,=A(SPACK)                                        21900000
         BALR      R14,R15                                              21910000
         B         RLOOP                                                21920000
RSELSE   MVI       STATE,C'A'          ELSE,ABORT                       21930000
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              21940000
         B         RLOOP                                                21950000
**********************************************************************  21960000
*        PROCESS FILE PACKET                                         *  21970000
**********************************************************************  21980000
RFILE    CLC       NUMTRY,MAXTRY       EXCEEDED NO. OF TRIALS ALLOWED   21990000
         BL        ROK2                NOPE, STILL OK                   22000000
         MVI       STATE,C'A'          ABORT IF YES                     22010000
         B         RLOOP                                                22020000
ROK2     L         R3,NUMTRY                                            22030000
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          22040000
         ST        R3,NUMTRY                                            22050000
         L         R15,=A(RPACK)       GET ADDRESS OF RPACK             22060000
         BALR      R14,R15             GO THERE AND RETURN WHEN DONE    22070000
         CLI       RTYPE,AE            ERROR PACKET?                    22080000
         BNE       RY2                 MAYBE AN ACK                     22090000
         MVI       ERRNUM,X'0A'        MICRO DIED                       22100000
         MVI       STATE,C'A'          SO WE DO TOO                     22110000
         B         RLOOP                                                22120000
RY2      CLI       RTYPE,AS            STILL IN INIT STATE?             22130000
         BNE       RNZ                 TRY FOR AN EOF                   22140000
         CLC       OLDTRY,MAXTRY       CAN WE TRY AGAIN?                22150000
         BL        ROLD                                                 22160000
         MVI       STATE,C'A'          ELSE, ABORT                      22170000
         B         RLOOP                                                22180000
ROLD     L         R3,OLDTRY                                            22190000
         LA        R3,1(R3)            INCREMENT COUNTER                22200000
         ST        R3,OLDTRY                                            22210000
         L         R3,N                GET PACKET NUMBER SENT           22220000
         BCTR      R3,0                SUBTRACT ONE FROM IT             22230000
         C         R3,NUM              NUM MUST EQUAL N-1               22240000
         BE        RNUM                                                 22250000
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          22260000
         B         RNAK                SEND A NAK                       22270000
RNUM     MVI       STYPE,AY            ACK PACKET                       22280000
         ST        R3,N                MAKE SEND SEQ NO. = N-1          22290000
         MVC       LSDAT(4),=F'6'     SET DATA LENGTH VARIABLE          22300000
         L         R15,=A(SPACK)                                        22310000
         BALR      R14,R15             GO TO SPACK AND RETURN           22320000
         CLI       STATE,C'A'                                           22330000
         BE        RABORT                                               22340000
         L         R4,N                                                 22350000
         LA        R4,1(R4)            ADD ONE                          22360000
         ST        R4,N                RESTORE N TO PROPER VALUE        22370000
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            22380000
         B         RLOOP                                                22390000
RNZ      CLI       RTYPE,AZ                                             22400000
         BNE       RNF                 MAYBE IT'S AN 'F'                22410000
         CLC       OLDTRY,MAXTRY       CAN WE TRY AGAIN?                22420000
         BL        ROLD2                                                22430000
         MVI       STATE,C'A'          ELSE,ABORT                       22440000
         B         RLOOP                                                22450000
ROLD2    L         R3,OLDTRY                                            22460000
         LA        R3,1(R3)            INCREMENT COUNTER                22470000
         ST        R3,OLDTRY                                            22480000
         L         R3,N                GET PACKET NUMBER SENT           22490000
         BCTR      R3,0                SUBTRACT ONE FROM IT             22500000
         C         R3,NUM              NUM MUST EQUAL N-1               22510000
         BE        RNUM2                                                22520000
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          22530000
         B         RNAK                SEND A NAK                       22540000
RNUM2    MVI       STYPE,AY            ACK PACKET                       22550000
         ST        R3,N                SEND SEQ := N-1                  22560000
         XC        LSDAT,LSDAT         NO DATA                          22570000
         L         R15,=A(SPACK)                                        22580000
         BALR      R14,R15                                              22590000
         CLI       STATE,C'A'                                           22600000
         BE        RABORT                                               22610000
         L         R4,N                                                 22620000
         LA        R4,1(R4)            ADD ONE                          22630000
         ST        R4,N                RESTORE N TO PROPER VALUE        22640000
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            22650000
         B         RLOOP                                                22660000
RNF      CLI       RTYPE,AF                                             22670000
         BNE       RNB                 WELL, IT'S NOT A FNAME           22680000
         CLC       NUM,N               THEY HAVE TO BE EQUAL            22690000
         BE        RNUM3                                                22700000
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          22710000
         B         RNAK                SEND A NAK                       22720000
RNUM3    MVI       STYPE,AY            ACK PACKET                       22730000
         XC        LSDAT,LSDAT         NO DATA                          22740000
OVER     L         R15,=A(SPACK)                                        22750000
         BALR      R14,R15             SEND ACK                         22760000
         CLI       STATE,C'A'                                           22770000
         BE        RABORT                                               22780000
         MVC       OLDTRY(4),NUMTRY    KEEP NUMTRY FOR LATER            22790000
         XC        NUMTRY,NUMTRY       RESET TO ZERO                    22800000
         L         R3,N                                                 22810000
         LA        R3,1(R3)            ADD ONE                          22820000
         ST        R3,N                INCREMENT COUNTER                22830000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               22840000
         MVI       STATE,C'D'          DATA RECEIVE STATE               22850000
         B         RLOOP                                                22860000
RNB      CLI       RTYPE,AB            SEE IF IT'S A BREAK              22870000
         BNE       RNN                 MAYBE GOT A NAK                  22880000
         CLC       NUM,N                                                22890000
         BE        RNUM4                                                22900000
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          22910000
         B         RNAK                SEND A NAK                       22920000
RNUM4    MVI       STYPE,AY            ACK PACKET                       22930000
         XC        LSDAT,LSDAT         NO DATA                          22940000
         L         R15,=A(SPACK)                                        22950000
         BALR      R14,R15                                              22960000
         CLI       STATE,C'A'                                           22970000
         BE        RABORT                                               22980000
         MVI       STATE,C'C'          COMPLETE STATE                   22990000
         B         RLOOP                                                23000000
RNN      CLI       RTYPE,AN            SEE IF GOT A NAK                 23010000
         BNE       RNELSE                                               23020000
RNAK     MVI       STYPE,AN            SEND A NAK PACKET                23030000
         XC        LSDAT,LSDAT         NO DATA                          23040000
         L         R15,=A(SPACK)                                        23050000
         BALR      R14,R15                                              23060000
         B         RLOOP               DO NOTHING ON A NAK              23070000
RNELSE   MVI       STATE,C'A'          ABORT OTHERWISE                  23080000
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              23090000
         B         RLOOP                                                23100000
**********************************************************************  23110000
*        RECEIVE DATA PACKETS                                        *  23120000
**********************************************************************  23130000
RDATA    CLC       NUMTRY,MAXTRY       HAVE WE EXCEEDED OUR LIMIT?      23140000
         BL        ROK3                                                 23150000
         MVI       STATE,C'A'          ELSE, ABORT                      23160000
         B         RLOOP                                                23170000
ROK3     L         R4,NUMTRY                                            23180000
         LA        R4,1(R4)            INCREMENT                        23190000
         ST        R4,NUMTRY           SAVE INCREMENTED COUNTER         23200000
         L         R15,=A(RPACK)                                        23210000
         BALR      R14,R15             CALL RPACK                       23220000
         CLI       RTYPE,AE            ERROR PACKET?                    23230000
         BNE       RY3                 MAYBE AN ACK                     23240000
         MVI       ERRNUM,X'0A'        MICRO DIED                       23250000
         MVI       STATE,C'A'          WE ABORT TOO                     23260000
         B         RLOOP                                                23270000
RY3      CLI       RTYPE,AD            IS THIS A DATA PACKET?           23280000
         BNE       RDF                 MAYBE IT'S AN FNAME PACKET       23290000
         CLC       N,NUM               CHECK FOR RIGHT PACKET           23300000
         BNE       DIF                                                  23310000
         L         R15,=A(PTCHR)                                        23320000
         BALR      R14,R15             PUT CHARACTERS INTO FILE         23330000
         LTR       R7,R7               CHECK FOR NO ERROR               23340000
         BZ        OKWR                NO ERROR                         23350000
         MVI       STATE,C'A'          ABORT ON FILE SYSTEM ERROR       23360000
         B         RLOOP                                                23370000
OKWR     MVI       STYPE,AY            ACK PACKET                       23380000
         XC        LSDAT,LSDAT         NO DATA                          23390000
         L         R15,=A(SPACK)                                        23400000
         BALR      R14,R15                                              23410000
         CLI       STATE,C'A'                                           23420000
         BE        RABORT                                               23430000
         MVC       OLDTRY(4),NUMTRY    SAVE NUMTRY'S VALUE IN OLDTRY    23440000
         XC        NUMTRY,NUMTRY       RESET NUMTRY                     23450000
         L         R3,N                                                 23460000
         LA        R3,1(R3)                                             23470000
         ST        R3,N                INCREMENT COUNTER                23480000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               23490000
         B         RLOOP                                                23500000
DIF      CLC       OLDTRY,MAXTRY       CAN WE DO IT?                    23510000
         BL        DIFNUM                                               23520000
         MVI       STATE,C'A'          AND ABORT                        23530000
         B         RLOOP                                                23540000
DIFNUM   L         R4,OLDTRY                                            23550000
         LA        R4,1(R4)                                             23560000
         ST        R4,OLDTRY           INCREMENT THIS COUNTER           23570000
         L         R4,N                                                 23580000
         BCTR      R4,0                                                 23590000
         C         R4,NUM              NUM MUST EQUAL N-1               23600000
         BE        DIFOK                                                23610000
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          23620000
         B         RDN1                SEND A NAK                       23630000
DIFOK    XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            23640000
         MVI       STYPE,AY            ACK PACKET                       23650000
         XC        LSDAT,LSDAT         NO DATA                          23660000
         ST        R4,N                SET N TO N-1 TO RESEND PACKET    23670000
         L         R15,=A(SPACK)                                        23680000
         BALR      R14,R15             SEND THE PACKET                  23690000
         CLI       STATE,C'A'                                           23700000
         BE        RABORT                                               23710000
         L         R4,N                                                 23720000
         LA        R4,1(R4)            ADD ONE                          23730000
         ST        R4,N                RESTORE N TO PROPER VALUE        23740000
         B         RLOOP               AND RETURN                       23750000
RDF      CLI       RTYPE,AF            SENDING FILENAME AGAIN?          23760000
         BNE       RDZ                                                  23770000
         CLC       OLDTRY,MAXTRY       CAN WE DO IT?                    23780000
         BL        FILOVER             TRYING IT AGAIN                  23790000
         MVI       STATE,C'A'          IF NO, ABORT                     23800000
         B         RLOOP                                                23810000
FILOVER  L         R4,OLDTRY                                            23820000
         LA        R4,1(R4)                                             23830000
         ST        R4,OLDTRY           SAVE INCREMENTED VALUE           23840000
         L         R4,N                                                 23850000
         BCTR      R4,0                NEED VALUE OF N-1                23860000
         C         R4,NUM              N-1 MUST EQUAL NUM               23870000
         BE        FILOK                                                23880000
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          23890000
         B         RDN1                SEND A NAK                       23900000
FILOK    XC        NUMTRY,NUMTRY       RESET TO ZERO                    23910000
         XC        LSDAT,LSDAT         NO DATA                          23920000
         MVI       STYPE,AY            ACK PACKET AGAIN                 23930000
         ST        R4,N                SET N TO N-1 FOR NOW             23940000
OVRWRT   L         R15,=A(SPACK)                                        23950000
         BALR      R14,R15                                              23960000
         CLI       STATE,C'A'                                           23970000
         BE        RABORT                                               23980000
         L         R4,N                                                 23990000
         LA        R4,1(R4)            ADD ONE                          24000000
         ST        R4,N                RESTORE N TO PROPER VALUE        24010000
         B         RLOOP               AND RETURN                       24020000
RDZ      CLI       RTYPE,AZ            IS THIS AN EOF PACKET?           24030000
         BNE       RDN                                                  24040000
         CLC       N,NUM               ARE THEY EQUAL                   24050000
         BE        RDOK                                                 24060000
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          24070000
         B         RDN1                SEND A NAK                       24080000
RDOK     MVI       STYPE,AY            ACK THE PACKET                   24090000
         XC        LSDAT,LSDAT         NO DATA                          24100000
         L         R15,=A(SPACK)                                        24110000
         BALR      R14,R15                                              24120000
         MVC       OLDTRY(4),NUMTRY    SAVE NUMTRY'S VALUE HERE         24130000
         XC        NUMTRY,NUMTRY       AND RESET COUNTER                24140000
         L         R3,N                                                 24150000
         LA        R3,1(R3)                                             24160000
         ST        R3,N                STORE VALUE INCREMENTED BY 1     24170000
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               24180000
         MVI       STATE,C'F'          TRY FOR ANOTHER FILE             24190000
         B         RLOOP                                                24200000
RDN      CLI       RTYPE,AN            DO WE NEED TO SEND A NAK?        24210000
         BNE       RDELSE                                               24220000
RDN1     MVI       STYPE,AN            SEND A NAK                       24230000
         XC        LSDAT,LSDAT         NO DATA                          24240000
         L         R15,=A(SPACK)                                        24250000
         BALR      R14,R15                                              24260000
         B         RLOOP                                                24270000
RDELSE   MVI       STATE,C'A'          UNRECOGNIZED PACKET - ABORT      24280000
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              24290000
         B         RLOOP                                                24300000
SAYNO    MVI       STYPE,AN            SEND A NAK PACKET                24310000
         XC        LSDAT,LSDAT         NO DATA                          24320000
         MVI       ERRNUM,X'0B'        ILLEGAL FILENAME ERROR           24330000
         L         R15,=A(SPACK)                                        24340000
         BALR      R14,R15                                              24350000
         B         RLOOP                                                24360000
**********************************************************************  24370000
*        RECEIVE ABORT PROCESS                                       *  24380000
**********************************************************************  24390000
RABORT   DS        0H                                                   24400000
         CLI       ERRNUM,X'0A'        DID THE MICRO DIE?               24410000
         BE        RNOERRP             NO ERROR PACKET IF SO            24420000
         MVI       STYPE,AE            ERROR PACKET                     24430000
         MVC       LSDAT(4),=F'20'     ALL MSGS ARE THIS LONG           24440000
         MVC       N(4),NUM            SYNCH PACKET NUMBERS             24450000
         SR        R5,R5                                                24460000
         IC        R5,ERRNUM                                            24470000
         M         R4,=F'20'           OFFSET := ERRNUM * 20            24480000
         LA        R5,ERRTAB(R5)                                        24490000
         MVC       SDAT(20),0(R5)      SPACK NEEDS THE DATA HERE        24500000
         TR        SDAT(20),ETOA                                        24510000
         L         R15,=A(SPACK)                                        24520000
         BALR      R14,R15             SEND ERROR PACKET & DIE          24530000
RNOERRP  LA        R15,4               SET A NON-ZERO RETCODE           24540000
         B         RECRET              PREPARE TO LEAVE                 24550000
**********************************************************************  24560000
*        RECEIVE COMPLETE PROCESS                                    *  24570000
**********************************************************************  24580000
RCOMP    SR        R15,R15             RETCODE OF ZERO                  24590000
RECRET   L         R13,4(R13)                                           24600000
         L         R14,12(R13)                                          24610000
         LM        R0,R12,20(R13)                                       24620000
         BR        14                                                   24630000
         EJECT                                                          24640000
**********************************************************************  24650000
*                                                                    *  24660000
*  ROUTINE TO PUT A CHARACTER IN OUTPUT BUFFER AND DUMP WHEN FULL    *  24670000
*                                                                    *  24680000
**********************************************************************  24690000
PTCHR    SR        R4,R4               COXPAHñEM QUOTE                  24700000
         SR        R6,R6               COXPAHñEM   LRECL                24710000
         SR        R8,R8               õKAúATEìø B    RDAT              24720000
         L         R9,RSAVPL           õKAúATEìø B    RBUF              24730000
         IC        R4,RQUO                                              24740000
         IC        R6,LRECL                                             24750000
         L         R5,LRDAT            COUNTER TO GET ALL DATA          24760000
RLUP     SR        R7,R7               USE TO PICK UP CHAR              24770000
         LTR       R5,R5               MORE DATA LEFT?                  24780000
         BNZ       MOR                 LEAVE IF ALL DONE                24790000
         TM    FLAGS,BINF              FILE BINARY ?             J      24800000
         BE    ST9RS                   YES - SKEEP EOREC. PROC.  J      24810000
         CLI       PREV,X'4D'          ARE WE IN MIDDLE OF LINE?        24820000
         BER       R14                 LEAVE IF NOT                     24830000
ST9RS    ST        R9,RSAVPL           SAVE OUR PLACE                   24840000
         SR        R7,R7               ZERO RETCODE                     24850000
         BR        R14                                                  24860000
MOR      BCTR      R5,0                DECREMENT CHAR COUNTER           24870000
         XC    PADD(4),PADD            FOR 8-BIT QUO              J     24880001
         SR    R1,R1                   WORK REGISTER              J     24890000
         IC        R7,RDAT(R8)         âEPEM CéMBOì                     24900000
*                                      ****** J BEGIN ********          24910000
         CLI   EBQUOT,AN               COçìACOBAHA PAâOTA C 8-âéT ?     24920000
         BE    TESTCQ                   HET                             24930000
         CLI   EBQUOT,AY               COçìACOBAHA PAâOTA C 8-âéT ?     24940000
         BE    TESTCQ                   HET                             24950000
         SR    R1,R1                   8-BIT QUOTING IS POSSIBLE        24960000
         IC    R1,EBQUOT               úAçPõöAEM PREF 8 âéTA            24970000
         CR    R7,R1                   ðOìõþEH PREF ?                   24980000
         BNE   TESTCQ                   HET                             24990000
*                                      ****** R BEGIN ********          25000001
         OI    PADD+3,X'80'            úAðOMHéM, þTO âùì PREF           25010001
         BCTR  R5,0                    ELSE - SKEEP QUOTE               25020000
         LA    R8,1(R8)                AäPEC CìEä. CéMBOìA              25030000
         IC    R7,RDAT(R8)             âEPEM CìEä. CéMBOì               25040000
TESTCQ   CR        R7,R4               ðOìõþEH QUOTE ?                  25050001
         BNE   REGULAR                 HET                              25060001
         BCTR      R5,0                DECREMENT CHAR COUNT             25070000
         LA        R8,1(R8)            MOVE POINTER                     25080000
         IC        R7,RDAT(R8)         âEPEM CéMBOì ðOCìE QUOTE         25090001
****     ðPOBEPKA CR LF B TEKCTOBOM æAêìE                               25100001
         TM    FLAGS,BINF              IS FILE BINARY            J      25110000
         BNZ   NOLF                    YES - SKEEP CR & LF PROC. J      25120000
         TM    PADD+3,X'80'            ðEPEä QUOTE âùì PREF ?    R      25130001
         BO    NOLF                    äA                        R      25140001
         C         R7,=X'0000004D'     IS IT A CR? (CHAR(CR))           25150000
         BNE       NOCR                WRITE OUT RECORD IF YES          25160000
         MVI       PREV,X'4D'          JUST HAD A CR                    25170000
         LA        R8,1(R8)            IGNORE CONTROL CHAR              25180000
         B         RFIN                                                 25190000
NOCR     C         R7,=X'0000004A'     HOW ABOUT A LF? (CHAR(LF))       25200000
         BNE       NOLF                IF YES, WRITE OUT RECORD         25210000
         LA        R8,1(R8)            IGNORE CONTROL CHAR              25220000
         CLI       PREV,X'4D'          WAS LAST THING CR?               25230000
         BNE       RFIN                NOPE, THEN KEEP ON               25240000
         B         RLUP                IGNORE LF IF PREV=CR             25250000
****                                                                    25260001
NOLF     CR        R7,R4               QUOTE ?                          25270001
         BE        REGULAR             äA, BùBOäéM QUOTE                25280001
         LTR   R1,R1                   ECTø ðPEæéKCAãéñ 8 âéTA ? J      25290001
         BZ    AR7O1H                  HET                       J      25300001
         CR    R7,R1                   üTO PREF  8 âéTA ?        J      25310001
         BE    REGULAR                 äA, BùBOäéM PREF          J      25320001
AR7O1H   A         R7,O1H              FUNCTION CTL(X)                  25330001
         N         R7,=X'0000007F'     çACéM BCE, KPOME CEMé âéT        25340001
REGULAR  O     R7,PADD                 ADD 8 BIT IF IT'S NEED ***J END  25350000
         STC       R7,RBUF(R9)         STORE CHAR IN RBUF               25360000
         LA        R9,1(R9)            MOVE RBUF COUNTER                25370000
         LA        R8,1(R8)            MOVE RDAT COUNTER                25380000
         MVI       PREV,X'00'          BLANK OUT CR IF WAS THERE        25390000
         C         R9,=F'255'          ONLY 256 CHARS ALLOWED           25400000
         BNH       RLUP                AND CONTINUE                     25410000
         LR        R10,R9              USE MAX LENGTH OF 256            25420000
         B         WRFIL               AND WRITE TO FILE                25430000
RFIN     LTR       R10,R9              GET DATA SIZE                    25440000
         BZ        FUDGE               GOTTA FAKE A BLANK LINE          25450000
         C         R7,=X'0000004D'     IS IT A CR?  (CHAR(CR))          25460000
         BE        WRFIL                                                25470000
         C         R7,=X'0000004A'     HOW ABOUT A LF? (CHAR(LF))       25480000
         BE        WRFIL                                                25490000
         ST        R10,RSAVPL          SAVE DATA RECEIVED SO FAR        25500000
         SR        R7,R7               ZERO RETCODE                     25510000
         BR        14                                                   25520000
FUDGE    MVI       RBUF,X'20'          MAKE FIRST CHAR A SPACE          25530000
         LA        R10,1(R10)          LENGTH OF ONE                    25540000
WRFIL    XC        RSAVPL,RSAVPL       RESET THE POINTER                25550000
         TM    FLAGS,BINF              IZ FILE BINARY  ?         J      25560000
         BNZ   CRR10                   YES  - NO TRANSLATE       J      25570000
         L     R15,TRTADDR             CURRENT TRAN TABLE ADDR   J      25580000
         TR    RBUF(256),0(R15)        MAKE EBCDIC AGAIN         J      25590000
         B     WRCONT                  SAME CONT                 J      25600000
CRR10    CR    R10,R6                  PART LT BLKSIZE            J     25610000
         BL    STR10                   NOW SKIP WRITE             J     25620000
WRTRY    ST    R10,SAVR10              TEMPORARY SAVE             J     25630000
         LR    R10,R6                  LENGHTH = BLKSIZE          J     25640000
         LA    R15,WRITEX                                         J     25650000
         BALR  R15,R15                 WRITE RECORD               J     25660000
         L     R10,SAVR10              RETURN R10                 J     25670000
         SR    R10,R6                                             J     25680000
         BE    STR10                                              J     25690000
         BCTR  R10,0                   FOR EX COM.                J     25700000
         LA    R15,RBUF(R6)                                       J     25710000
         MVC   RBUF(*-*),0(R15)        TO BEGIN OF BUF.           J     25720000
         EX    R10,*-6                                            J     25730000
         LA    R10,1(R10)              RETURN LEN                 J     25740000
         CR    R10,R6                  GRATER THEN LRECL ?        J     25750000
         BNL   WRTRY                   YES,NEXT WRITE             J     25760000
STR10    ST    R10,RSAVPL              SHORT PART - CONTINUE      J     25770000
         LR    R9,R10                  RESTORE BUF. POINTER  (!!) J     25780000
         B     RLUP                                               J     25790000
WRCONT   CLI   RFM,C'V'                IS IT VARIABLE FORMAT ?    J     25800000
         BE    VAR                                                      25810000
         CR        R10,R6              PAD OUT TO LRECL SIZE ?          25820000
         BE        VAR                 NOPE, IT'S OK.                   25830000
         BNL   PUR                                                J     25840000
         LR        R2,R6               GET LRECL SIZE                   25850000
         SR        R2,R10              PAD WITH THIS MANY SPACES        25860000
         BCTR      R2,0                MINUS ONE FOR THE 'EX'           25870000
         LA        R9,RBUF(R10)        START PADDING HERE               25880000
         MVI       0(R9),C' '          PUT IN THE FIRST SPACE           25890000
         LTR       R2,R2                                                25900000
         BZ        PUR                 DON'T PAD IF SIZE DIF WAS ONE    25910000
         BCTR      R2,0                SUBRTRACT SPACE WE JUST ADDED    25920000
         EX        R2,PAD              PAD OUT BUFFER                   25930000
PUR      LR        R10,R6              LENGTH HAS TO BE THIS SIZE       25940000
VAR      DS        0H                                             RJR   25950000
         LA        R15,WRITEX                                           25960000
         BALR      R15,R15                                              25970000
         SR        R9,R9               START AT BEGINNING OF RBUF       25980000
         B         RLUP                GET NEXT LINE IF OK              25990000
RECSAVE  DS        18F                                                  26000000
PAD      MVC       1(0,R9),0(R9)       PAD OUT WITH SPACES              26010000
         LTORG                                                          26020000
*                                                                       26030000
         EJECT                                                          26040000
**********************************************************************  26050000
*                                                                    *  26060000
*  DISK FILE WRITE ROUTE WITH DEBUGGING CODE                         *  26070000
*                                                                    *  26080000
**********************************************************************  26090000
WRITEX   DS        0H                                                   26100000
         USING     PARMS,R11                                            26110000
         STM       R12,R15,WRITSAVE                                     26120000
         BALR      R12,0                                                26130000
         USING     *,R12                                                26140000
         LA        R0,RBUF             POINT TO RBUF                    26150000
         TM        KEROUT+(DCBRECFM-IHADCB),DCBRECV VARIABLE?           26160000
         BZ        WRITEX2             NO, THEN DON'T ADJUST            26170000
         LA        R0,RBUF-4           POINT TO RDW                     26180000
         LR        R15,R10             GET THE LENGTH                   26190000
         AH        R15,=H'4'           INCLUDE LENGTH OF RDW            26200000
         SR        R1,R1                                                26210000
         STH       R1,RBUF-2           CLEAR RDW                        26220000
         IC        R1,LRECL            GET LRECL                        26230000
         CR        R15,R1              IS THE RECORD GT MAX LRECL?      26240000
         BNH       *+6                 NO, THEN IT'S OK                 26250000
         LR        R15,R1              ELSE SET TO MAX                  26260000
         STH       R15,RBUF-4                                           26270000
WRITEX2  DS        0H                                                   26280000
         PUT       KEROUT,(R0)                                          26290000
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        26300000
         BZ        WRNODBG                                              26310000
         MVC       WRKBUFF(2),=H'12'                                    26320000
         XC        WRKBUFF+2(2),WRKBUFF+2                               26330000
         MVC       WRKBUFF+4(8),=CL8'QSAM PUT'                          26340000
         PUT       DEBUG,WRKBUFF                                        26350000
         EX        R10,DBGMVC4                                          26360000
         LA        R1,4(,R10)                                           26370000
         STH       R1,WRKBUFF                                           26380000
         PUT       DEBUG,WRKBUFF                                        26390000
WRNODBG  LM        R12,R15,WRITSAVE                                     26400000
         BR        R15                                                  26410000
DBGMVC4  MVC       WRKBUFF+4(*-*),RBUF                                  26420000
         DROP      R11                                                  26430000
         DROP      R12                                                  26440000
         LTORG                                                          26450000
         EJECT                                                          26460000
**********************************************************************  26470000
*                                                       J (BEGIN)    *  26480000
*        ROUTINE TO SET 8 - BIT QUOTE  CHARACTER DEPENDING ON MY     *  26490000
*         OUN  CAPABILITIES AND THE OT HER KERMIT'S REQUEST          *  26500003
*                                                                    *  26510000
**********************************************************************  26520000
DOQUO    DS    0H                                                       26530000
         STM   R14,R12,12(R13)                                          26540000
         BALR  R12,0                                                    26550000
         USING *,R12                                                    26560000
         LA    R14,DQSAVE                                               26570000
         ST    R13,4(R14)                                               26580000
         ST    R14,8(R13)                                               26590000
         LR    R13,R14                                                  26600000
         L     R11,=A(PARMS)           GET ADDRESS OF WORKAREAS         26610000
         USING PARMS,R11                                                26620000
         LA    R7,RDAT                 POINT TO DATA BUFFER             26630000
         CLI   EBQUOT,AN               CAN  I DO 8-BIT QUOTING ?        26640000
         BE    DQRET                   NO - SO FORGET IT                26650000
         CLI   EBQUOT,AY               CAN I DO IT IF REQUIRED ?        26660000
         BNE   DQ0                     NO - I MUST  QUOTE               26670000
         MVC   EBQUOT(1),6(R7)         SET NEW BIT QUOTE CHAR           26680000
         SR    R3,R3                                                    26690000
         IC    R3,EBQUOT                                                26700000
*                                      QUOT CHAR CHECKING               26710000
         C     R3,=F'33'                                                26720000
         BNL   PREC0                                                    26730000
         B     DQ1                                                      26740000
PREC0    C     R3,=F'62'                                                26750000
         BH    PREC1                                                    26760000
         B     PREC5                                                    26770000
PREC1    C     R3,=F'96'                                                26780000
         BNL   PREC2                                                    26790000
         B     DQ1                                                      26800000
PREC2    C     R3,=F'126'                                               26810000
         BNH   PREC5                                                    26820000
PREC5    DS    0H                      CHAR IS GOOD                     26830000
         CLC   EBQUOT(1),QUOCHAR       SAME ?                           26840000
         BE    DQ1                                                      26850000
*        CLC   EBQUOT(1),SQUOTE                                         26860000
*        BE    DQ1                                                      26870000
         B     DQRET                                                    26880000
DQ0      CLI   6(R7),AY                I NEED QUOT, CAN HI DO IT ?      26890000
         BE    DQRET                                                    26900000
         CLI   6(R7),AN                HE CANT DO IT, DON'T QUOTE       26910000
         BE    DQ1                                                      26920000
         CLC   EBQUOT(1),6(R7)         QUOT CHARS MAST MATCH            26930000
         BE    DQRET                                                    26940000
DQ1      MVI   EBQUOT,AN               ELSE, FORGET THE QUOTING         26950000
DQRET    L     R13,4(R13)                                               26960000
         L     R14,12(R13)                                              26970000
         LM    R0,R12,20(R13)                                           26980000
         BR    14                                                       26990000
DQSAVE   DS    18F                     SAVE AREA         J (END)        27000000
         DROP      R11                                                  27010000
         DROP      R12                                                  27020000
         LTORG                                                          27030000
         EJECT                                                          27040000
**********************************************************************  27050000
*                                                                    *  27060000
*        ROUTINE TO PARSE COMMANDS AND CREATE PARSE TABLE            *  27070000
*                                                                    *  27080000
**********************************************************************  27090000
PARSER   STM       R14,R12,12(R13)     SAVE REGISTERS                   27100000
         LR        R12,R15             MOVE THE BASE REGISTER           27110000
         USING     PARSER,R12          ##                               27120000
         L         R11,=A(PARMS)       GET ADDRESS OF WORKAREAS         27130000
         USING     PARMS,R11                                            27140000
         LR        R3,R0               R3 = TEXT LENGTH                 27150000
         BCTR      R1,0                R1 ==> BYTE BEFORE PARM          27160000
         LA        R3,0(R1,R3)         R3 ==> END OF LINE               27170000
         LA        R2,1                R2 = PARSING INCREMENT           27180000
         LA        R5,PTRTBL           R5 ==> TARGET AREA               27190000
         LA        R6,4                R6 = POINTER INCREMENT           27200000
         STM       R5,R6,PARSELST      SAVE FOR PARSING                 27210000
         LA        R7,PTRTBL+PTRTBLL-4 R7 ==> END OF TARGET             27220000
*                                                                       27230000
SCNTOKEN BXH       R1,R2,SCNFINIS      SCAN FOR PARM START              27240000
         CLI       0(R1),C' '          FOUND A BLANK?                   27250000
         BE        SCNTOKEN            YES, THEN KEEP LOOKING           27260000
         ST        R1,0(,R5)           SAVE PTR TO OPERAND              27270000
         BXH       R5,R6,SCNFINIS      BR ON END OF TARGET AREA         27280000
SCNLASTC BXH       R1,R2,SCNFINIS      SCAN TO END OF OPERAND           27290000
         CLI       0(R1),C' '          IS THIS BLANK AT END OF OPERAND  27300000
         BNE       SCNLASTC            IF SO, MOVE TOKEN                27310000
         LR        R9,R1               REMEMBER JUST AFTER OPERAND      27320000
         B         SCNTOKEN            FIND START OF NEXT OPERAND       27330000
SCNFINIS MVI       0(R9),C' '          MARK THE END OF OPERANDS         27340000
         ST        R9,0(R5)            SAVE POINTER TO END              27350000
         ST        R5,PARSELST+8       SAVE END TARGET                  27360000
         LM        R14,R12,12(R13)     RESTORE THE REGISTERS            27370000
         BR        R14                 RETURN TO CALLER                 27380000
         LTORG                                                          27390000
         DROP      R11                                                  27400000
         DROP      R12                 DON'T NEED THEM ANYMORE          27410000
         EJECT                                                          27420000
PARMS    DS        0H                  GLOBAL DATA LIST                 27430000
         USING PARMS,R11                                                27440000
SNDPKT   DS        CL130               SEND THIS TO MICRO               27450000
         ORG       SNDPKT                                               27460000
*HDR     DS        X                    WAS PHDR                     Z  27470000
PLEN     DS        X                                                    27480000
PNUM     DS        X                                                    27490000
PTYPE    DS        X                                                    27500000
PDATA    DS        0C                                                   27510000
         ORG       ,                                                    27520000
RECPKT   DS        CL130               RECEIVE THIS FROM MICRO          27530000
LSDAT    DS        F                   SEND PACKET SIZE                 27540000
LRDAT    DS        F                   RECEIVE PACKET SIZE              27550000
FLAGS    DC        X'00'               USE TO TEST OUR FLAGS            27560000
NAME     DC        18X'20'             NAME OF FILE(S) TO SEND          27570000
         DS        0F                                                   27580000
         DS        0F                                                   27590000
INPUT    DS        CL130               INPUT BUFFER                     27600000
         DS        0F                                                   27610000
         DS        F                   RDW FOR VARIABLE RECORDS         27620000
BUF      DS        CL260               DISK READ INTO HERE              27630000
         DS        F                   RDW FOR VARIABLE RECORDS         27640000
RBUF     DS        CL260               DISK WRITE FROM HERE             27650000
N        DC        F'0'                SEND PACKET NUMBER               27660000
NUM      DC        F'0'                RECEIVE PACKET NUMBER            27670000
NUMTRY   DC        F'0'                TRIAL COUNTER FOR TRANSFERS      27680000
OLDTRY   DS        F                   COUNTER FOR PREVIOUS PACKET      27690000
STORLOC  DS        F                   POINTER TO EXTRA STORAGE         27700000
MAXPACK  DC        F'94'               MAX PACKET SIZE                  27710000
RECL     DS        F                   RECORD LEN (IF RECFM = V)        27720000
RPSIZ    DC        F'94'               MAX RECEIVE PACKET SIZE          27730000
DSSIZ    DC        F'40'               DEFAULT MAX SEND PACKET SIZE     27740000
SPSIZ    DS        F                   SEND PACKET SIZE                 27750000
MAXTRY   DC        F'5'                NO. OF TIMES TO RETRY PACKET     27760000
IMXTRY   DC        F'16'               NO. OF INITIAL TRIALS ALLOWED    27770000
SIZE     DS        F                   MAX SIZE FOR SEND DATA           27780000
DEL      DC        F'127'              OCTAL 177 (DELETE CHAR)          27790000
ZERO     DC        F'0'                                                 27800000
ONE      DC        F'1'                                                 27810000
FIVE     DC        F'5'                                                 27820000
TWO      DC        F'2'                                                 27830000
SPACE    DC        F'32'               ASCII SPACE                      27840000
O1H      DC        F'64'               OCTAL 100                        27850000
O2H      DC        F'128'              OCTAL 200                        27860000
SAVPL    DC        F'0'                POINTER WITHIN BUF,INIT=0        27870000
RSAVPL   DC        F'0'                POINTER IN 'PTCHR',INIT=0        27880000
DQUOTE   DC        X'23'               DEFAULT QUOTE CHARACTER = #      27890000
QUOCHAR  DS        X                   QOUTE CHAR WE'LL SEND            27900000
RQUO     DS        X                   MICRO'S QUOTE CHAR               27910000
EBQUOT   DS    X                       8-BIT QUOTING CHAR             J 27920000
ORIG8Q   DS    X                       ORIGINAL 8-BIT QUOTING CHAR    J 27930000
TEMP     DS        F                   TEMPORARY SPACE                  27940000
         DS        0D                                                   27950000
PKVAR    DS        D                   USE FOR PICKING UP INTEGER       27960000
SDAT     DS        CL130               TEMP PLACE FOR SEND DATA         27970000
RDAT     DS        CL130               TEMP PLACE FOR RECEIVE DATA      27980000
FILNAML  DS    H                   LENGTH OF FILENAME                   27990000
FILNAM   DS        CL18                SEND/REC FILENAME                28000000
STATE    DS        C                   OUR CURRENT STATE                28010000
DEOL     DC        X'04'               DEFAULT END OF PACKET (EOT)    Z 28020000
REOL     DS        X                   EOL CHAR I NEED (CR)             28030000
SEOL     DS        X                   EOL I'LL SEND                    28040000
DSOH     DC        X'01'               DEFAULT START OF HEADER (CTL A)  28050000
RSOH     DS        X                   RECEIVE START OF HEADER          28060000
SSOH     DS        X                   SEND START OF HEADER             28070000
DLRECL   DC        X'50'               DEFAULT LRECL SIZE OF 80         28080000
LRECL    DS        X                   LRECL PROGRAM WILL USE           28090000
DBLKSIZE DC        H'80'               DEFAULT BLKSIZE OF 80            28100000
BLKSIZE  DS        H                   BLKSIZE PROGRAM WILL USE         28110000
DTRACK   DC        F'5'                DEFAULT SPACE ALLOCATION         28120000
DRECFM   DC        C'F'                DEFAULT WITH FIXED RECFM         28130000
RFM      DS        C                   RECFM PROGRAM WILL USE           28140000
PREV     DS        C                   PREVIOUS CHAR REC (IN PTCHR)     28150000
BLIP     DS        X                   SAVE USER'S BLIP CHAR            28160000
LINSIZ   DS        F                   SAVE USER'S CONSOLE LINESIZE     28170000
ERRNUM   DS        X                   ERROR NUMBER,IN CASE WE DIE      28180000
OLDERR   DS        X                   ERROR OF PREVIOUS EXECUTION      28190000
STYPE    DS        C                   TYPE OF PACKET SENT              28200000
RTYPE    DS        C                   TYPE OF PACKET RECEIVED          28210000
*                                                                       28220000
READSAVE DS        4F                                                   28230000
WRITSAVE DS        4F                                                   28240000
SAVR6    DS    F                                                  J     28250000
SAVR10   DS    F                       FOR TEMPORARY SAVE OF R10  J     28260000
PADD     DS    F                       PAD FOR 8-BIT QUOT AT READ J     28270000
TRTBLDL  DC    H'1,12'                                                  28280000
TRTNAME  DC    CL8'STANDARD',CL4' '                                     28290000
TRTADDR  DC    A(ATOE8)                                                 28300000
PARSELST DS        3F                  PTRS TO OPERAND STACK            28310000
PTRTBL   DS        15F                 OPERAND STACK                    28320000
PTRTBLL  EQU       *-PTRTBL            LENGTH OF PTRTBL                 28330000
DBLWRK   DS        D                                                    28340000
IDSYS    DC        F'2'                MVS TSO                          28350000
DDNAME   DC        CL8' '              DDNAME TO ALLOCATE               28360000
DSNAME   DC        CL80' '             DSNAME TO ALLOCATE               28370000
DSNAMEX  DC        CL80' '             WRKBUFFER                        28380000
MEMBER   DC        CL8' '              MEMBER NAME FOR PDS ALLOC        28390000
CMSXXX   DC        CL8' '              USED IN CMS ONLY                 28400000
CMSYYY   DC        CL8' '                                               28410000
CMSZZZ   DC        CL2' '                                               28420000
DISP1    DC        F'2'                DISP (0=NEW,1=OLD,2=SHR)         28430000
DISP2    DC        F'3'                DISP (0=UNCAT,1=CAT,3=KEEP)      28440000
INOUT    DC        F'2'                0=INPUT,1=OUTPUT,2=INOUT)        28450000
RECFMX   DC        F'1'                1=FB,2=VBS                       28460000
BLKSIZEX DC        F'3600'             FOR NEW DATA SETS ONLY           28470000
LRECLX   DC        F'80'               ....                             28480000
DEV      DC        CL8'SYSDA'          DEVICE                           28490000
TRACK    DC        F'20'               # TRACKS TO ALLOC FOR NEW DSETS  28500000
DYNALCRC DC        F'0'                RETURN CODE FROM FUNCTION        28510000
WRKBUFF  DS        CL280                                                28520000
PREFIX   DC        CL8' '              USERS DSET PREFIX FROM UPT       28530000
PREFIXL  DC        F'0'                PREFIX LENGTH-1                  28540000
DDELAY   DC        F'2000'             DEFAULT DELAY TIME               28550000
DELAY    DS        F                   DELAY TIME                       28560000
PUTGET   PUTGET OUTPUT=(OLD,SINGLE,MODE),TERMPUT=ASIS,MF=L        J     28570000
ECBPTGT  DC    F'0'                    ECB FOR IOPL               J     28580000
OLD      DC    A(1,*+4),H'17,0',CL13' KERMIT-TSO>' OUTPUT STRING J      28590003
IOPLL    DC    4F'0'                   IOPL                       J     28600000
*                                                                       28610000
*  THIS IS THE DYNALC PARM LIST USED FOR BOTH ALLOCATION AND            28620000
*  CREATION OF  DATA SETS.                                              28630000
*                                                                       28640000
DYNAPARM DS 0F                                                          28650000
 DC A(IDSYS,DDNAME,DSNAME,MEMBER,CMSXXX,CMSYYY,CMSZZZ,DISP1,DISP2)      28660000
 DC A(INOUT,RECFMX,BLKSIZEX,LRECLX,DEV,TRACK)                           28670000
 DC X'80',AL3(DYNALCRC)                                                 28680000
*                                                                       28690000
* TABLE TO TRANSLATE TO UPPER CASE                                      28700000
*                                                                       28710000
UPPER    DC    256AL1(*-UPPER)                                          28720000
         ORG   UPPER+X'81'                                              28730000
         DC    C'ABCDEFGHI'                                             28740000
         ORG   UPPER+X'91'                                              28750000
         DC    C'JKLMNOPQR'                                             28760000
         ORG   UPPER+X'A2'                                              28770000
         DC    C'STUVWXYZ'                                              28780000
         ORG                                                            28790000
* THIS IS THE ASCII TO EBCDIC TABLE    TRUNCATED (RUSSIAN DKOI)    Z    28800000
*                     0 1 2 3 4 5 6 7 8 9 A B C D E F                   28810000
ATOE     DC        X'00010203372D2E2F1605250B0C0D0E0F' 0                28820000
         DC        X'101112133C3D322618193F271C1D1E1F' 1                28830000
         DC        X'404F7F7B5B6C507D4D5D5C4E6B604B61' 2                28840000
         DC        X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 3                28850000
         DC        X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 4                28860000
         DC        X'D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D' 5                28870000
         DC        X'B8B9BABBBCBDBEBFCACBCCCDCECFDADB' 6                28880000
         DC        X'DCDDDEDFEAEBECEDEEEFFAFBFCFDFEFF' 7                28890000
*THIS IS THE EBCDIC TO ASCII CONVERSION TABLE                           28900000
*CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL           28910000
*                     0 1 2 3 4 5 6 7 8 9 A B C D E F                   28920000
ETOA     DC        X'00010203905C867F0000000B0C0D0E0F' 0           Z    28930000
         DC        X'101112139D0A0000181992001C1D1E1F' 1                28940000
         DC        X'80818200840A171B00008A0000050607' 2                28950000
         DC        X'0000160094959604000000001415001A' 3                28960000
         DC        X'200000000000000000005B2E3C282B21' 4                28970000
         DC        X'260000000000000000005D242A293B5E' 5                28980000
         DC        X'2D2F00000000000000007C2C255F3E3F' 6                28990000
         DC        X'000000000027606162203A2340273D22' 7                29000000
         DC        X'63414243444546474849646566676869' 8                29010000
         DC        X'6A4A4B4C4D4E4F5051526B6C6D6E6F70' 9                29020000
         DC        X'7100535455565758595A727374757677' A                29030000
         DC        X'78797A7B7C7D7E276061626364656667' B                29040000
         DC        X'2841424344454647484968696A6B6C6D' C                29050000
         DC        X'294A4B4C4D4E4F5051526E6F70717273' D                29060000
         DC        X'5C00535455565758595A747576777879' E                29070000
         DC        X'303132333435363738397A7B7C7D7E7F' F                29080000
*     ASCII TO EBCDIC  TEXT FILE  TABLE                                 29090000
*                     0 1 2 3 4 5 6 7 8 9 A B C D E F                   29100000
ATOE8    DC        X'00010203372D2E2F1605250B0C0D0E0F' 0                29110000
         DC        X'101112133C3D322618193F271C1D1E1F' 1                29120000
         DC        X'404F7F7B5B6C507D4D5D5C4E6B604B61' 2                29130000
         DC        X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 3                29140000
         DC        X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 4                29150000
         DC        X'D7D8D9E2E3E4E5E6E7E8E94AE05A5F6D' 5                29160000
         DC        X'B8B9BABBBCBDBEBFCACBCCCDCECFDADB' 6                29170000
         DC        X'DCDDDEDFEAEBECEDEEEFFAFBFCFDFEFF' 7                29180000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 8                29190000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' 9                29200000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' A                29210000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' B                29220000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' C                29230000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' D                29240000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' E                29250000
         DC        X'3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F3F' F                29260000
*     EBCDIC TO ASCII  TEXT FILE  TABLE                                 29270000
*                     0 1 2 3 4 5 6 7 8 9 A B C D E F                   29280000
ETOA8    DC        X'000102039009867F0000000B0C0D0E0F' 0           Z    29290000
         DC        X'101112139D0A0000181992001C1D1E1F' 1                29300000
         DC        X'80818200840A171B00008A0000050607' 2                29310000
         DC        X'0000160094959604000000001415001A' 3                29320000
         DC        X'200000000000000000005B2E3C282B21' 4                29330000
         DC        X'260000000000000000005D242A293B5E' 5                29340000
         DC        X'2D2F00000000000000007C2C255F3E3F' 6                29350000
         DC        X'000000000027606162203A2340273D22' 7                29360000
         DC        X'63414243444546474849646566676869' 8                29370000
         DC        X'6A4A4B4C4D4E4F5051526B6C6D6E6F70' 9                29380000
         DC        X'7100535455565758595A727374757677' A                29390000
         DC        X'78797A7B7C7D7E276061626364656667' B                29400000
         DC        X'2841424344454647484968696A6B6C6D' C                29410000
         DC        X'294A4B4C4D4E4F5051526E6F70717273' D                29420000
         DC        X'5C00535455565758595A747576777879' E                29430000
         DC        X'303132333435363738397A7B7C7D7E7F' F                29440000
*                                                                       29450000
* TABLE OF ERROR MESSAGES (IN CASE WE ABORT)                            29460000
ERRTAB   DC        CL20'BAD SEND-PACKET SIZE'    ERR MSG #0             29470000
         DC        CL20'BAD MESSAGE NUMBER'      ERR MSG #1             29480000
         DC        CL20'UNRECOGNIZED STATE'      ERR MSG #2             29490000
         DC        CL20'NO SOH ENCOUNTERED'      ERR MSG #3             29500000
         DC        CL20'BAD CHARACTER COUNT'     ERR MSG #4             29510000
         DC        CL20'BAD CHECKSUM'            ERR MSG #5             29520000
         DC        CL20'DISK IS FULL'            ERR MSG #6             29530000
         DC        CL20'ILLEGAL PACKET TYPE'     ERR MSG #7             29540000
         DC        CL20'LOST A PACKET'           ERR MSG #8             29550000
         DC        CL20'MICRO SENT A NAK'        ERR MSG #9             29560000
         DC        CL20'MICRO ABORTED'           ERR MSG #10            29570000
         DC        CL20'ILLEGAL FILE NAME'       ERR MSG #11            29580000
         DC        CL20'INVALID LRECL'           ERR MSG #12            29590000
         DC        CL20'PERMANENT I/O ERROR'     ERR MSG #13            29600000
         DC        CL20'DISK IS READ-ONLY'       ERR MSG #14            29610000
         DC        CL20'RECFM CONFLICT'          ERR MSG #15            29620000
         DC        CL20'ERR ALLOCATING SPACE'    ERR MSG #16            29630000
DATASET CAMLST     NAME,DSNAME,,WRKBUFF                                 29640000
KERIN DCB DDNAME=KERIN,DSORG=PS,MACRF=(GM),                            X29650000
               EODAD=INEOF                                              29660000
KEROUT DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,      X29670000
               RECFM=VB                                                 29680000
DEBUG  DCB DDNAME=DEBUG,DSORG=PS,MACRF=(PM),LRECL=260,BLKSIZE=2048,    X29690000
               RECFM=VB                                                 29700000
MODDCBF DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=80,     X29710000
               RECFM=FB                                                 29720000
MODDCBFL EQU *-MODDCBF                                                  29730000
MODDCBV DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,     X29740000
               RECFM=VB                                                 29750000
MODDCBVL EQU *-MODDCBV                                                  29760000
         END KERMIT                                                     29770003
