KERMIT   TITLE     'KERMIT-IBM'                                         TSO00010
         MACRO                                                          TSO00020
         REGISTER                                                       TSO00030
         LCLA  &N                                                       TSO00040
         SPACE                                                          TSO00050
*********************************************************************** TSO00060
*              GENERAL REGISTER EQUATES                               * TSO00070
*********************************************************************** TSO00080
         SPACE                                                          TSO00090
&N       SETA  0                                                        TSO00100
.LOOP    ANOP                                                           TSO00110
R&N      EQU   &N                                                       TSO00120
         AIF   (&N EQ 15).OUT                                           TSO00130
&N       SETA  &N+1                                                     TSO00140
         AGO   .LOOP                                                    TSO00150
.OUT     ANOP                                                           TSO00160
         SPACE                                                          TSO00170
         MEND                                                           TSO00180
         MACRO                                                          TSO00190
&LABEL   BINCVRT &REG,&AREA,&DBLWRK                                     TSO00200
.*                                                                      TSO00210
.*  CONVERT THE CONTENTS OF &REG TO DECIMAL AND EDIT INTO &AREA.        TSO00220
.*  &AREA IS A FIELD OF LENGTH SIX THAT WILL CONTAIN THE INTEGER        TSO00230
.*  STRING WITH LEADING BLANKS SUPRESSED.  &DBLWRK IS A DOUBLE          TSO00240
.*  WORK SPACE.                                                         TSO00250
.*                                                                      TSO00260
&LABEL   CVD   &REG,&DBLWRK                                             TSO00270
         MVC   &AREA.(6),=X'402020202120'                               TSO00280
         ED    &AREA.(6),&DBLWRK+5                                      TSO00290
         MEND                                                           TSO00300
         MACRO                                                          TSO00310
&LAB     WRTERM &MSG                                                    TSO00320
         LCLC   &MS                                                     TSO00330
         LCLA   &LN                                                     TSO00340
&MS      SETC  '&MSG'                                                   TSO00350
&LN      SETA  K'&MS                                                    TSO00360
&LN      SETA  &LN-2                                                    TSO00370
&LAB     TPUT =C&MS,&LN                                                 TSO00380
         MEND                                                           TSO00390
         MACRO                                                          TSO00400
&LAB     PROMPT &MSG                                                    TSO00410
         LCLC   &MS                                                     TSO00420
         LCLA   &LN                                                     TSO00430
&MS      SETC  '&MSG'                                                   TSO00440
&LN      SETA  K'&MS                                                    TSO00450
&LN      SETA  &LN-2                                                    TSO00460
&LAB     TPUT =C&MS,&LN,ASIS                                            TSO00470
         MEND                                                           TSO00480
         MACRO                                                          TSO00490
         RDTERM &BUFF                                                   TSO00500
         TGET &BUFF,130                                                 TSO00510
         MEND                                                           TSO00520
KERMIT   CSECT                                                          TSO00530
*                                                                       TSO00540
*         ----------------------------------------                      TSO00550
*                                                                       TSO00560
*  KERMIT/TSO   -                                                       TSO00570
*                                                                       TSO00580
*  Kermit - KL10 Error-free Reciprocol Micro Interface Transfer         TSO00590
*  IBM Version 1.0                                                      TSO00600
*                                                                       TSO00610
*  This program is the IBM MVS/TSO side of a file transfer system.      TSO00620
*  It can be used to transfer files between a micro and a system        TSO00630
*  running under MVS/TSO. It MUST be run as a Command Processor.        TSO00640
*  See the KERMIT manual for the complete program specifications        TSO00650
*  to which this program and any other component of the system          TSO00660
*  must adhere.                                                         TSO00670
*                                                                       TSO00680
*  Ronald J. Rusnak, University of Chicago Computation Center           TSO00690
*  BITNET address, SYSRONR at UCHIVM1                                   TSO00700
*  MAILNET address, SYSTEMS.RON@UCHICAGO.MAILNET                        TSO00710
*  ARPA forwarding address, SYSTEMS.RON%UCHICAGO@MIT-MULTICS.ARPA       TSO00720
*  May 1984                                                             TSO00730
*                                                                       TSO00740
*  Developed by the modification of the IBM CMS version written by      TSO00750
*  Daphne Tzoar, Columbia University Center for Computing Activities    TSO00760
*  March 1982                                                           TSO00770
*                                                                       TSO00780
* Copyright (C) 1984 University of Chicago                              TSO00790
*                                                                       TSO00800
* Permission is granted to any individual or institution to copy        TSO00810
* or use this program, except for explicitly commercial purposes.       TSO00820
*                                                                       TSO00830
*                                                                       TSO00840
*        The following external subroutines are required:               TSO00850
*          -DYNALC - MVS dynamic allocation interface.                  TSO00860
*                                                                       TSO00870
*                                                                       TSO00880
*         ----------------------------------------                      TSO00890
*                                                                       TSO00900
* Note that this is an experimental version; all changes should         TSO00910
* be forwarded to the author.                                           TSO00920
*                                                                       TSO00930
         EJECT                                                          TSO00940
* REGISTER USAGE -                                                      TSO00950
* R1 -                                                                  TSO00960
* R2 -                                                                  TSO00970
* R3 -                                                                  TSO00980
* R4 -                                                                  TSO00990
* R5 -                                                                  TSO01000
* R6 -                                                                  TSO01010
* R7 -                                                                  TSO01020
* R8 -                                                                  TSO01030
* R9 -                                                                  TSO01040
* R10 -                                                                 TSO01050
* R11 - BASE REGISTER FOR GLOBAL DATA AREA                              TSO01060
* R12 - PROGRAM BASE                                                    TSO01070
* R13 - SAVE AREA                                                       TSO01080
* R14 - SUBROUTINE LINKAGE                                              TSO01090
* R15 - SUBROUTINE LINKAGE                                              TSO01100
*                                                                       TSO01110
         SPACE                                                          TSO01120
         PRINT     NOGEN                                                TSO01130
         REGISTER                                                       TSO01140
         IKJCPPL                                                        TSO01150
         IKJUPT                                                         TSO01160
         SPACE                                                          TSO01170
AD       EQU       68                  DATA PACKET (ASCII 'D')          TSO01180
AN       EQU       78                  NAK                              TSO01190
AZ       EQU       90                  EOF PACKET                       TSO01200
AS       EQU       83                  INIT PACKET                      TSO01210
AY       EQU       89                  ACK                              TSO01220
AF       EQU       70                  FILE PACKET                      TSO01230
AB       EQU       66                  BREAK PACKET                     TSO01240
AE       EQU       69                  ERROR PACKET                     TSO01250
ERCOD    EQU       12                  MEANS EOF WITH 'FSREAD'          TSO01260
FLG1     EQU       X'80'               IS FILE THE FIRST OR NOT         TSO01270
FLG2     EQU       X'40'               OVERWRITE SENT FILENAME?         TSO01280
FLG3     EQU       X'20'               ONE = SENT ONLY PARTIAL RECORD   TSO01290
FLG4     EQU       X'10'               NAK FROM MICRO(0) OR RPACK(1)?   TSO01300
FLG5     EQU       X'08'               ALLOCATED MORE SPACE (DMSFREE)   TSO01310
         EJECT                                                          TSO01320
         DCBD      DSORG=(PS)                                           TSO01330
         EJECT                                                          TSO01340
**********************************************************************  TSO01350
*                                                                    *  TSO01360
*        KERMIT-TSO PROGRAM                                          *  TSO01370
*                                                                    *  TSO01380
**********************************************************************  TSO01390
KERMIT   CSECT                                                          TSO01400
         STM       R14,R12,12(R13)                                      TSO01410
         BALR      R12,0                                                TSO01420
         USING     *,R12                                                TSO01430
         LA        R14,KSAVE                                            TSO01440
         ST        R13,4(R14)                                           TSO01450
         ST        R14,8(R13)                                           TSO01460
         LR        R13,R14                                              TSO01470
* USE R11 AS BASE REGISTER FOR THE SHARED DATA AREA                     TSO01480
         L         R11,=A(PARMS)                                        TSO01490
         USING     PARMS,R11                                            TSO01500
         TM        0(R1),X'80'     IS THIS A COMMAND PROCESSOR?         TSO01510
         BO        NOTCP           NO, THEN REFUSE USER                 TSO01520
*                                                                       TSO01530
* collect users mvs-tso prefix.                                         TSO01540
*                                                                       TSO01550
         L         R2,CPPLUPT-CPPL(,R1)  GET TO UPT                     TSO01560
         XR        R3,R3                 CLEAR R3                       TSO01570
         IC        R3,UPTPREFL-UPT(,R2)  GET LENGTH                     TSO01580
         BCTR      R3,0                                                 TSO01590
         ST        R3,PREFIXL  SAVE FOR LATER                           TSO01600
         MVC       PREFIX(*-*),UPTPREFX-UPT(R2)  MOVE PREFIX            TSO01610
         EX        R3,*-6                                               TSO01620
         GTSIZE ,                  GET TERMINAL INFO                    TSO01630
         LTR       R0,R0           IS THIS A GRAPHICS DEVICE?           TSO01640
         BNZ       BADDEV          YES, THEN REFUSE USER                TSO01650
         L         R15,=A(INIT)                                         TSO01660
         BALR      R14,R15             CALL THE INITIALIZATION          TSO01670
         WRTERM    'KERMIT-TSO Version 1.00'                            TSO01680
         WRTERM    ' '                                                  TSO01690
**********************************************************************  TSO01700
*                                                                    *  TSO01710
*        MAIN COMMAND PROCESSING ROUTINE                             *  TSO01720
*                                                                    *  TSO01730
**********************************************************************  TSO01740
PROMPT   PROMPT    'KERMIT-TSO> '                                       TSO01750
         RDTERM    INPUT                                                TSO01760
*                                                                       TSO01770
         TR        INPUT,UPPER         UPPERCASE INPUT                  TSO01780
         LA        R1,INPUT            R1 GETS ADDRESS OF STRING        TSO01790
         L         R0,=F'130'          R0 GETS THE LENGTH               TSO01800
         L         R15,=A(PARSER)                                       TSO01810
         BALR      R14,R15             DO TOKENIZING                    TSO01820
*                                                                       TSO01830
         LM        R7,R9,PARSELST      SAVE ADDR OF TOKENIZED LIST      TSO01840
         L         R6,0(,R7)           GET THE PTR TO FIRST OPERAND     TSO01850
NOPRO    MVI       ERRNUM,X'FF'        RESET ERROR FOR THIS TIME        TSO01860
         CLI       0(R6),C' '          BARE CARRIAGE RETURN?            TSO01870
         BE        PROMPT              IGNORE IT                        TSO01880
         CLI       0(R6),C'E'          CHECK FOR 'EXIT' COMMAND         TSO01890
         BE        LEAVE                                                TSO01900
         CLI       0(R6),C'Q'          CHECK FOR 'QUIT' COMMAND         TSO01910
         BE        LEAVE                                                TSO01920
         CLI       0(R6),C'?'          NEED HELP ?                      TSO01930
         BNE       SETCHK                                               TSO01940
         WRTERM    'Legal Commands are: '                               TSO01950
   WRTERM    'Receive, Send, Help, Exit, Quit, Set, Status, Show .'     TSO01960
         B         PROMPT                                               TSO01970
SETCHK   CLC       =C'SET',0(R6)       IS IT THE SET COMMAND ?          TSO01980
         BE        STSWITCH                                             TSO01990
         CLC       =C'ST',0(R6)        IS IT THE STATUS COMMAND?        TSO02000
         BE        STATSW                                               TSO02010
         CLC       =C'SH',0(R6)        IS IT THE SHOW COMMAND?          TSO02020
         BE        SHOSW                                                TSO02030
         CLC       =C'HE',0(R6)        NEED HELP ?                      TSO02040
         BE        HELPSW                                               TSO02050
         OI        FLAGS,FLG1          SET FLG1 - IT'S THE FIRST FILE   TSO02060
         NI        FLAGS,X'FF'-FLG2    TURN OFF OVERWRITE FLAG (INIT)   TSO02070
         CLC       =C'RE',0(R6)                                         TSO02080
         BNE       SS                  MAYBE IT'S A SEND COMMAND        TSO02090
**********************************************************************  TSO02100
*        PROCESS RECEIVE COMMAND                                     *  TSO02110
**********************************************************************  TSO02120
         BXH       R7,R8,RR3           GET NEXT OPERAND                 TSO02130
         L         R6,0(,R7)           GET POINTER TO NEXT OPERAND      TSO02140
         CLI       0(R6),C'?'          NEED HELP?                       TSO02150
         BNE       RR2                                                  TSO02160
         WRTERM    'Specify dsname to be created for RECEIVE.'          TSO02170
         B         PROMPT                                               TSO02180
RR2      CLI       0(R6),C' '          MORE WORDS ?                     TSO02190
         BE        RR3                 NO, THEN PROMPT                  TSO02200
         MVC       DSNAMEX(80),=CL80' ' BLANK DSNAME                    TSO02210
         LA        R1,DSNAMEX          POINT TO DSNAME BUFFER           TSO02220
         LA        R2,44               MAX LENGTH OF DSNAME             TSO02230
         SR        R5,R5               ZERO THE LENGTH                  TSO02240
RR4      CLI       0(R6),C' '          IS THIS END OF FIELD             TSO02250
         BE        RR5                 YES, THEN PROCESS DSNAME         TSO02260
         MVC       0(1,R1),0(R6)       MOVE A CHARACTER                 TSO02270
         LA        R6,1(,R6)           MOVE ALONG INPUT BUFFER          TSO02280
         LA        R1,1(,R1)           MOVE ALONG DSNAME BUFFER         TSO02290
         LA        R5,1(,R5)           UP THE LENGTH COUNT              TSO02300
         BCT       R2,RR4              KEEP LOOKING FOR END             TSO02310
         WRTERM    'Dsname too long'                                    TSO02320
*                                                                       TSO02330
*  allocate a new data set for receive                                  TSO02340
*  dynaloc will not prefix - so we have to do this by hand.             TSO02350
*                                                                       TSO02360
RR3      WRTERM    'Enter data set name for RECEIVE.'                   TSO02370
         MVC       DSNAMEX(80),=CL80' '   BLANK FIELD                   TSO02380
         TGET      DSNAMEX,44           GET DSNAME                      TSO02390
         TR        DSNAMEX(80),UPPER    MAKE UPPER CASE DSN             TSO02400
         LR        R5,R1                  SAVE TGET LENGTH              TSO02410
RR5      LA        R6,DSNAMEX             SOURCE                        TSO02420
         MVC       DSNAME(44),=CL44' ' BLANK FIELD                      TSO02430
         LA        R2,DSNAME           PLACE TO STUFF DSNAME            TSO02440
         CLI       DSNAMEX,C''''       TEST IF QUOTED                   TSO02450
         BE        GBDSNQ1             BR IF SO                         TSO02460
*                                                                       TSO02470
*  we'll prefix the dsname "by hand".                                   TSO02480
*                                                                       TSO02490
         L         R3,PREFIXL          ELSE GET EX LEN                  TSO02500
         MVC       0(*-*,R2),PREFIX    MOVE PREFIX TO BUFFER            TSO02510
         EX        R3,*-6              MOVE IT                          TSO02520
         LA        R2,1(R3,R2)         NEXT POS IN BUFFER               TSO02530
         MVI       0(R2),C'.'          PUT A DOT IN THERE               TSO02540
         LA        R2,1(,R2)           PLACE FOR REST OF DSNAME         TSO02550
         B         GBDSNQ2             CONTINUE                         TSO02560
GBDSNQ1  DS        0H                  X                                TSO02570
         LA        R6,1(,R6)           PAST QUOTE                       TSO02580
         S         R5,=F'2'            REDUCE LENGTH BY 2               TSO02590
*                                                                       TSO02600
*  build the parm list to the MVS dynalc routine.                       TSO02610
*                                                                       TSO02620
GBDSNQ2  DS        0H                                                   TSO02630
         BCTR      R5,0                DEC LEN FOR  EX                  TSO02640
         MVC       0(*-*,R2),0(R6)     COMPLETE DSNAME                  TSO02650
         EX        R5,*-6                                               TSO02660
         MVC       DDNAME(8),=CL8'KEROUT'                               TSO02670
         MVC       DISP1(4),=F'0'      A NEW DATA SET                   TSO02680
         MVC       DISP2(4),=F'1'      CATLG                            TSO02690
         MVC       INOUT(4),=F'1'      OUTPUT                           TSO02700
         MVC       RECFMX(4),=F'1'     FB DATA SET                      TSO02710
         MVC       TRACK(4),=F'5'      5 TRACK ALLOC                    TSO02720
*                                                                       TSO02730
* select a model dcb.  either f or v                                    TSO02740
*                                                                       TSO02750
         MVC       KEROUT(MODDCBFL),MODDCBF                             TSO02760
         CLI       RFM,C'F'           DOES USER WANT FB                 TSO02770
         BE        MAKDCB             YES                               TSO02780
         MVC       KEROUT(MODDCBVL),MODDCBV  USE V MODEL                TSO02790
MAKDCB   DS        0H                                                   TSO02800
*                                                                       TSO02810
* NOW CHECK THE LRECL AND BLKSIZE BEFORE OPEN                           TSO02820
*                                                                       TSO02830
         SR        R1,R1      CLEAR R1                                  TSO02840
         IC        R1,LRECL   GET LRECL                                 TSO02850
         SR        R2,R2               CLEAR R2                         TSO02860
         LH        R3,BLKSIZE GET BLKSIZE                               TSO02870
         CLI       RFM,C'V'            IS THIS VARIABLE                 TSO02880
         BE        CHKFIXD             NO, THEN CHECK AS IF FIXED       TSO02890
         DR        R2,R1               SEE IF BLKSIZE IS A MULTIPLE     TSO02900
         LTR       R2,R2                 OF THE LRECL                   TSO02910
         BNZ       CHKBLKER            YES, THEN SET LRECL AND BLKSIZE  TSO02920
         LH        R3,BLKSIZE          GET BLKSIZE                      TSO02930
         B         SETLB                                                TSO02940
CHKBLKER WRTERM    'BLKSIZE not multiple of LRECL for RECFM=F'          TSO02950
         B         PROMPT                                               TSO02960
CHKFIXD  SH        R3,=H'4'            ADJUST BLKSIZE                   TSO02970
         CR        R1,R3               IS LRECL =< BLKSIZE - 4          TSO02980
         BNH       CHKFIXD2            YES, THEN SET LRECL AND BLKSIZE  TSO02990
         WRTERM    'LRECL not less than BLKSIZE - 4 FOR RECFM=V'        TSO03000
         B         PROMPT                                               TSO03010
CHKFIXD2 AH        R3,=H'4'            READJUST BLKSIZE                 TSO03020
SETLB    DS        0H                                                   TSO03030
         STH       R1,KEROUT+(DCBLRECL-IHADCB) STUFF IN DCB             TSO03040
         STH       R3,KEROUT+(DCBBLKSI-IHADCB)                          TSO03050
         ST        R3,BLKSIZEX             BLKSIZE                      TSO03060
         ST        R1,LRECLX               LRECL                        TSO03070
         LOCATE    DATASET                                              TSO03080
         LTR       R15,R15             DOES DATASET EXIST?              TSO03090
         BNZ       RRALOC              NO, THEN ALLOC A NEW ONE         TSO03100
         PROMPT    'Dataset exists, reply "OK" to overwrite: '          TSO03110
         TGET      WRKBUFF,3                                            TSO03120
         OC        WRKBUFF(3),=CL80' '  UPPER CASE REPLY                TSO03130
         CLC       =C'OK',WRKBUFF                                       TSO03140
         BNE       PROMPT               BR, IF NOT OK                   TSO03150
         MVC       DISP1,=F'1'          MAKE DISP OLD                   TSO03160
         MVC       DISP2,=F'3'          KEEP                            TSO03170
RRALOC   L         R15,=V(DYNALC)      -> ENTRY POINT                   TSO03180
         LA        R1,DYNAPARM         PARMS FOR ALLOC                  TSO03190
         BALR      R14,R15             DO IT                            TSO03200
*                                                                       TSO03210
         ICM       R1,B'1111',DYNALCRC GET RETURN OCDE                  TSO03220
         BNZ       PROMPT              BR IF FAILURE                    TSO03230
*                                                                       TSO03240
* ... then we'll merge in these dcb attributes                          TSO03250
*                                                                       TSO03260
MAKDCBX  DS        0H                                                   TSO03270
         OPEN      (KEROUT,(OUTPUT))                                    TSO03280
         TM        KEROUT+(DCBOFLGS-IHADCB),DCBOFOPN                    TSO03290
         BO        GBOPNA                                               TSO03300
         WRTERM    'Open for dataset failed.'                           TSO03310
         B         PROMPT                                               TSO03320
*                                                                       TSO03330
*  a breeze...                                                          TSO03340
*                                                                       TSO03350
GBOPNA   DS        0H                                                   TSO03360
         WRTERM    'Receive waiting...'                                 TSO03370
         L         R15,=A(RECEIVE)                                      TSO03380
         BALR      R14,R15             CALL RECEIVE PORTION             TSO03390
         LTR       R5,R15              CHECK RETURN CODE                TSO03400
         BNZ       LNON                                                 TSO03410
         MVI       ERRNUM,X'FF'                                         TSO03420
LNON     DS        0H                                                   TSO03430
*                                                                       TSO03440
*  close any open data sets.                                            TSO03450
*                                                                       TSO03460
         CLOSE     (KERIN,,KEROUT)                                      TSO03470
         MVC       OLDERR(1),ERRNUM    ERROR SETTING OF THIS RUN        TSO03480
         LTR       R5,R5               CHECK THE RETCODE                TSO03490
         BZ        PROMPT              ALL OKAY                         TSO03500
         WRTERM    'Error in receiving file. Try again.'                TSO03510
         B         PROMPT              ERROR - TRY AGAIN                TSO03520
SS       CLC       =C'SEN',0(R6)                                        TSO03530
         BNE       ERR                 UNRECOGNIZED COMMAND             TSO03540
**********************************************************************  TSO03550
*        PROCESS SEND COMMAND                                        *  TSO03560
**********************************************************************  TSO03570
         BXH       R7,R8,SS3           NO MORE LEFT                     TSO03580
         L         R6,0(R7)            PICK UP  NEXT OPERAND            TSO03590
         CLI       0(R6),C'?'          NEED HELP?                       TSO03600
         BNE       SS2                                                  TSO03610
         WRTERM    'Specify dataset name.'                 [  ]         TSO03620
         B         PROMPT                                               TSO03630
SS2      CLI       0(R6),C' '          MORE DATA ?                      TSO03640
*                                                                       TSO03650
*  User wants to send a data set - well...                              TSO03660
*                                                                       TSO03670
         BE        SS3                 NO, THEN PROMPT                  TSO03680
         MVC       DSNAMEX(80),=CL80' ' BLANK DSNAME                    TSO03690
         LA        R1,DSNAMEX          POINT TO DSNAME BUFFER           TSO03700
         LA        R2,44               MAX LENGTH OF DSNAME             TSO03710
         SR        R5,R5               CLEAR LENGTH                     TSO03720
SS4      CLI       0(R6),C' '          IS THIS END OF FIELD             TSO03730
         BE        SS5                 YES, THEN PROCESS DSNAME         TSO03740
         MVC       0(1,R1),0(R6)       MOVE A CHARACTER                 TSO03750
         LA        R6,1(,R6)           MOVE ALONG INPUT BUFFER          TSO03760
         LA        R1,1(,R1)           MOVE ALONG DSNAME BUFFER         TSO03770
         LA        R5,1(,R5)           UP THE LENGTH COUNT              TSO03780
         BCT       R2,SS4              KEEP LOOKING FOR END             TSO03790
         WRTERM    'Dsname too long'                                    TSO03800
         B         PROMPT                                               TSO03810
SS3      WRTERM    'Enter dataset name to send.'                        TSO03820
         MVC       DSNAMEX(80),=CL80' '   BLANK FIELD                   TSO03830
         TGET      DSNAMEX,44           GET DSNAME                      TSO03840
         TR        DSNAMEX(80),UPPER    MAKE UPPER CASE DSN             TSO03850
         LR        R5,R1                  SAVE TGET LENGTH              TSO03860
SS5      LA        R6,DSNAMEX             SOURCE                        TSO03870
         MVC       DSNAME(44),=CL44' ' BLANK FIELD                      TSO03880
         LA        R2,DSNAME           PLACE TO STUFF DSNAME            TSO03890
         CLI       DSNAMEX,C''''       TEST IF QUOTED                   TSO03900
         BE        GBDSNQ3             BR IF SO                         TSO03910
*                                                                       TSO03920
*  user tests if i know how to prefix a dsname.                         TSO03930
*                                                                       TSO03940
         L         R3,PREFIXL          ELSE GET EX LEN                  TSO03950
         MVC       0(*-*,R2),PREFIX    MOVE PREFIX TO BUFFER            TSO03960
         EX        R3,*-6              MOVE IT                          TSO03970
         LA        R2,1(R3,R2)         NEXT POS IN BUFFER               TSO03980
         MVI       0(R2),C'.'          PUT A DOT IN THERE               TSO03990
         LA        R2,1(,R2)           PLACE FOR REST OF DSNAME         TSO04000
         B         GBDSNQ4             CONTINUE                         TSO04010
GBDSNQ3  DS        0H                  X                                TSO04020
         LA        R6,1(,R6)           PAST QUOTE                       TSO04030
         S         R5,=F'2'            REDUCE LENGTH BY 2               TSO04040
*                                                                       TSO04050
*  build a "control block"                                              TSO04060
*                                                                       TSO04070
GBDSNQ4  DS        0H                                                   TSO04080
         BCTR      R5,0                DEC LEN FOR  EX                  TSO04090
         MVC       0(*-*,R2),0(R6)     COMPLETE DSNAME                  TSO04100
         EX        R5,*-6                                               TSO04110
         LA        R5,DSNAME+43        POINT TO END OF DSNAME           TSO04120
         LA        R4,44               LENGTH OF DSNAME                 TSO04130
SSFINDL1 CLI       0(R5),C' '          IS IT BLANK?                     TSO04140
         BNE       SSFINDL2            NO, THEN FOUND END OF DSN        TSO04150
         BCTR      R5,0                DECREMENT PTR                    TSO04160
         BCT       R4,SSFINDL1         LOOP TILL FOUND                  TSO04170
         WRTERM    'Dsname cannot be entirely blank'                    TSO04180
         B         PROMPT                                               TSO04190
SSFINDL2 LR        R3,R5               REMEMBER END OF DSN              TSO04200
         LA        R2,2                TRY TO FIND 2 LEVELS             TSO04210
SSFINDL3 CLI       0(R5),C'.'          IS IT A DOT?                     TSO04220
         BE        SSFINDL4            YES, THEN HANDLE IT              TSO04230
SSFINDL5 BCTR      R5,0                DECREMENT PTR                    TSO04240
         BCT       R4,SSFINDL3         LOOP TILL FOUND                  TSO04250
         B         SSFINDE             BR IF FRONT OF DSN               TSO04260
SSFINDL4 BCT       R2,SSFINDL5         FIND ANOTHER LEVEL               TSO04270
SSFINDE  MVC       FILNAM,=CL80' '     BLANK FILNAM                     TSO04280
         LA        R5,1(,R5)           MOVE TO FRONT OF LEVEL           TSO04290
         SR        R3,R5               FIND LENGTH TO MOVE              TSO04300
         CH        R3,=H'17'           TRUNC IF TOO LONG                TSO04310
         BNH       *+8                 NOT TOO LONG                     TSO04320
         LA        R3,=H'17'           FORCE MAX LENGTH                 TSO04330
         MVC       FILNAM(*-*),0(R5)   MOVE INSTRUCTION FOR EXECUTE     TSO04340
         EX        R3,*-6              GO MOVE THE DATA                 TSO04350
         STH   R3,FILNAML          SAVE LENGTH - 1                      TSO04360
         MVC       DDNAME(8),=CL8'KERIN'                                TSO04370
         MVC       DISP1(4),=F'2'    DISP=SHR                           TSO04380
         MVC       DISP2(4),=F'3'    KEEP                               TSO04390
         MVC       INOUT(4),=F'0'  INPUT                                TSO04400
         LA        R1,DYNAPARM                                          TSO04410
         L         R15,=V(DYNALC)    GET EMTRY POINT                    TSO04420
         BALR      R14,R15           DO IT                              TSO04430
         ICM       R1,B'1111',DYNALCRC GET RETURN CODE                  TSO04440
         BNZ       PROMPT                                               TSO04450
*                                                                       TSO04460
*  open the users data set                                              TSO04470
*                                                                       TSO04480
         OPEN      (KERIN,(INPUT))                                      TSO04490
         TM        KERIN+(DCBOFLGS-IHADCB),DCBOFOPN                     TSO04500
         BO        GBOPNB                                               TSO04510
         WRTERM    'Open for dataset failed.'                           TSO04520
         B         PROMPT                                               TSO04530
GBOPNB   DS        0H                                                   TSO04540
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECV IS RECFM=V           TSO04550
         BO        SSDELAY         YES, THEN WAIT                       TSO04560
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECF IS RECFM=F           TSO04570
         BO        SSDELAY         YES, THEN WAIT                       TSO04580
         WRTERM    'Invalid RECFM, only fixed and variable supported'   TSO04590
         CLOSE     KERIN                                                TSO04600
         B         PROMPT                                               TSO04610
SSDELAY  DS        0H                                                   TSO04620
         MVC  WRKBUFF(37),=C'Waiting ..... seconds before sending.'     TSO04630
         L         R1,DELAY                                             TSO04640
         SR        R0,R0                                                TSO04650
         D         R0,=F'100'                                           TSO04660
         BINCVRT   R1,WRKBUFF+7,DBLWRK                                  TSO04670
         TPUT      WRKBUFF,37                                           TSO04680
         STIMER    WAIT,BINTVL=DELAY                                    TSO04690
         B         SSWITCH                                              TSO04700
ERR      WRTERM    'Invalid command'                                    TSO04710
         B         PROMPT              INVALID COMMAND - TRY AGAIN      TSO04720
         SPACE     3                                                    TSO04730
SSWITCH  EQU       *                                                    TSO04740
         L         R15,=A(SEND)                                         TSO04750
         BALR      R14,R15             CALL SEND PORTION                TSO04760
         LTR       R5,R15              CHECK RETURN CODE                TSO04770
         BNZ       LINON                                                TSO04780
         MVI       ERRNUM,X'FF'        WORKED OK                        TSO04790
LINON    DS        0H                                                   TSO04800
*                                                                       TSO04810
*  close any open data sets.                                            TSO04820
*                                                                       TSO04830
         CLOSE     (KERIN,,KEROUT)                                      TSO04840
         MVC       OLDERR(1),ERRNUM    ERROR SETTING OF THIS RUN        TSO04850
         LTR       R5,R5               CHECK THE RETCODE                TSO04860
         BZ        PROMPT              ALL OKAY                         TSO04870
         WRTERM    'Error in sending file. Try again.'                  TSO04880
         B         PROMPT              ERROR - TRY AGAIN                TSO04890
**********************************************************************  TSO04900
*        PROCESS SET COMMAND                                         *  TSO04910
**********************************************************************  TSO04920
STSWITCH EQU       *                                                    TSO04930
         L         R15,=A(SET)                                          TSO04940
         BALR      R14,R15             CALL "SET" SUBROUTINE            TSO04950
         LTR       R15,R15             CHECK RETCODE                    TSO04960
         BZ        PROMPT                                               TSO04970
         WRTERM    'Illegal Set Command'                                TSO04980
         B         PROMPT                                               TSO04990
**********************************************************************  TSO05000
*        PROCESS SHOW COMMAND                                        *  TSO05010
**********************************************************************  TSO05020
SHOSW    EQU       *                                                    TSO05030
         L         R15,=A(SHOW)                                         TSO05040
         BALR      R14,R15             CALL "SHOW" SUBROUTINE           TSO05050
         LTR       R15,R15             CHECK RETCODE                    TSO05060
         BZ        PROMPT                                               TSO05070
         WRTERM    'Illegal Show Command'                               TSO05080
         B         PROMPT                                               TSO05090
**********************************************************************  TSO05100
*        PROCESS STATUS COMMAND                                      *  TSO05110
**********************************************************************  TSO05120
STATSW   EQU       *                                                    TSO05130
         BXH       R7,R8,GIVSTAT       NO MORE LEFT                     TSO05140
         L         R6,0(R7)            PICK UP  NEXT OPERAND            TSO05150
         CLI       0(R6),C'?'          NEED HELP?                       TSO05160
         BNE       GIVSTAT                                              TSO05170
         WRTERM    'Confirm with a carriage return'                     TSO05180
         B         PROMPT                                               TSO05190
GIVSTAT  CLI       OLDERR,X'FF'        WAS THERE AN ERROR LAST TIME?    TSO05200
         BNE       FAIL                                                 TSO05210
         WRTERM    'Kermit completed successfully'                      TSO05220
         B         PROMPT                                               TSO05230
FAIL     SR        R5,R5                                                TSO05240
         IC        R5,OLDERR           GET OFFSET INTO ERROR TABLE      TSO05250
         M         R4,=F'20'           OFFSET := ERRNUM * 20            TSO05260
         LA        R5,ERRTAB(R5)                                        TSO05270
*G       WRTERM    (R5),20             PRINT ERROR MSG ON SCREEN        TSO05280
         TPUT      (R5),20                                              TSO05290
         B         PROMPT              AND LEAVE                        TSO05300
**********************************************************************  TSO05310
*        PROCESS HELP COMMAND                                        *  TSO05320
**********************************************************************  TSO05330
HELPSW   BXH       R7,R8,GIVHLP        NO MORE LEFT                     TSO05340
         L         R6,0(R7)            PICK UP  NEXT OPERAND            TSO05350
         CLI       0(R6),C'?'          NEED HELP?                       TSO05360
         BNE       GIVHLP                                               TSO05370
         WRTERM    'Confirm with a carriage return'                     TSO05380
         B         PROMPT                                               TSO05390
GIVHLP   DS        0H                                                   TSO05400
         WRTERM    'Enter ? at prompt to receive list of commands.'     TSO05410
         WRTERM  'Enter ? after a command to receive list of operands'  TSO05420
         B         PROMPT                                               TSO05430
**********************************************************************  TSO05440
*        PROCESS EXIT COMMAND                                        *  TSO05450
**********************************************************************  TSO05460
LEAVE    BXH       R7,R8,KRET        ANY MORE OPERANDS?                 TSO05470
         L         R6,0(,R7)           GET ADDRESS OF OPERAND           TSO05480
         CLI       0(R6),C'?'          NEED HELP?                       TSO05490
         BNE       KRET                NO, JUST LEAVE                   TSO05500
         WRTERM    'Confirm with a carriage return'                     TSO05510
         B         PROMPT                                               TSO05520
BADDEV   WRTERM    'An Ascii terminal must be used.'                    TSO05530
         B         RET                                                  TSO05540
NOTCP    WRTERM    'KERMIT-TSO must be running as a command processor'  TSO05550
         WRTERM    'Contact your local systems programmer'              TSO05560
         B         RET                                                  TSO05570
KRET     EQU       *                                                    TSO05580
RET      EQU       *                                                    TSO05590
*                                                                       TSO05600
*  close any open data sets.                                            TSO05610
*  dynalc has a free=close so.....                                      TSO05620
*                                                                       TSO05630
         TM        KERIN+(DCBOFLGS-IHADCB),DCBOFOPN                     TSO05640
         BNO       RETGB1                                               TSO05650
         CLOSE     KERIN                                                TSO05660
RETGB1   DS        0H                                                   TSO05670
         TM        KEROUT+(DCBOFLGS-IHADCB),DCBOFOPN                    TSO05680
         BNO       RETGB2                                               TSO05690
         CLOSE     KEROUT                                               TSO05700
RETGB2   DS        0H                                                   TSO05710
         CLOSE     DEBUG                                                TSO05720
         L         R13,4(R13)                                           TSO05730
         L         R14,12(R13)                                          TSO05740
         LM        R0,R12,20(R13)                                       TSO05750
         BR        R14                                                  TSO05760
KSAVE    DS        18F                 KERMIT'S SAVE AREA               TSO05770
         LTORG                                                          TSO05780
         DROP      R11                                                  TSO05790
         DROP      R12                 NO LONGER NEED THEM              TSO05800
         EJECT                                                          TSO05810
**********************************************************************  TSO05820
*                                                                    *  TSO05830
*        ROUTINE TO PROCESS SET COMMAND                              *  TSO05840
*                                                                    *  TSO05850
**********************************************************************  TSO05860
SET      DS        0H                                                   TSO05870
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          TSO05880
         BALR      R12,0               ESTABLISH ADDRESSABILITY         TSO05890
         USING     *,R12                                                TSO05900
         LA        R14,SETSAVE         ADDRESS OF MY SAVE AREA          TSO05910
         ST        R13,4(R14)          SAVE CALLER'S                    TSO05920
         ST        R14,8(R13)                                           TSO05930
         LR        R13,R14                                              TSO05940
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 TSO05950
         L         R11,=A(PARMS)                                        TSO05960
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         TSO05970
         BXH       R7,R8,SETHLP                                         TSO05980
         L         R6,0(R7)            PICK UP NEXT OPERAND             TSO05990
         CLI       0(R6),C'?'          NEED HELP ?                      TSO06000
         BNE       NOQ                                                  TSO06010
SETHLP   WRTERM    'Blksize, Debug, Delay, End-of-line, Lrecl,'         TSO06020
         WRTERM    'Quote, Packet-size, Recfm, Space, Start-of-line'    TSO06030
         B         SETOK                                                TSO06040
**********************************************************************  TSO06050
*                           SET RECFM                                *  TSO06060
**********************************************************************  TSO06070
NOQ      CLC       =C'RE',0(R6)                                         TSO06080
         BNE       NOREC                                                TSO06090
         BXH       R7,R8,SETNFM        MORE OPERANDS?                   TSO06100
         L         R6,0(R7)            PICK UP RECORD FORMAT            TSO06110
         CLI       0(R6),C'?'                                           TSO06120
         BNE       CHKFM                                                TSO06130
         WRTERM    'f or v (default of v)'                              TSO06140
         B         SETOK                                                TSO06150
CHKFM    CLI       0(R6),C'V'          REDUNDANT                        TSO06160
         BE        FMSET                                                TSO06170
         CLI       0(R6),C'F'          FIXED FORMAT?                    TSO06180
         BNE       RECERR                                               TSO06190
FMSET    MVC       RFM(1),0(R6)        PICK UP RECFM                    TSO06200
         B         SETOK                                                TSO06210
RECERR   WRTERM    'Fixed and variable files only'                      TSO06220
         B         SETERR                                               TSO06230
**********************************************************************  TSO06240
*                         SET QUOTE                                  *  TSO06250
**********************************************************************  TSO06260
NOREC    CLC       =C'QU',0(R6)        QUOTE CHARACTER                  TSO06270
         BNE       NOQUO                                                TSO06280
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO06290
         L         R6,0(R7)            GET NEXT TOKEN                   TSO06300
         CLI       0(R6),C' '          VALUE NOT SUPPLIED?              TSO06310
         BNE       GIVQ                                                 TSO06320
SETNFM   WRTERM    '?NOT CONFIRMED'                                     TSO06330
         B         SETERR                                               TSO06340
GIVQ     CLC       =C'? ',0(R6)                                         TSO06350
         BNE       GETQUO                                               TSO06360
         WRTERM    'a single character'                                 TSO06370
         B         SETOK                                                TSO06380
GETQUO   MVC       QUOCHAR(1),0(R6)    SET NEW QUOTE CHAR               TSO06390
         TR        QUOCHAR(1),ETOA     GET ASCII FORM                   TSO06400
         CLI       1(R6),C' '          IS IT ONLY ONE CHAR?             TSO06410
         BE        ISQOK                                                TSO06420
         WRTERM    'one character only'                                 TSO06430
         B         BADQUO                                               TSO06440
ISQOK    CLI       QUOCHAR,X'21'       CAN'T BE LESS THAN 32            TSO06450
         BL        BADQUO                                               TSO06460
         CLI       QUOCHAR,X'7E'       CAN'T BE LARGER THAN 126         TSO06470
         BH        BADQUO                                               TSO06480
         CLI       QUOCHAR,X'3E'       HAS TO BE BETWEEN 32-62          TSO06490
         BNH       SETOK                                                TSO06500
         CLI       QUOCHAR,X'60'       OR BETWEEN 96-126                TSO06510
         BNL       SETOK                                                TSO06520
BADQUO   WRTERM    'Must fall between 41-76,140,or 173-176 (octal).'    TSO06530
         MVC       QUOCHAR(1),DQUOTE   RESET VALUE, JUST IN CASE        TSO06540
         B         SETERR                                               TSO06550
**********************************************************************  TSO06560
*                         SET LRECL                                  *  TSO06570
**********************************************************************  TSO06580
NOQUO    CLC       =C'LR',0(R6)        LRECL SIZE                       TSO06590
         BNE       SETBLK                                               TSO06600
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO06610
         L         R6,0(R7)            GET NEXT TOKEN                   TSO06620
         CLI       0(R6),C'?'          HELP ?                           TSO06630
         BNE       GETREC                                               TSO06640
         WRTERM    'Logical Record Length (default of 80).'             TSO06650
         B         SETOK                                                TSO06660
GETREC   CLI       0(R6),C' '          NO VALUE GIVEN                   TSO06670
         BNE       CALC                                                 TSO06680
         WRTERM    '?not confirmed'                                     TSO06690
         B         SETERR                                               TSO06700
CALC     CLI       0(R6),X'F0'         MUST BE >= TO 0                  TSO06710
         BL        BADREC                                               TSO06720
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  TSO06730
         BH        BADREC                                               TSO06740
         XC        PKVAR,PKVAR         EMPTY IT OUT                     TSO06750
         SR        R4,R4               LENGTH OF NUMBER                 TSO06760
         CLI       1(R6),C' '          TWO DIGITS?                      TSO06770
         BNE       CALC2                                                TSO06780
         EX        R4,PCK                                               TSO06790
         B         TST                                                  TSO06800
CALC2    LA        R4,1(R4)            ADD ONE                          TSO06810
         CLI       2(R6),C' '          THREE DIGITS?                    TSO06820
         BNE       CALC3                                                TSO06830
         EX        R4,PCK                                               TSO06840
         B         TST                                                  TSO06850
CALC3    LA        R4,1(R4)            IS THERE AN ERROR?               TSO06860
         CLI       3(R6),C' '                                           TSO06870
         BNE       BADREC                                               TSO06880
         EX        R4,PCK                                               TSO06890
TST      CVB       R7,PKVAR                                             TSO06900
         C         R7,=F'255'          MAX OF 255 FOR LRECL             TSO06910
         BH        BADREC                                               TSO06920
         STC       R7,LRECL            SET THE LRECL VALUE              TSO06930
         B         SETOK                                                TSO06940
BADREC   WRTERM    'A number with a maximum of 255.'                    TSO06950
         B         SETERR                                               TSO06960
**********************************************************************  TSO06970
*                         SET BLKSIZE                                *  TSO06980
**********************************************************************  TSO06990
SETBLK   CLC       =C'BL',0(R6)        BLOCK SIZE                       TSO07000
         BNE       SETSPACE                                             TSO07010
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO07020
         L         R6,0(R7)            GET NEXT TOKEN                   TSO07030
         CLI       0(R6),C'?'          HELP ?                           TSO07040
         BNE       GETBLK                                               TSO07050
         WRTERM    'Blocksize (default of 80).'                         TSO07060
         B         SETOK                                                TSO07070
GETBLK   CLI       0(R6),C' '          NO VALUE GIVEN                   TSO07080
         BNE       BLKCALC                                              TSO07090
         WRTERM    '?not confirmed'                                     TSO07100
         B         SETERR                                               TSO07110
BLKCALC  XC        PKVAR,PKVAR         EMPTY IT OUT                     TSO07120
         SR        R4,R4               LENGTH OF NUMBER                 TSO07130
         LA        R7,5                MAX LENGTH OF NUMBER             TSO07140
         LR        R5,R6               SAVE START OF STRING             TSO07150
BLKCALC1 CLI       0(R6),X'F0'         MUST BE >= TO 0                  TSO07160
         BL        BADBLK                                               TSO07170
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  TSO07180
         BH        BADBLK                                               TSO07190
         CLI       1(R6),C' '          FOUND LAST DIGIT?                TSO07200
         BE        BLKCALC2                                             TSO07210
         LA        R4,1(R4)            COUNT NUMBER OF DIGITS           TSO07220
         LA        R6,1(R6)            POINT TO NEXT DIGIT              TSO07230
         BCT       R7,BLKCALC1         KEEP CHECKING                    TSO07240
         B         BADBLK                                               TSO07250
BLKCALC2 EX        R4,BLKPCK                                            TSO07260
         B         BLKTST                                               TSO07270
BLKTST   CVB       R7,PKVAR                                             TSO07280
         C         R7,=F'32767'        MAX OF 32767 FOR BLKSIZE         TSO07290
         BH        BADBLK                                               TSO07300
         STH       R7,BLKSIZE          SET THE BLKSIZE                  TSO07310
         B         SETOK                                                TSO07320
BADBLK   WRTERM    'A number with a maximum of 32767'                   TSO07330
         B         SETERR                                               TSO07340
**********************************************************************  TSO07350
*                         SET TRACK ALLOCATION                       *  TSO07360
**********************************************************************  TSO07370
SETSPACE CLC       =C'SP',0(R6)        BLOCK SIZE                       TSO07380
         BNE       SETEOL                                               TSO07390
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO07400
         L         R6,0(R7)            GET NEXT TOKEN                   TSO07410
         CLI       0(R6),C'?'          HELP ?                           TSO07420
         BNE       GETSPC                                               TSO07430
         WRTERM    'Dataset space allocation (default of 5 tracks).'    TSO07440
         B         SETOK                                                TSO07450
GETSPC   CLI       0(R6),C' '          NO VALUE GIVEN                   TSO07460
         BNE       SPCCALC                                              TSO07470
         WRTERM    '?not confirmed'                                     TSO07480
         B         SETERR                                               TSO07490
SPCCALC  XC        PKVAR,PKVAR         EMPTY IT OUT                     TSO07500
         SR        R4,R4               LENGTH OF NUMBER                 TSO07510
         LA        R7,5                MAX LENGTH OF NUMBER             TSO07520
         LR        R5,R6               SAVE START OF STRING             TSO07530
SPCCALC1 CLI       0(R6),X'F0'         MUST BE >= TO 0                  TSO07540
         BL        BADSPC                                               TSO07550
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  TSO07560
         BH        BADSPC                                               TSO07570
         CLI       1(R6),C' '          FOUND LAST DIGIT?                TSO07580
         BE        SPCCALC2                                             TSO07590
         LA        R4,1(R4)            COUNT NUMBER OF DIGITS           TSO07600
         LA        R6,1(R6)            POINT TO NEXT DIGIT              TSO07610
         BCT       R7,SPCCALC1         KEEP CHECKING                    TSO07620
         B         BADSPC                                               TSO07630
SPCCALC2 EX        R4,SPCPCK                                            TSO07640
         B         SPCTST                                               TSO07650
SPCTST   CVB       R7,PKVAR                                             TSO07660
         C         R7,=F'99999'        MAX OF 99999 FOR SPACE           TSO07670
         BH        BADSPC                                               TSO07680
         ST        R7,TRACK            SET THE ALLOCATION               TSO07690
         B         SETOK                                                TSO07700
BADSPC   WRTERM    'A number with a maximum of 99999'                   TSO07710
         B         SETERR                                               TSO07720
**********************************************************************  TSO07730
*                         SET END-OF-LINE CHARACTER                  *  TSO07740
**********************************************************************  TSO07750
SETEOL   CLC       =C'EN',0(R6)        EOL CHARACTER                    TSO07760
         BNE       NOEND                                                TSO07770
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO07780
         L         R6,0(R7)            GET NEXT TOKEN                   TSO07790
         CLI       0(R6),C' '          NOT DATA                         TSO07800
         BNE       EOLCHAR                                              TSO07810
         WRTERM    '?not confirmed'                                     TSO07820
         B         SETERR                                               TSO07830
EOLCHAR  CLI       0(R6),C'?'          NEED HELP?                       TSO07840
         BNE       GETEOL                                               TSO07850
         WRTERM    'A two digit number between 00 and 31 (dec).'        TSO07860
         B         SETOK                                                TSO07870
GETEOL   CLI       0(R6),X'F0'         MUST BE >= TO 0                  TSO07880
         BL        BADEOL                                               TSO07890
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  TSO07900
         BH        BADEOL                                               TSO07910
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE             TSO07920
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS          TSO07930
         BE        BADEOL                                               TSO07940
         CLI       2(R6),C' '          TWO CHARS, AT MAX                TSO07950
         BNE       BADEOL                                               TSO07960
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARACTERS           TSO07970
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG      TSO07980
         C         R7,=F'31'           MAX OF 31 DECIMAL                TSO07990
         BH        BADEOL                                               TSO08000
         STC       R7,SEOL             SET SEND EOL VALUE               TSO08010
         B         SETOK                                                TSO08020
BADEOL   WRTERM    'Must be a two digit value less than 31 (dec).'      TSO08030
         B         SETERR                                               TSO08040
**********************************************************************  TSO08050
*                         SET PACKET-SIZE                            *  TSO08060
**********************************************************************  TSO08070
NOEND    CLC       =C'PA',0(R6)        CHANGE RECEIVE PACKET SIZE       TSO08080
         BNE       NOPAC                                                TSO08090
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO08100
         L         R6,0(R7)            GET NEXT TOKEN                   TSO08110
         CLI       0(R6),C' '          NO DATA                          TSO08120
         BNE       GETPAC                                               TSO08130
         WRTERM    '?not confirmed'                                     TSO08140
         B         SETERR                                               TSO08150
GETPAC   CLI       0(R6),C'?'          NEED HELP?                       TSO08160
         BNE       CALC4                                                TSO08170
         WRTERM    'Receive packet size (range: 26-94 decimal).'        TSO08180
         B         SETOK                                                TSO08190
CALC4    CLI       0(R6),X'F0'         MUST BE >= TO 0                  TSO08200
         BL        BADPAC                                               TSO08210
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  TSO08220
         BH        BADPAC                                               TSO08230
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE             TSO08240
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS          TSO08250
         BE        BADPAC                                               TSO08260
         CLI       2(R6),C' '          TWO CHARS, AT MAX                TSO08270
         BNE       BADPAC                                               TSO08280
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARS                TSO08290
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG      TSO08300
         C         R7,=F'26'           THIS IS MIN                      TSO08310
         BL        BADPAC                                               TSO08320
         C         R7,MAXPACK          THIS IS THE MAX                  TSO08330
         BH        BADPAC                                               TSO08340
         ST        R7,RPSIZ            USE THIS VALUE NOW               TSO08350
         B         SETOK                                                TSO08360
BADPAC   WRTERM    'Must be between 26-94 (decimal).'                   TSO08370
         B         SETERR                                               TSO08380
**********************************************************************  TSO08390
*                         SET DEBUG ON|OFF                           *  TSO08400
**********************************************************************  TSO08410
NOPAC    CLC       =C'DEB',0(R6)      IS THIS DEBUG?                    TSO08420
         BNE       SETSOH              NO, THEN SEE IF SET SOH          TSO08430
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO08440
         L         R6,0(R7)            GET NEXT TOKEN                   TSO08450
         CLI       0(R6),C' '          IS THERE AN OPERAND?             TSO08460
         BE        DEBERR              NO, THEN ASK FOR ONE.            TSO08470
         CLC       =C'ON',0(R6)        IS IT TIME TO TURN ON            TSO08480
         BE        DEBON               YES, OPEN FILE                   TSO08490
         CLC       =C'OF',0(R6)       IS IT TIME TO TURN OFF            TSO08500
         BE        DEBOFF              YES, CLOSE FILE                  TSO08510
         B         DEBERR              YES, GIVE MESSAGE                TSO08520
DEBERR   WRTERM    'Command is SET DEBUG ON | OFF'                      TSO08530
         B         SETERR                                               TSO08540
DEBON    OPEN      (DEBUG,(OUTPUT))                                     TSO08550
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        TSO08560
         BO        SETOK                                                TSO08570
         WRTERM    'Unable to open debug file, debug disabled.'         TSO08580
         B         SETERR                                               TSO08590
DEBOFF   CLOSE     DEBUG                                                TSO08600
         B         SETOK                                                TSO08610
**********************************************************************  TSO08620
*                         SET START-OF-HEADER CHARACTER              *  TSO08630
**********************************************************************  TSO08640
SETSOH   CLC       =C'ST',0(R6)       SOH CHARACTER                     TSO08650
         BNE       NOSOH               NO, THEN TRY DELAY               TSO08660
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO08670
         L         R6,0(R7)            GET NEXT TOKEN                   TSO08680
         CLI       0(R6),C' '          NOT DATA                         TSO08690
         BNE       SOHCHAR                                              TSO08700
         WRTERM    '?not confirmed'                                     TSO08710
         B         SETERR                                               TSO08720
SOHCHAR  CLI       0(R6),C'?'          NEED HELP?                       TSO08730
         BNE       GETSOH                                               TSO08740
         WRTERM    'A two digit number between 00 and 31 (dec).'        TSO08750
         B         SETOK                                                TSO08760
GETSOH   CLI       0(R6),X'F0'         MUST BE >= TO 0                  TSO08770
         BL        BADSOH                                               TSO08780
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  TSO08790
         BH        BADSOH                                               TSO08800
         XC        PKVAR,PKVAR         USE TO CONVERT VALUE             TSO08810
         CLI       1(R6),C' '          INPUT MUST BE TWO CHARS          TSO08820
         BE        BADSOH                                               TSO08830
         CLI       2(R6),C' '          TWO CHARS, AT MAX                TSO08840
         BNE       BADSOH                                               TSO08850
         PACK      PKVAR(8),0(2,R6)    PICK UP TWO CHARACTERS           TSO08860
         CVB       R7,PKVAR            PUT PACKED DECIMAL INTO REG      TSO08870
         C         R7,=F'31'           MAX OF 31 DECIMAL                TSO08880
         BH        BADSOH              ERROR, TOO BIG                   TSO08890
         STC       R7,SSOH             SET SEND SOH VALUE               TSO08900
         STC       R7,RSOH             SET RECEIVE SOH VALUE            TSO08910
         B         SETOK                                                TSO08920
BADSOH   WRTERM    'Must be a two digit value less than 31 (dec).'      TSO08930
         B         SETERR                                               TSO08940
**********************************************************************  TSO08950
*                      SET DELAY VALUE                               *  TSO08960
**********************************************************************  TSO08970
NOSOH    CLC       =C'DEL',0(R6)       CHANGE RECEIVE PACKET SIZE       TSO08980
         BNE       SETERR                                               TSO08990
         BXH       R7,R8,SETNFM        ANY MORE OPERANDS                TSO09000
         L         R6,0(R7)            GET NEXT TOKEN                   TSO09010
         CLI       0(R6),C' '          NO DATA                          TSO09020
         BNE       GETDELAY                                             TSO09030
         WRTERM    '?not confirmed'                                     TSO09040
         B         SETERR                                               TSO09050
GETDELAY CLI       0(R6),C'?'          NEED HELP?                       TSO09060
         BNE       DLYCALC                                              TSO09070
         WRTERM    'Receive packet size (range: 26-94 decimal).'        TSO09080
         B         SETOK                                                TSO09090
DLYCALC  XC        PKVAR,PKVAR         EMPTY IT OUT                     TSO09100
         SR        R4,R4               LENGTH OF NUMBER                 TSO09110
         LA        R7,5                MAX LENGTH OF NUMBER             TSO09120
         LR        R5,R6               SAVE START OF STRING             TSO09130
DLYCALC1 CLI       0(R6),X'F0'         MUST BE >= TO 0                  TSO09140
         BL        BADDELAY                                             TSO09150
         CLI       0(R6),X'F9'         MUST BE <= TO 9                  TSO09160
         BH        BADDELAY                                             TSO09170
         CLI       1(R6),C' '          FOUND LAST DIGIT?                TSO09180
         BE        DLYCALC2                                             TSO09190
         LA        R4,1(R4)            COUNT NUMBER OF DIGITS           TSO09200
         LA        R6,1(R6)            POINT TO NEXT DIGIT              TSO09210
         BCT       R7,DLYCALC1         KEEP CHECKING                    TSO09220
         B         BADDELAY                                             TSO09230
DLYCALC2 EX        R4,DLYPCK                                            TSO09240
         B         DLYTST                                               TSO09250
DLYTST   CVB       R7,PKVAR                                             TSO09260
         LTR       R7,R7               THIS IS MIN                      TSO09270
         BNP       BADDELAY                                             TSO09280
         C         R7,=F'99999'        THIS IS THE MAX                  TSO09290
         BH        BADDELAY                                             TSO09300
         MH        R7,=H'100'          MAKE IT 100THS OF SECONDS        TSO09310
         ST        R7,DELAY            USE THIS VALUE NOW               TSO09320
         B         SETOK                                                TSO09330
BADDELAY WRTERM    'Must be between 1-99999 (DECIMAL).'                 TSO09340
         B         SETERR                                               TSO09350
SETERR   LA        R15,4               SET A NON-ZERO RETCODE           TSO09360
         B         SETRET                                               TSO09370
SETOK    SR        R15,R15             RETCODE OF 0                     TSO09380
*                                                                       TSO09390
SETRET   L         R13,4(R13)                                           TSO09400
         L         R14,12(R13)                                          TSO09410
         LM        R0,R12,20(R13)                                       TSO09420
         BR        R14                                                  TSO09430
SETSAVE  DS        18F                                                  TSO09440
PCK      PACK      PKVAR(8),0(0,R6)                                     TSO09450
BLKPCK   PACK      PKVAR(8),0(0,R5)                                     TSO09460
SPCPCK   PACK      PKVAR(8),0(0,R5)                                     TSO09470
DLYPCK   PACK      PKVAR(8),0(0,R5)                                     TSO09480
         LTORG                                                          TSO09490
         DROP      R11                                                  TSO09500
         DROP      R12                                                  TSO09510
         EJECT                                                          TSO09520
**********************************************************************  TSO09530
*                                                                    *  TSO09540
*        ROUTINE TO PROCESS SHOW COMMAND                             *  TSO09550
*                                                                    *  TSO09560
**********************************************************************  TSO09570
SHOW     DS        0H                                                   TSO09580
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          TSO09590
         BALR      R12,0               ESTABLISH ADDRESSABILITY         TSO09600
         USING     *,R12                                                TSO09610
         LA        R14,SHOWSAVE        ADDRESS OF MY SAVE AREA          TSO09620
         ST        R13,4(R14)          SAVE CALLER'S                    TSO09630
         ST        R14,8(R13)                                           TSO09640
         LR        R13,R14                                              TSO09650
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 TSO09660
         L         R11,=A(PARMS)                                        TSO09670
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         TSO09680
         BXH       R7,R8,SHONFM        ANY MORE OPERANDS                TSO09690
         L         R6,0(R7)            GET NEXT TOKEN                   TSO09700
         CLI       0(R6),C'?'          NEED HELP ?                      TSO09710
         BNE       SHOREC                                               TSO09720
         WRTERM    'State'                                              TSO09730
         B         SHOWOK                                               TSO09740
SHONFM   WRTERM    '?NOT CONFIRMED'                                     TSO09750
         B         SHOWERR                                              TSO09760
SHOREC   CLI       0(R6),C'S'          IS THIS SHOW STATE               TSO09770
         BNE       SHOWERR                                              TSO09780
         MVC       WRKBUFF(18),=C'Record format is .'                   TSO09790
         MVC       WRKBUFF+17(1),RFM                                    TSO09800
         TPUT      WRKBUFF,18                                           TSO09810
         TR        QUOCHAR(1),ATOE     GET EBCDIC VERSION               TSO09820
         MVC       WRKBUFF(20),=C'Quote character is .'                 TSO09830
         MVC       WRKBUFF+19(1),QUOCHAR                                TSO09840
         TPUT      WRKBUFF,20                                           TSO09850
         TR        QUOCHAR(1),ETOA     KEEP THE ASCII FORM AROUND       TSO09860
         SR        R4,R4               ZERO IT OUT                      TSO09870
         IC        R4,LRECL                                             TSO09880
         MVC       WRKBUFF(8),=C'Lrecl is'                              TSO09890
         BINCVRT   R4,WRKBUFF+8,DBLWRK                                  TSO09900
         TPUT      WRKBUFF,14                                           TSO09910
         LH        R4,BLKSIZE                                           TSO09920
         MVC       WRKBUFF(10),=C'Blksize is'                           TSO09930
         BINCVRT   R4,WRKBUFF+10,DBLWRK                                 TSO09940
         TPUT      WRKBUFF,16                                           TSO09950
         L         R4,TRACK                                             TSO09960
         MVC       WRKBUFF(32),=C'Space allocation is ..... tracks'     TSO09970
         BINCVRT   R4,WRKBUFF+19,DBLWRK                                 TSO09980
         TPUT      WRKBUFF,32                                           TSO09990
         SR        R4,R4               ZERO IT OUT                      TSO10000
         IC        R4,SSOH                                              TSO10010
       MVC WRKBUFF(44),=C'Start-of-header character is ..... (decimal)' TSO10020
         BINCVRT   R4,WRKBUFF+28,DBLWRK                                 TSO10030
         TPUT      WRKBUFF,44                                           TSO10040
         SR        R4,R4               ZERO IT OUT                      TSO10050
         IC        R4,SEOL                                              TSO10060
         MVC WRKBUFF(40),=C'End-of-line character is ..... (decimal)'   TSO10070
         BINCVRT   R4,WRKBUFF+24,DBLWRK                                 TSO10080
         TPUT      WRKBUFF,40                                           TSO10090
         MVC WRKBUFF(38),=C'Receive packet size is ..... (decimal)'     TSO10100
         L         R1,RPSIZ                                             TSO10110
         BINCVRT   R1,WRKBUFF+22,DBLWRK                                 TSO10120
         TPUT      WRKBUFF,38                                           TSO10130
         MVC       WRKBUFF(28),=C'Delay value is ..... seconds'         TSO10140
         L         R1,DELAY                                             TSO10150
         SR        R0,R0                                                TSO10160
         D         R0,=F'100'                                           TSO10170
         BINCVRT   R1,WRKBUFF+14,DBLWRK                                 TSO10180
         TPUT      WRKBUFF,28                                           TSO10190
         MVC       WRKBUFF(9),=C'Debug is '                             TSO10200
         MVC       WRKBUFF+9(3),=C'off'                                 TSO10210
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        TSO10220
         BZ        SHOWDBG                                              TSO10230
         MVC       WRKBUFF+9(3),=C'on '                                 TSO10240
SHOWDBG  TPUT      WRKBUFF,12                                           TSO10250
         B         SHOWOK                                               TSO10260
SHOWERR  LA        R15,4               SET A NON-ZERO RETCODE           TSO10270
         B         SHOWRET                                              TSO10280
SHOWOK   SR        R15,R15             ZERO RETCODE                     TSO10290
*                                                                       TSO10300
SHOWRET  L         R13,4(R13)                                           TSO10310
         L         R14,12(R13)                                          TSO10320
         LM        R0,R12,20(R13)                                       TSO10330
         BR        R14                                                  TSO10340
SHOWSAVE DS        18F                                                  TSO10350
         LTORG                                                          TSO10360
         DROP      R11                                                  TSO10370
         DROP      R12                                                  TSO10380
*                                                                       TSO10390
         EJECT                                                          TSO10400
**********************************************************************  TSO10410
*                                                                    *  TSO10420
*        ROUTINE TO INITIALIZE PARAMETER AREA                        *  TSO10430
*                                                                    *  TSO10440
**********************************************************************  TSO10450
INIT     DS        0H                                                   TSO10460
         STM       R14,R12,12(R13)                                      TSO10470
         BALR      R12,0                                                TSO10480
         USING     *,R12                                                TSO10490
         LA        R14,ISAVE                                            TSO10500
         ST        R13,4(R14)                                           TSO10510
         ST        R14,8(R13)                                           TSO10520
         LR        R13,R14                                              TSO10530
*                                                                       TSO10540
* INITIALIZE VARIABLES THAT GET CHANGED DURING EXECUTION                TSO10550
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA LIST                 TSO10560
         L         R11,=A(PARMS)                                        TSO10570
         USING     PARMS,R11                                            TSO10580
         XC        SNDPKT,SNDPKT       CLEAR OUT THESE BUFFERS          TSO10590
         XC        RECPKT,RECPKT                                        TSO10600
         XC        INPUT,INPUT                                          TSO10610
         LA        R0,BUF                                               TSO10620
         LA        R1,L'BUF            ; CLEAR OUT THE BUFFER.          TSO10630
         SR        R15,R15                                              TSO10640
         MVCL      R0,R14                                               TSO10650
         LA        R0,RBUF                                              TSO10660
         LA        R1,L'RBUF                                            TSO10670
         SR        R15,R15                                              TSO10680
         MVCL      R0,R14                                               TSO10690
         XC        SDAT,SDAT                                            TSO10700
         XC        RDAT,RDAT                                            TSO10710
         XC        N,N                 SET VARIABLES TO ZERO            TSO10720
         XC        NUM,NUM                                              TSO10730
         XC        LSDAT,LSDAT                                          TSO10740
         XC        LRDAT,LRDAT                                          TSO10750
         MVI       FLAGS,X'00'         CLEAR ALL FLAGS                  TSO10760
         XC        SAVPL,SAVPL                                          TSO10770
         XC        RSAVPL,RSAVPL                                        TSO10780
         XC        NUMTRY,NUMTRY                                        TSO10790
         MVC       FILNAM,=18X'20'     BLANK OUT FILNAM & NAME          TSO10800
         MVC       NAME,=18X'20'                                        TSO10810
         MVI       PREV,X'00'                                           TSO10820
         MVI       ERRNUM,X'FF'        SET TO NO ERROR FOR NOW          TSO10830
         MVI       OLDERR,X'FF'        SAME HERE                        TSO10840
         XC        PKVAR,PKVAR         ZERO IT OUT                      TSO10850
         XC        OLDTRY,OLDTRY                                        TSO10860
         XC        SPSIZ,SPSIZ                                          TSO10870
         XC        SIZE,SIZE                                            TSO10880
         XC        TEMP,TEMP                                            TSO10890
         XC        STORLOC,STORLOC                                      TSO10900
         MVC       DELAY,DDELAY        SET DEFAULT DELAY                TSO10910
         MVC       LRECL(1),DLRECL     SET DEFAULTS, JUST IN CASE       TSO10920
         MVC       BLKSIZE(2),DBLKSIZE SET DEFAULTS, JUST IN CASE       TSO10930
         MVC       TRACK,DTRACK        DEFAULT SPACE OF 5 TRACKS        TSO10940
         MVC       RFM(1),DRECFM                                        TSO10950
         MVC       QUOCHAR(1),DQUOTE                                    TSO10960
         MVC       RQUO(1),DQUOTE                                       TSO10970
         MVC       REOL(1),DEOL                                         TSO10980
         MVC       SEOL(1),DEOL                                         TSO10990
         MVC       SSOH(1),DSOH                                         TSO11000
         MVC       RSOH(1),DSOH                                         TSO11010
         MVI       STATE,C' '                                           TSO11020
         MVI       STYPE,C' '                                           TSO11030
         MVI       RTYPE,C' '                                           TSO11040
*                                                                       TSO11050
INITRET  L         R13,4(R13)                                           TSO11060
         L         R14,12(R13)                                          TSO11070
         LM        R0,R12,20(R13)                                       TSO11080
         BR        R14                                                  TSO11090
ISAVE    DS        18F                                                  TSO11100
         LTORG                                                          TSO11110
         DROP      R11                                                  TSO11120
         DROP      R12                                                  TSO11130
         EJECT                                                          TSO11140
**********************************************************************  TSO11150
*                                                                    *  TSO11160
*        ROUTINE TO PROCESS SEND COMMAND                             *  TSO11170
*                                                                    *  TSO11180
**********************************************************************  TSO11190
SEND     DS        0H                                                   TSO11200
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          TSO11210
         BALR      R12,0               ESTABLISH ADDRESSABILITY         TSO11220
         USING     *,R12                                                TSO11230
         LA        R14,SENDSAVE        ADDRESS OF MY SAVE AREA          TSO11240
         ST        R13,4(R14)          SAVE CALLER'S                    TSO11250
         ST        R14,8(R13)                                           TSO11260
         LR        R13,R14                                              TSO11270
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 TSO11280
         L         R11,=A(PARMS)                                        TSO11290
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         TSO11300
         MVI       STATE,C'S'                                           TSO11310
         SR        R3,R3                                                TSO11320
         ST        R3,N                                                 TSO11330
         ST        R3,NUMTRY                                            TSO11340
OKSND    TM        FLAGS,FLG1          IS THIS THE FIRST FILE?          TSO11350
         BNO       SLOOP                                                TSO11360
         NI        FLAGS,X'FF'-FLG1    TURN OFF FIRST FILE FLAG         TSO11370
**********************************************************************  TSO11380
*        MAIN SEND LOOP                                              *  TSO11390
**********************************************************************  TSO11400
SLOOP    CLI       STATE,C'D'          SEND DATA STATE                  TSO11410
         BE        SDATA                                                TSO11420
         CLI       STATE,C'F'          SEND FILE STATE                  TSO11430
         BE        SFILE                                                TSO11440
         CLI       STATE,C'S'          SEND INIT STATE                  TSO11450
         BE        SINIT                                                TSO11460
         CLI       STATE,C'Z'          END OF FILE STATE                TSO11470
         BE        SEOF                                                 TSO11480
         CLI       STATE,C'B'          SEND BREAK STATE                 TSO11490
         BE        SBREAK                                               TSO11500
         CLI       STATE,C'C'          COMPLETE STATE                   TSO11510
         BE        COMPLETE                                             TSO11520
         CLI       STATE,C'A'          ABORT STATE                      TSO11530
         BE        ABORT               ERROR - GO TO ABORT STATE        TSO11540
         MVI       ERRNUM,X'02'        UNRECOGNIZED STATE               TSO11550
         B         ABORT               OTHERWISE, DIE                   TSO11560
**********************************************************************  TSO11570
*        CREATE AND SEND INITIALIZATION PACKET                       *  TSO11580
**********************************************************************  TSO11590
SINIT    CLC       NUMTRY,IMXTRY       SEE IF CAN SEND                  TSO11600
         BL        OK1                 YES WE CAN                       TSO11610
         MVI       STATE,C'A'          NOPE, GO INTO ABORT STATE        TSO11620
         B         SLOOP                                                TSO11630
OK1      L         R5,SPACE            MAKE CHARACTER PRINTABLE         TSO11640
         A         R5,RPSIZ            ADD REC PACKET SIZE              TSO11650
         STC       R5,SDAT             ADD SIZE INFO TO BUFFER          TSO11660
         L         R5,SPACE                                             TSO11670
         A         R5,=F'8'            8 FOR TIMEOUT                    TSO11680
         STC       R5,SDAT+1                                            TSO11690
         L         R5,SPACE            SEND ZERO + " " FOR NPAD         TSO11700
         STC       R5,SDAT+2           WE'RE THE SLOW GUYS              TSO11710
         SR        R5,R5               PAD WITH NULLS                   TSO11720
         L         R3,O1H                                               TSO11730
         XR        R5,R3               CTL FUNCTION (XOR WITH 64)       TSO11740
         STC       R5,SDAT+3           DON'T NEED PADCHAR EITHER        TSO11750
         SR        R5,R5               ZERO IT OUT FOR NEXT TWO GUYS    TSO11760
         IC        R5,REOL             EOL CHAR I NEED                  TSO11770
         A         R5,SPACE            MAKE PRINTABLE                   TSO11780
         STC       R5,SDAT+4                                            TSO11790
         IC        R5,QUOCHAR          MY QUOTE CHAR                    TSO11800
         STC       R5,SDAT+5                                            TSO11810
         L         R3,NUMTRY                                            TSO11820
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          TSO11830
         ST        R3,NUMTRY                                            TSO11840
         MVI       STYPE,AS            PACKET TYPE = SEND INITIATE      TSO11850
         MVC       LSDAT(4),=F'6'     BUFFER SIZE FOR THIS SEND         TSO11860
         L         R4,DSSIZ            GET DEFAULT SPSIZ                TSO11870
         S         R4,FIVE             FOR NOW, USE DEFAULT SPSIZ....   TSO11880
         ST        R4,SIZE             ....TO SET VALUE OF SIZE         TSO11890
         L         R15,=A(SPACK)       GET ADDRESS OF ROUTINE 'SPACK'   TSO11900
         BALR      14,15               SAVE * AND GO TO SPACK           TSO11910
         CLI       STATE,C'A'                                           TSO11920
         BE        ABORT                                                TSO11930
         L         15,=A(RPACK)        GET ADDRESS OF 'RPACK'           TSO11940
         BALR      14,15               SAVE * AND GO TO RPACK           TSO11950
         CLI       RTYPE,AE            ERROR PACKET?                    TSO11960
         BNE       Y1                  NO, THEN MAYBE AN ACK            TSO11970
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO11980
         MVI       STATE,C'A'          AND DIE                          TSO11990
         B         SLOOP                                                TSO12000
Y1       CLI       RTYPE,AY            SEE IF GOT ACK                   TSO12010
         BNE       N1                  MAYBE IT'S 'N'                   TSO12020
         CLC       N,NUM               CHECK MESSAGE NUMBERS            TSO12030
         BE        AOK1                                                 TSO12040
         MVI       ERRNUM,X'08'        PACKET LOST                      TSO12050
         B         SLOOP                                                TSO12060
AOK1     SR        R4,R4               ZERO OUT REGISTER                TSO12070
         IC        R4,RDAT             USE SPSIZ THE MICRO WANTS        TSO12080
         S         R4,SPACE            SUBTRACT THE ' '                 TSO12090
         C         R4,=F'26'           BUFFER HAS TO BE >= 26           TSO12100
         BNL       CH1                 SO FAR, SO GOOD                  TSO12110
         MVI       STATE,C'A'          ABORT THEN                       TSO12120
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR   TSO12130
         B         SLOOP                                                TSO12140
CH1      C         R4,MAXPACK          MAX PACKET SIZE                  TSO12150
         BNH       CH2                 CONTINUE IF <= TO MAX            TSO12160
         MVI       STATE,C'A'          DIE                              TSO12170
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR   TSO12180
         B         SLOOP                                                TSO12190
CH2      STC       R4,SPSIZ+3          USE SPSIZ THE MICRO WANTS        TSO12200
         S         R4,FIVE                                              TSO12210
         ST        R4,SIZE             SET SIZE TO SPSIZ-5              TSO12220
         CLC       LRDAT(4),=F'4'      USING DEFAULTS?                  TSO12230
         BNH       NOCHG               YUP                              TSO12240
         LA        R5,RDAT             POINTER TO THE BUFFER            TSO12250
         SR        R7,R7                                                TSO12260
         IC        R7,4(R5)            SEOL MICRO WANTS                 TSO12270
         S         R7,SPACE            UNCHAR (IE - SUBTRACT SPACE)     TSO12280
         STC       R7,SEOL                                              TSO12290
NOCHG    MVI       STATE,C'F'          PUT INTO SEND FILE STATE         TSO12300
         XC        NUMTRY,NUMTRY       RESET TO ZERO                    TSO12310
         L         R3,N                                                 TSO12320
         LA        R3,1(R3)            ADD ONE                          TSO12330
         ST        R3,N                STORE VALUE INCREMENTED BY 1     TSO12340
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO12350
         B         SLOOP                                                TSO12360
N1       CLI       RTYPE,AN            SEE IF IT'S 'N'                  TSO12370
         BNE       AB1                 IF NOT, DIE                      TSO12380
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     TSO12390
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     TSO12400
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     TSO12410
         B         SLOOP                                                TSO12420
AB1      MVI       STATE,C'A'          ELSE, ABORT                      TSO12430
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         TSO12440
         B         SLOOP                                                TSO12450
**********************************************************************  TSO12460
*        CREATE AND SEND FILE PACKET                                 *  TSO12470
**********************************************************************  TSO12480
SFILE    CLC       NUMTRY,MAXTRY       EXCEEDED NO. OF TRIES ALLOWED?   TSO12490
         BL        OK2                 NOPE, STILL OK                   TSO12500
         MVI       STATE,C'A'          ABORT IF YES                     TSO12510
         B         SLOOP                                                TSO12520
OK2      DS        0H                                                   TSO12530
         TR        FILNAM,ETOA                                          TSO12540
         LH    R5,FILNAML          GET LENGTH OF FILENAME - 1           TSO12550
         MVC   SDAT(*-*),FILNAM    USE FOR EXECUTE                      TSO12560
         EX    R5,*-6              GO MOVE FILENAME TO BUFFER           TSO12570
         LA    R5,1(,R5)           UP THE FILE LENGTH TO BE EXACT       TSO12580
         L         R3,NUMTRY                                            TSO12590
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          TSO12600
         ST        R3,NUMTRY                                            TSO12610
         MVI       STYPE,AF            PACKET TYPE = FILE HEADER        TSO12620
         ST        R5,LSDAT            SET BUFFER SIZE                  TSO12630
         TR        FILNAM,ATOE                                          TSO12640
SNDFIL   L         R15,=A(SPACK)       GET ADDRESS OF 'SPACK'           TSO12650
         BALR      14,15               SAVE * AND GO TO SPACK           TSO12660
         CLI       STATE,C'A'                                           TSO12670
         BE        ABORT                                                TSO12680
         L         15,=A(RPACK)        GET ADDRESS OF 'RPACK'           TSO12690
         BALR      14,15               SAVE * AND GO TO RPACK           TSO12700
         CLI       RTYPE,AE            ERROR PACKET?                    TSO12710
         BNE       Y2                  MAYBE AN ACK                     TSO12720
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO12730
         MVI       STATE,C'A'          SO WE DO TOO                     TSO12740
         B         SLOOP                                                TSO12750
Y2       CLI       RTYPE,AY            SEE IF GOT ACK                   TSO12760
         BNE       N2                  MAYBE GOT AN 'N'                 TSO12770
         CLC       N,NUM               DO WE HAVE THE CORRECT ACK?      TSO12780
         BE        AOK2                                                 TSO12790
         MVI       ERRNUM,X'08'        MISSING A PACKET SOMEWHERE       TSO12800
         B         SLOOP                                                TSO12810
AOK2     MVI       STATE,C'D'          PREPARE FOR SEND-DATA STATE      TSO12820
         XC        NUMTRY,NUMTRY       RESET COUNTER                    TSO12830
         L         R3,N                                                 TSO12840
         LA        R3,1(R3)            ADD ONE                          TSO12850
         ST        R3,N                STORE INCREMENTED VALUE          TSO12860
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO12870
         L         15,=A(GTCHR)                                         TSO12880
         BALR      14,15               DO GET-CHAR AND COME BACK        TSO12890
         B         SLOOP                                                TSO12900
N2       CLI       RTYPE,AN                                             TSO12910
         BNE       AB2                 ELSE, DIE                        TSO12920
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     TSO12930
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     TSO12940
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     TSO12950
         B         SLOOP                                                TSO12960
AB2      MVI       STATE,C'A'          ELSE, ABORT                      TSO12970
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         TSO12980
         B         SLOOP                                                TSO12990
**********************************************************************  TSO13000
*        CREATE AND SEND DATA PACKETS                                *  TSO13010
**********************************************************************  TSO13020
SDATA    CLC       NUMTRY,MAXTRY       CAN WE DO IT?                    TSO13030
         BL        OK4                 YES                              TSO13040
         MVI       STATE,C'A'          ELSE ABORT                       TSO13050
         B         SLOOP                                                TSO13060
OK4      L         R3,NUMTRY                                            TSO13070
         LA        R3,1(R3)            INCREMENT COUNTER                TSO13080
         ST        R3,NUMTRY                                            TSO13090
         MVI       STYPE,AD            PACKET TYPE = DATA               TSO13100
         L         R15,=A(SPACK)                                        TSO13110
         BALR      14,15               GO TO SPACK AND RETURN           TSO13120
         CLI       STATE,C'A'                                           TSO13130
         BE        ABORT                                                TSO13140
         L         15,=A(RPACK)                                         TSO13150
         BALR      14,15               SAME FOR RPACK                   TSO13160
         CLI       RTYPE,AE            ERROR PACKET?                    TSO13170
         BNE       Y4                  MAYBE AN ACK                     TSO13180
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO13190
         MVI       STATE,C'A'          SO WE DO TOO                     TSO13200
         B         SLOOP                                                TSO13210
Y4       CLI       RTYPE,AY            SEE IF GOT 'ACK'                 TSO13220
         BNE       N4                  SEE IF IT'S AN 'N'               TSO13230
         CLC       N,NUM               DO WE HAVE THE CORRECT ACK?      TSO13240
         BE        AOK4                                                 TSO13250
         MVI       ERRNUM,X'08'        MISSING A PACKET                 TSO13260
         B         SLOOP                                                TSO13270
AOK4     XC        NUMTRY,NUMTRY       RESET COUNTER                    TSO13280
         L         R3,N                                                 TSO13290
         LA        R3,1(R3)            INCREMENT COUNTER                TSO13300
         ST        R3,N                                                 TSO13310
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO13320
         L         15,=A(GTCHR)                                         TSO13330
         BALR      14,15               DO GET-CHAR AND RETURN           TSO13340
         B         SLOOP                                                TSO13350
N4       CLI       RTYPE,AN                                             TSO13360
         BNE       AB4                                                  TSO13370
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     TSO13380
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     TSO13390
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     TSO13400
         B         SLOOP                                                TSO13410
AB4      MVI       STATE,C'A'                                           TSO13420
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              TSO13430
         B         SLOOP                                                TSO13440
**********************************************************************  TSO13450
*        CREATE AND SEND EOF PACKET                                  *  TSO13460
**********************************************************************  TSO13470
SEOF     CLC       NUMTRY,MAXTRY       CAN WE DO IT?                    TSO13480
         BL        OK5                 BRANCH IF YES                    TSO13490
         MVI       STATE,C'A'          ABORT IF NO                      TSO13500
         B         SLOOP                                                TSO13510
OK5      L         R3,NUMTRY                                            TSO13520
         LA        R3,1(R3)            ADD ONE                          TSO13530
         ST        R3,NUMTRY           STORE INCREMENTED COUNTER        TSO13540
         MVI       STYPE,AZ            PACKET TYPE = EOF                TSO13550
         XC        LSDAT,LSDAT         LENGTH OF ZERO                   TSO13560
         L         R15,=A(SPACK)                                        TSO13570
         BALR      14,15               SAVE * AND GO TO SPACK           TSO13580
         CLI       STATE,C'A'                                           TSO13590
         BE        ABORT                                                TSO13600
         L         15,=A(RPACK)                                         TSO13610
         BALR      14,15               SAME FOR RPACK                   TSO13620
         CLI       RTYPE,AE            ERROR PACKET?                    TSO13630
         BNE       Y5                  MAYBE AN ACK                     TSO13640
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO13650
         MVI       STATE,C'A'          SO WE DO TOO                     TSO13660
         B         SLOOP                                                TSO13670
Y5       CLI       RTYPE,AY            CHECK FOR 'ACK'                  TSO13680
         BNE       N5                  MAYBE WAS A 'NAK'                TSO13690
         CLC       N,NUM               CORRECT ACK?                     TSO13700
         BE        AOK5                                                 TSO13710
         MVI       ERRNUM,X'08'        LOST A PACKET                    TSO13720
         B         SLOOP                                                TSO13730
AOK5     L         R3,N                                                 TSO13740
         LA        R3,1(R3)            ADD ONE                          TSO13750
         ST        R3,N                STORE VALUE INCREMENTED BY 1     TSO13760
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO13770
         MVI       STATE,C'F'          SET TO SEND FILE FOR NOW         TSO13780
*                                                                       TSO13790
*                                                                       TSO13800
*  WE JUST PROCESS ONE FILE FOR NOW.                                    TSO13810
*                                                                       TSO13820
DIEOK    MVI       STATE,C'B'          BREAK CONNECTION                 TSO13830
         B         SLOOP                                                TSO13840
N5       CLI       RTYPE,AN                                             TSO13850
         BNE       AB5                 DIE IF NOT A NAK                 TSO13860
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     TSO13870
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     TSO13880
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     TSO13890
         B         SLOOP                                                TSO13900
AB5      MVI       STATE,C'A'          ELSE, ABORT                      TSO13910
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         TSO13920
         B         SLOOP                                                TSO13930
**********************************************************************  TSO13940
*        CREATE AND SEND BREAK PACKET                                *  TSO13950
**********************************************************************  TSO13960
SBREAK   CLC       NUMTRY,MAXTRY       OVER OUR LIMIT?                  TSO13970
         BL        OK6                 BRANCH IF NO                     TSO13980
         MVI       STATE,C'A'          ABORT IF YES                     TSO13990
         B         SLOOP                                                TSO14000
OK6      L         R3,NUMTRY                                            TSO14010
         LA        R3,1(R3)            ADD ONE                          TSO14020
         ST        R3,NUMTRY           INCREMEMTED TRIAL COUNTER        TSO14030
         MVI       STYPE,AB            PACKET TYPE = BREAK              TSO14040
         XC        LSDAT,LSDAT         LENGTH = ZERO                    TSO14050
         L         R15,=A(SPACK)                                        TSO14060
         BALR      14,15               SAVE * AND GO TO SPACK           TSO14070
         CLI       STATE,C'A'                                           TSO14080
         BE        ABORT                                                TSO14090
         L         15,=A(RPACK)                                         TSO14100
         BALR      14,15               SAVE * AND GO TO RPACK           TSO14110
         CLI       RTYPE,AE            ERROR PACKET?                    TSO14120
         BNE       Y6                  MAYBE AN ACK                     TSO14130
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO14140
         MVI       STATE,C'A'          THEN WE DO TOO                   TSO14150
         B         SLOOP                                                TSO14160
Y6       CLI       RTYPE,AY            CHECK FOR ACK                    TSO14170
         BNE       N6                  CHECK FOR 'N'                    TSO14180
         CLC       N,NUM               CORRECT ACK?                     TSO14190
         BE        AOK6                                                 TSO14200
         MVI       ERRNUM,X'08'        LOST A PACKET                    TSO14210
         B         SLOOP                                                TSO14220
AOK6     MVI       STATE,C'C'          COMPLETED STATE                  TSO14230
         B         SLOOP                                                TSO14240
N6       CLI       RTYPE,AN            CHECK FOR 'N'                    TSO14250
         BNE       AB6                 DIE IF NOT A NAK                 TSO14260
         TM        FLAGS,FLG4          DID MICRO NAK OR I REJECTED?     TSO14270
         BO        SLOOP               LEAVE ERR MSG AS IS IF I DID     TSO14280
         MVI       ERRNUM,X'09'        MICRO NAK'ED                     TSO14290
         B         SLOOP                                                TSO14300
AB6      MVI       STATE,C'A'          ELSE,ABORT                       TSO14310
         MVI       ERRNUM,X'07'        UNRECOGNIZED PACKET TYPE         TSO14320
         B         SLOOP                                                TSO14330
**********************************************************************  TSO14340
*        CREATE AND SEND ABORT PACKET                                *  TSO14350
**********************************************************************  TSO14360
ABORT    DS        0H                                                   TSO14370
         TM        FLAGS,FLG1          DYING ON FILE-NOT-FOUND?         TSO14380
         BO        NOERRP              IF SO, THEN NO ERROR PACKET      TSO14390
         CLI       ERRNUM,X'0A'        DID THE MICRO DIE?               TSO14400
         BE        NOERRP              NO ERROR PACKET IF SO            TSO14410
         MVI       STYPE,AE            ERROR PACKET                     TSO14420
         MVC       LSDAT(4),=F'20'     ALL MSGS ARE THIS LONG           TSO14430
         MVC       N(4),NUM            SYNCH PACKET NUMBERS             TSO14440
         SR        R5,R5                                                TSO14450
         IC        R5,ERRNUM           GET RIGHT MESSAGE NUMBER         TSO14460
         M         R4,=F'20'           OFFSET := ERRNUM * 20            TSO14470
         LA        R5,ERRTAB(R5)                                        TSO14480
         MVC       SDAT(20),0(R5)      SPACK NEEDS THE DATA HERE        TSO14490
         TR        SDAT(20),ETOA                                        TSO14500
         L         R15,=A(SPACK)                                        TSO14510
         BALR      R14,R15             SEND ERROR PACKET & DIE          TSO14520
NOERRP   LA        R15,4               SET NON-ZERO RETCODE             TSO14530
         B         SENDRET             PREPARE TO LEAVE                 TSO14540
**********************************************************************  TSO14550
*        PROCESS COMPLETE                                            *  TSO14560
**********************************************************************  TSO14570
COMPLETE SR        R15,R15             ZERO WILL BE RETCODE             TSO14580
SENDRET  L         R13,4(R13)                                           TSO14590
         L         R14,12(R13)                                          TSO14600
         LM        R0,R12,20(R13)                                       TSO14610
         BR        R14                                                  TSO14620
         EJECT                                                          TSO14630
**********************************************************************  TSO14640
*                                                                    *  TSO14650
*  ROUTINE TO GET A CHARACTER FROM INPUT BUFFER WILL READ DISK TO    *  TSO14660
*        FILL THE BUFFER.                                            *  TSO14670
*                                                                    *  TSO14680
**********************************************************************  TSO14690
GTCHR    DS        0H                                                   TSO14700
         TM        FLAGS,FLG3          SEE IF THERE'S STUFF IN BUF      TSO14710
         BO        STUFF               ONES -> STUFF'S THERE            TSO14720
*                                                                       TSO14730
*  GO TO COMMON ROUTINE TO READ SOME BYTES                              TSO14740
*                                                                       TSO14750
         LA        R15,READX                                            TSO14760
         BALR      R15,R15                                              TSO14770
*                                                                       TSO14780
         LTR       R4,R1               PUT RESULT OF READ IN R4         TSO14790
         BZ        OK8                                                  TSO14800
         C         R4,=A(ERCOD)        RETCODE OF 12 MEANS EOF          TSO14810
         BNE       ERR1                TRY IT AGAIN                     TSO14820
         MVI       STATE,C'Z'          MAKE TO EOF STATE                TSO14830
         BR        R14                                                  TSO14840
ERR1     MVI       STATE,C'A'          ABORT ON FILE SYSTEM ERROR       TSO14850
         MVI       ERRNUM,X'0C'        INVALID RECORD LENGTH            TSO14860
         C         R4,=F'8'            WAS OUR GUESS RIGHT?             TSO14870
         BER       R14                 IF YES, RETURN                   TSO14880
         MVI       ERRNUM,X'0D'        ELSE, GOT AN I/O ERROR           TSO14890
         BR        R14                                                  TSO14900
OK8      LR        R5,R0               GET NUMBER OF BYTES READ IN      TSO14910
         LR        R4,R5               SAVE ALSO IN R4                  TSO14920
         BCTR      R4,0                SUBTRACT 1 FOR EX COMMAND        TSO14930
         EX        R4,TRANS            EBCDIC TO ASCII TRANSLATION      TSO14940
         LA        R8,BUF              GET LOCATION OF BUFFER INPUT     TSO14950
         LA        R9,BUF(R4)          LAST POSITION IN THAT BUFFER     TSO14960
X4       CLI       0(R9),X'20'         IS THIS A BLANK?                 TSO14970
         BNE       X5                  NO, FOUND LAST CHAR OF LINE      TSO14980
         BCTR      R9,0                                                 TSO14990
         CR        R9,R8                                                TSO15000
         BNL       X4                  FIND LAST CHAR                   TSO15010
         SR        R5,R5               ALL BLANKS                       TSO15020
         B         FOO                                                  TSO15030
X5       SR        R9,R8                                                TSO15040
         LR        R5,R9               LENGTH OF LINE                   TSO15050
         LA        R5,1(R5)            ADD ONE                          TSO15060
FOO      LA        R9,BUF(R5)          FIRST BLANK SPACE AFTER DATA     TSO15070
         MVC       0(1,R9),=X'0D'      ADD ASCII CR                     TSO15080
         LA        R9,1(R9)            INCREMENT POINTER                TSO15090
         MVC       0(1,R9),=X'0A'      AND ADD ASCII LF                 TSO15100
         LA        R5,2(R5)            TWO EXTRA BYTES OF DATA NOW      TSO15110
         ST        R5,RECL             LRECL + 2 (FOR CRLF)             TSO15120
         SR        R8,R8               ZERO OUT INDEX FOR BUF           TSO15130
STUFF    SR        R9,R9               SAME FOR INDEX FOR SDAT          TSO15140
         SR        R10,R10             CHARACTER COUNTER                TSO15150
         SR        R5,R5               WILL HOLD QUOCHAR                TSO15160
         IC        R5,QUOCHAR                                           TSO15170
         L         R8,SAVPL            WHERE WE LEFT OFF                TSO15180
         C         R8,RECL             SEE IF ARE AT LIMIT              TSO15190
         BNL       FULL2               LEAVE IF REACHED OR EXCEEDED     TSO15200
         SR        R7,R7                                                TSO15210
LOOP     IC        R7,BUF(R8)          PICK UP BYTE                     TSO15220
         CR        R7,R5               IS IT THE QUOTE CHARACTER?       TSO15230
         BE        SPECIAL                                              TSO15240
         C         R7,DEL              IS IT THE CHARDEL?               TSO15250
         BE        SPECIAL                                              TSO15260
         C         R7,SPACE            IS IT A CONTROL CHARACTER?       TSO15270
         BL        SPECIAL                                              TSO15280
         B         ADDIT                                                TSO15290
SPECIAL  L         R4,SIZE             MUNGE VALUE WHILE IN R4          TSO15300
         SR        R4,R10              FIND DIF BETWWEN THE TWO         TSO15310
         C         R4,TWO              SEE IF HAVE AT LEAST 2 BYTES     TSO15320
         BNL       ROOM                YES,CAN ADD                      TSO15330
         STC       R10,LSDAT+3         SET LSDAT TO VAL OF COUNTER      TSO15340
         OI        FLAGS,FLG3          SET FLAG TO SHOW STUFF'S THERE   TSO15350
         ST        R8,SAVPL            SAVE PLACE IN BUF                TSO15360
         BR        14                  LEAVE THIS ROUTINE               TSO15370
ROOM     LA        R4,SDAT(R9)         WHERE IT'S GOING                 TSO15380
         MVC       0(1,R4),QUOCHAR     MOVE QUOTE CHAR THERE            TSO15390
         LA        R9,1(R9)            INCREMENT SDAT COUNTER           TSO15400
         LA        R10,1(R10)          INCREMENT CHARACTER COUNTER      TSO15410
         CR        R7,R5               DON'T ADD ^O100 TO THIS          TSO15420
         BE        ADDIT               IT'S ALREADY PRINTABLE           TSO15430
         A         R7,O1H              ADD ^O100 TO CHAR                TSO15440
         N         R7,=X'0000007F'     GET MOD ^O200                    TSO15450
ADDIT    STC       R7,SDAT(R9)         ADD THE CHARACTER                TSO15460
         LA        R9,1(R9)            INCREMENT SDAT COUNTER           TSO15470
         LA        R8,1(R8)            INCREMENT BUF COUNTER            TSO15480
         LA        R10,1(R10)          INCREMENT CHARACTER COUNTER      TSO15490
         C         R8,RECL             SEE IF REACHED LIMIT             TSO15500
         BNL       FULL2                                                TSO15510
         C         R9,SIZE             SEE IF REACHED LIMIT             TSO15520
         BNL       FULL                                                 TSO15530
         B         LOOP                                                 TSO15540
FULL     EQU       *                                                    TSO15550
         STC       R10,LSDAT+3         THIS ONE TOO                     TSO15560
         ST        R8,SAVPL            HERE TOO                         TSO15570
         OI        FLAGS,FLG3          TURN ON FLAG - STUFF IN BUF      TSO15580
         BR        14                                                   TSO15590
FULL2    EQU       *                                                    TSO15600
         STC       R10,LSDAT+3         THIS ONE TOO                     TSO15610
         XC        SAVPL,SAVPL         RESET THIS                       TSO15620
         NI        FLAGS,X'FF'-FLG3    TURN OFF LEFTOVER DATA FLAG      TSO15630
         BR        14                                                   TSO15640
SENDSAVE DS        18F                                                  TSO15650
TRANS    TR        BUF(0),ETOA         EBCDIC TO ASCII TRANSLATION      TSO15660
TRNS     TR        SNDPKT(0),ATOE      BACK FROM ASCII TO EBCDIC        TSO15670
PARSE    DC        32X'00'                                              TSO15680
         DC        X'01'               STOP ON A SPACE                  TSO15690
         DC        223X'00'                                             TSO15700
FIRST    MVC       SDAT(0),FILNAM      PICK UP THE FN                   TSO15710
SECOND   MVC       0(0,R7),FILNAM+8    PICK UP FT                       TSO15720
         LTORG                                                          TSO15730
         DROP      R11                                                  TSO15740
         DROP      R12                 DON'T NEED THEM ANYMORE          TSO15750
         EJECT                                                          TSO15760
**********************************************************************  TSO15770
*                                                                    *  TSO15780
*        ROUTINE TO PROCESS SEND PACKET REQUEST                      *  TSO15790
*                                                                    *  TSO15800
**********************************************************************  TSO15810
SPACK    DS        0H     CSECT                                         TSO15820
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          TSO15830
         BALR      R12,0               ESTABLISH ADDRESSABILITY         TSO15840
         USING     *,R12                                                TSO15850
         LA        R14,SPSAVE          ADDRESS OF MY SAVE AREA          TSO15860
         ST        R13,4(R14)          SAVE CALLER'S                    TSO15870
         ST        R14,8(R13)                                           TSO15880
         LR        R13,R14                                              TSO15890
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 TSO15900
         L         R11,=A(PARMS)                                        TSO15910
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         TSO15920
         SR        R9,R9                                                TSO15930
         MVC       PHDR,SSOH           ADD SOH TO PACKET                TSO15940
         CLC       LSDAT,SIZE          NEED DATA SIZE <= SPSIZ-5        TSO15950
         BNH       FINE                                                 TSO15960
         MVI       ERRNUM,X'00'        DATA SIZE EXCEEDS MAX LIMIT      TSO15970
         MVI       STATE,C'A'          ABORT ON THIS                    TSO15980
         B         SPRET                                                TSO15990
FINE     L         R4,=F'35'           USE ^o43 TO OFFSET DATA          TSO16000
         A         R4,LSDAT            ADD IT TO LSDAT                  TSO16010
         STC       R4,PLEN                                              TSO16020
         AR        R9,R4               AND THEN ADD IT TO CHECKSUM      TSO16030
         CLC       N,ZERO              CHECK IF N IS VALID              TSO16040
         BNL       T1                  OK IF >= TO 0                    TSO16050
         MVI       ERRNUM,X'01'        ILLEGAL MESSAGE NUMBER           TSO16060
         MVI       STATE,C'A'                                           TSO16070
         B         SPRET                                                TSO16080
T1       CLC       N,O1H               SEE IF IS <= OCTAL 100           TSO16090
         BNH       T2                                                   TSO16100
         MVI       ERRNUM,X'01'        ILLEGAL MESSAGE NUMBER           TSO16110
         MVI       STATE,C'A'                                           TSO16120
         B         SPRET                                                TSO16130
T2       L         R4,SPACE            OFFSET THIS VALUE TOO            TSO16140
         A         R4,N                ADD IT TO N                      TSO16150
         ST        R4,TEMP                                              TSO16160
         MVC       PNUM(1),TEMP+3                                       TSO16170
         A         R9,TEMP             AND ADD TO CHECKSUM              TSO16180
         CLI       STYPE,X'41'         ASCII 'A'                        TSO16190
         BL        T3                  CAN'T BE LESS THAN THIS          TSO16200
         CLI       STYPE,X'5A'         ASCII 'Z'                        TSO16210
         BNH       T4                  CAN'T BE GREATER                 TSO16220
T3       MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              TSO16230
         MVI       STATE,C'A'          DIE ON THIS                      TSO16240
         B         SPRET                                                TSO16250
T4       MVC       PTYPE(1),STYPE      ADD MESSAGE TYPE                 TSO16260
         SR        R2,R2               ZERO IT OUT                      TSO16270
         IC        R2,STYPE                                             TSO16280
         AR        R9,R2               ADD TO CHECKSUM                  TSO16290
         L         R6,LSDAT            HOW MUCH DATA                    TSO16300
         LTR       R6,R6               TEST IT OUT                      TSO16310
         BZ        NODAT                                                TSO16320
         SR        R5,R5               USE TO GET DATA                  TSO16330
         SR        R3,R3               USE TO HOLD DATA                 TSO16340
DATCHK   IC        R3,SDAT(R5)         PICK UP CHAR                     TSO16350
         AR        R9,R3               ADD TO CHECKSUM                  TSO16360
         LA        R5,1(R5)            BUMP POINTER                     TSO16370
         BCTR      R6,0                                                 TSO16380
         LTR       R6,R6               MORE DATA?                       TSO16390
         BNZ       DATCHK                                               TSO16400
NODAT    L         R6,LSDAT            WILL NEED THIS LATER             TSO16410
         LR        R7,R6               MUNGE WHILE IN R7                TSO16420
         BCTR      R7,0                SUBTRACT 1 FOR EX FUNCTION       TSO16430
         EX        R7,MOVE             MOVE THE DATA TO SNDPKT          TSO16440
         ST        R9,TEMP             WE'LL NEED THIS SOON             TSO16450
         N         R9,=X'000000C0'     GET MOD 192                      TSO16460
         M         R8,ONE              CARRY OVER THE SIGN BIT          TSO16470
         D         R8,O1H              GET MOD 64                       TSO16480
         A         R9,TEMP             ADD THE TWO VALUES               TSO16490
         N         R9,=X'0000003F'     GET MOD 64 OF CHECKSUM           TSO16500
         A         R9,SPACE            ADD OFFSET                       TSO16510
         STC       R9,PDATA(R6)        ADD CHECKSUM AFTER DATA          TSO16520
         LA        R6,1(R6)            MOVE POINTER                     TSO16530
         IC        R9,SEOL             ADD SEND END OF PACKET CHAR      TSO16540
         STC       R9,PDATA(R6)                                         TSO16550
         LA        R6,5(R6)            VALUE OF LSDAT+5                 TSO16560
         TR        SNDPKT(130),ATOE    SEND IN EBCDIC                   TSO16570
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        TSO16580
         BZ        SPNODEB                                              TSO16590
         MVC       WRKBUFF(2),=H'20'                                    TSO16600
         XC        WRKBUFF+2(2),WRKBUFF+2                               TSO16610
         MVC       WRKBUFF+4(16),=CL16'TPUT SEND PACKET'                TSO16620
         PUT       DEBUG,WRKBUFF                                        TSO16630
         LA        R1,4(,R6)           ADJUST LENGTH                    TSO16640
         STH       R1,WRKBUFF          SET RDW                          TSO16650
         EX        R6,DBGMVC1          MOVE IN DATA                     TSO16660
         PUT       DEBUG,WRKBUFF                                        TSO16670
SPNODEB  TPUT      SNDPKT,(R6),CONTROL                                  TSO16680
         LTR       R15,R15             WAS THERE ANY ERROR?             TSO16690
         BZ        SPRET               NO, THEN JUST RETURN             TSO16700
         MVI       ERRNUM,10           SET MICRO DIED                   TSO16710
         MVI       STATE,C'A'          ABORT ON THIS                    TSO16720
SPRET    L         R13,4(R13)                                           TSO16730
         L         R14,12(R13)                                          TSO16740
         LM        R0,R12,20(R13)                                       TSO16750
         BR        14                                                   TSO16760
SPSAVE   DS        18F                                                  TSO16770
MOVE     MVC       PDATA(0),SDAT                                        TSO16780
DBGMVC1  MVC       WRKBUFF+4(*-*),SNDPKT                                TSO16790
         LTORG                                                          TSO16800
         DROP      R11                                                  TSO16810
         DROP      R12                 DON'T NEED THEM ANYMORE          TSO16820
         EJECT                                                          TSO16830
**********************************************************************  TSO16840
*                                                                    *  TSO16850
*        ROUTINE TO PROCESS RECEIVE PACKET REQUEST                   *  TSO16860
*                                                                    *  TSO16870
**********************************************************************  TSO16880
RPACK    DS        0H                                                   TSO16890
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          TSO16900
         BALR      R12,0               ESTABLISH ADDRESSABILITY         TSO16910
         USING     *,R12                                                TSO16920
         LA        R14,RPSAVE          ADDRESS OF MY SAVE AREA          TSO16930
         ST        R13,4(R14)          SAVE CALLER'S                    TSO16940
         ST        R14,8(R13)                                           TSO16950
         LR        R13,R14                                              TSO16960
* USE R11 AS BASE REGISTER FOR 'PARMS' GLOBAL DATA AREA                 TSO16970
         L         R11,=A(PARMS)                                        TSO16980
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         TSO16990
         TGET      RECPKT,130,ASIS                                      TSO17000
         LTR       R15,R15             WAS THERE AN ERROR?              TSO17010
         BZ        RPTSTDB             NO, THEN TEST FOR DEBUG          TSO17020
         MVI       RTYPE,AE            SET AN ERROR                     TSO17030
         B         RPRET                                                TSO17040
RPTSTDB  TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        TSO17050
         BZ        RDNODEB                                              TSO17060
         LA        R8,4(,R1)       SAVE LENGTH                          TSO17070
         MVC       WRKBUFF(2),=H'19'                                    TSO17080
         XC        WRKBUFF+2(2),WRKBUFF+2                               TSO17090
         MVC       WRKBUFF+4(15),=CL15'TGET REC PACKET'                 TSO17100
         PUT       DEBUG,WRKBUFF                                        TSO17110
         STH       R8,WRKBUFF          SET RDW                          TSO17120
         EX        R8,DBGMVC2          MOVE IN DATA                     TSO17130
         PUT       DEBUG,WRKBUFF                                        TSO17140
RDNODEB  TR        RECPKT(130),ETOA                                     TSO17150
         NI        FLAGS,X'FF'-FLG4    ASSUME MICRO'LL NAK-NOT RPACK    TSO17160
         SR        R8,R8               INDEX REG FOR RECPKT             TSO17170
         SR        R5,R5               CHECKSUM REGISTER                TSO17180
TRY      LA        R7,RECPKT(R8)       ADDRESS OF CHARACTER             TSO17190
         CLC       RSOH,0(R7)          IS IT START OF HEADER            TSO17200
         BE        READIN              YES; SO FAR, SO GOOD             TSO17210
         LA        R8,1(R8)            TRY NEXT CHARACTER               TSO17220
         C         R8,=F'130'          SEE IF EXCEED BUFFER             TSO17230
         BL        TRY                                                  TSO17240
         MVI       ERRNUM,X'03'        NO "SOH" ERROR                   TSO17250
         B         BADP                                                 TSO17260
READIN   SR        R9,R9               ZERO OUT INDEX REG FOR RDAT      TSO17270
         LA        R8,1(R8)            INCREMENT COUNTER                TSO17280
         LA        R7,RECPKT(R8)       PICK UP LOC OF CHAR COUNT        TSO17290
         CLC       RSOH,0(R7)          IS IT START OF HEADER?           TSO17300
         BE        READIN              START OVER                       TSO17310
         CLC       0(1,R7),DQUOTE      COUNT+' '+3 AND ^d35             TSO17320
         BNL       CONT                CONTINUE IF >=                   TSO17330
         MVI       ERRNUM,X'04'        BAD LENGTH ATTRIBUTE             TSO17340
         B         BADP                                                 TSO17350
CONT     IC        R5,0(R7)            START CHECKSUM                   TSO17360
         LR        R7,R5               MUNGE IN R7 TO GET LRDAT         TSO17370
         S         R7,=F'35'           LENGTH OF DATA                   TSO17380
         STC       R7,LRDAT+3                                           TSO17390
         LA        R8,1(R8)            INCREMENT                        TSO17400
         SR        R7,R7               ZERO IT OUT                      TSO17410
         IC        R7,RECPKT(R8)       PICK UP PACKET NUMBER            TSO17420
         CLM       R7,B'0001',RSOH     IS IT START OF HEADER            TSO17430
         BE        READIN                                               TSO17440
         AR        R5,R7               ADD TO CHECKSUM                  TSO17450
         S         R7,SPACE            SUBTRACT THE ' '                 TSO17460
         STC       R7,NUM+3            NUM := RECEIVED PACKET NO.       TSO17470
         LA        R8,1(R8)            INCREMENT COUNTER                TSO17480
         IC        R7,RECPKT(R8)       PICK UP MESSAGE TYPE             TSO17490
         CLM       R7,B'0001',RSOH     IS IT START OF HEADER?           TSO17500
         BE        READIN                                               TSO17510
         AR        R5,R7               ADD TO CHECKSUM                  TSO17520
         STC       R7,RTYPE            PUT INTO RTYPE                   TSO17530
         LA        R8,1(R8)            GO TO NEXT BYTE                  TSO17540
         L         R4,LRDAT            COUNTER TO GET ALL DATA          TSO17550
LUP      C         R4,ZERO             SEE IF PICKED UP ALL DATA        TSO17560
         BE        FIN                                                  TSO17570
         XC        TEMP,TEMP           ZERO IT OUT                      TSO17580
         LA        R7,RECPKT(R8)       NEXT LOCATION IN BUFFER          TSO17590
         MVC       TEMP+3(1),0(R7)     PICK UP NEXT BYTE                TSO17600
         CLC       RSOH,TEMP+3         IS IT START OF HEADER            TSO17610
         BE        READIN                                               TSO17620
         LA        R7,RDAT(R9)         WHERE THE DATA'S GOING           TSO17630
         MVC       0(1,R7),TEMP+3      AND MOVE IT                      TSO17640
         A         R5,TEMP             ADD TO CHECKSUM                  TSO17650
         LA        R8,1(R8)            ADD ONE                          TSO17660
         LA        R9,1(R9)            ADD ONE                          TSO17670
         BCTR      R4,0                DECREMENT COUNTER                TSO17680
         B         LUP                                                  TSO17690
FIN      SR        R7,R7               ZERO OUT REGISTER                TSO17700
         IC        R7,RECPKT(R8)       GET CHECKSUM                     TSO17710
         CLM       R7,B'0001',RSOH     IS IT START OF HEADER            TSO17720
         BE        READIN                                               TSO17730
         ST        R5,TEMP             WE'LL NEED THIS SOON             TSO17740
         N         R5,=X'000000C0'     GET MOD 192                      TSO17750
         M         R4,ONE              CARRY OVER THE SIGN BIT          TSO17760
         D         R4,O1H              GET MOD 64                       TSO17770
         A         R5,TEMP             ADD THE TWO VALUES               TSO17780
         N         R5,=X'0000003F'     GET MOD 64                       TSO17790
         A         R5,SPACE            ADD OFFSET                       TSO17800
         CR        R5,R7               COMPUTED VS RECEIVED CHECKSUM    TSO17810
         BE        RPRET                                                TSO17820
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN                     TSO17830
         BZ        NODEBG2                                              TSO17840
         MVC       WRKBUFF(2),=H'18'                                    TSO17850
         XC        WRKBUFF+2(2),WRKBUFF+2                               TSO17860
         MVC       WRKBUFF+4(14),=CL14'CHECKSUM ERROR'                  TSO17870
         PUT       DEBUG,WRKBUFF                                        TSO17880
NODEBG2  MVI       ERRNUM,X'05'        BAD CHECKSUM ERROR               TSO17890
BADP     MVI       RTYPE,AN            RETURN A NAK                     TSO17900
         OI        FLAGS,FLG4          RPACK NAK'ED THE PACKET          TSO17910
RPRET    L         R13,4(R13)                                           TSO17920
         L         R14,12(R13)                                          TSO17930
         LM        R0,R12,20(R13)                                       TSO17940
         BR        14                                                   TSO17950
DBGMVC2  MVC       WRKBUFF+4(*-*),RECPKT                                TSO17960
RPSAVE   DS        18F                                                  TSO17970
         LTORG                                                          TSO17980
         DROP      R11                                                  TSO17990
         DROP      R12                 DON'T NEED THEM ANYMORE          TSO18000
         EJECT                                                          TSO18010
**********************************************************************  TSO18020
*                                                                    *  TSO18030
*  DISK FILE READ ROUTE WITH DEBUGGING CODE                          *  TSO18040
*                                                                    *  TSO18050
**********************************************************************  TSO18060
READX    DS        0H                                                   TSO18070
         USING     PARMS,R11           ESTABLISH ADDRESSABILITY         TSO18080
         STM       R12,R15,READSAVE                                     TSO18090
         BALR      R12,0                                                TSO18100
         USING     *,R12                                                TSO18110
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECV  VARIABLE?           TSO18120
         BO        RDVAR                                                TSO18130
         GET       KERIN,BUF                                            TSO18140
         B         RDTSTDB                                              TSO18150
RDVAR    GET       KERIN,BUF-4                                          TSO18160
RDTSTDB  TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        TSO18170
         BZ        RDNODBG                                              TSO18180
         MVC       WRKBUFF(2),=H'12'                                    TSO18190
         XC        WRKBUFF+2(2),WRKBUFF+2                               TSO18200
         MVC       WRKBUFF+4(8),=CL8'QSAM GET'                          TSO18210
         PUT       DEBUG,WRKBUFF                                        TSO18220
         LH        R1,KERIN+(DCBLRECL-IHADCB)                           TSO18230
         STH       R1,WRKBUFF                                           TSO18240
         EX        R1,DBGMVC3                                           TSO18250
         PUT       DEBUG,WRKBUFF                                        TSO18260
RDNODBG  XR        R1,R1               SET RETURN CODE                  TSO18270
         LH        R0,KERIN+(DCBLRECL-IHADCB)  GET RECORD LENGTH        TSO18280
         TM        KERIN+(DCBRECFM-IHADCB),DCBRECV  VARIABLE?           TSO18290
         BZ        *+12                NO, THEN SKIP                    TSO18300
         LH        R0,BUF-4            GET LENGTH FROM RDW              TSO18310
         SH        R0,=H'4'            REMOVE RDW LENGTH                TSO18320
         LM        R12,R15,READSAVE                                     TSO18330
         BR        R15                                                  TSO18340
DBGMVC3  MVC       WRKBUFF+4(*-*),KERIN                                 TSO18350
*                                                                       TSO18360
INEOF    DS        0H                                                   TSO18370
         LA        R1,12                                                TSO18380
         XR        R0,R0                                                TSO18390
         LM        R12,R15,READSAVE                                     TSO18400
         BR        R15                                                  TSO18410
         LTORG                                                          TSO18420
         DROP      R11                                                  TSO18430
         DROP      R12                                                  TSO18440
         EJECT                                                          TSO18450
**********************************************************************  TSO18460
*                                                                    *  TSO18470
*        ROUTINE TO PROCESS RECEIVE COMMAND                          *  TSO18480
*                                                                    *  TSO18490
**********************************************************************  TSO18500
RECEIVE  DS        0H                                                   TSO18510
         STM       R14,R12,12(R13)     SAVE CALLER'S REGISTERS          TSO18520
         BALR      R12,0               ESTABLISH ADDRESSABILITY         TSO18530
         USING     *,R12                                                TSO18540
         LA        R14,RECSAVE         ADDRESS OF MY SAVE AREA          TSO18550
         ST        R13,4(R14)          SAVE CALLER'S                    TSO18560
         ST        R14,8(R13)                                           TSO18570
         LR        R13,R14                                              TSO18580
* USE R11 AS BASE REGISTER FOR THE GLOBAL DATA AREA, 'PARMS'            TSO18590
         L         R11,=A(PARMS)                                        TSO18600
         USING     PARMS,R11                                            TSO18610
         SR        R6,R6               GET ZERO                         TSO18620
         ST        R6,NUMTRY           ZERO THIS OUT                    TSO18630
         ST        R6,N                HERE TOO                         TSO18640
         MVI       STATE,C'R'          SET TO RECEIVE STATE             TSO18650
**********************************************************************  TSO18660
*        MAIN RECEIVE PROCESSING LOOP                                *  TSO18670
**********************************************************************  TSO18680
RLOOP    CLI       STATE,C'D'          RECEIVE DATA STATE               TSO18690
         BE        RDATA                                                TSO18700
         CLI       STATE,C'F'          RECEIVE FILE STATE               TSO18710
         BE        RFILE                                                TSO18720
         CLI       STATE,C'R'          RECEIVE INIT STATE               TSO18730
         BE        RINIT                                                TSO18740
         CLI       STATE,C'C'          COMPLETE STATE                   TSO18750
         BE        RCOMP                                                TSO18760
         CLI       STATE,C'A'          ABORT STATE                      TSO18770
         BE        RABORT                                               TSO18780
         MVI       ERRNUM,X'02'        UNRECOGNIZED STATE               TSO18790
         B         RABORT              ELSE, DIE                        TSO18800
**********************************************************************  TSO18810
*        PROCESS INITIALIZATION PACKET                               *  TSO18820
**********************************************************************  TSO18830
RINIT    CLC       NUMTRY,IMXTRY       SEE IF CAN RECEIVE               TSO18840
         BL        ROK1                YES, WE CAN                      TSO18850
         MVI       STATE,C'A'          NOPE, GO INTO ABORT STATE        TSO18860
         B         RLOOP                                                TSO18870
ROK1     L         R3,NUMTRY                                            TSO18880
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          TSO18890
         ST        R3,NUMTRY                                            TSO18900
         L         R4,DSSIZ            DEFAULT SEND PACKET SIZE         TSO18910
         S         R4,FIVE             USE DEFAULT TO SET "SIZE"        TSO18920
         ST        R4,SIZE             IN CASE WE DIE BEFORE IT'S SET   TSO18930
         L         R15,=A(RPACK)       GET INIT INFORMATION             TSO18940
         BALR      R14,R15                                              TSO18950
         CLI       RTYPE,AE            ERROR PACKET?                    TSO18960
         BNE       RY1                 ALL OK                           TSO18970
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO18980
         MVI       STATE,C'A'          SO WE DO TOO                     TSO18990
         B         RLOOP                                                TSO19000
RY1      CLI       RTYPE,AS            IS IT A SEND-INIT PACKET         TSO19010
         BNE       RN1                 MAYBE IT GOT CLOBBERED           TSO19020
         SR        R4,R4               ZERO OUT REGISTER                TSO19030
         IC        R4,RDAT             GET FIRST CHARACTER              TSO19040
         S         R4,SPACE            SUBTRACT THE ' '                 TSO19050
         C         R4,=F'26'           MIN SPACK SIZE                   TSO19060
         BNL       RCH1                SO FAR, SO GOOD                  TSO19070
         MVI       STATE,C'A'          ELSE, ABORT                      TSO19080
         MVI       ERRNUM,X'00'        INVALID DATA-PACKET-SIZE ERROR   TSO19090
         B         RLOOP                                                TSO19100
RCH1     C         R4,MAXPACK          MAX PACKET SIZE                  TSO19110
         BNH       RCH2                                                 TSO19120
         MVI       STATE,C'A'          ABORT IF SIZE IS ILLEGAL         TSO19130
         MVI       ERRNUM,X'00'        BAD SEND DATA LENGTH             TSO19140
         B         RLOOP                                                TSO19150
RCH2     STC       R4,SPSIZ+3          USE THE VALUE AS SEND SIZE       TSO19160
         S         R4,FIVE                                              TSO19170
         ST        R4,SIZE             SET IT TO SPSIZ-5                TSO19180
         CLC       LRDAT(4),=F'4'      USING ALL DEFAULTS ?             TSO19190
         BNH       NOCH                YUP                              TSO19200
         LA        R5,RDAT             POINT TO THE BUFFER              TSO19210
         SR        R7,R7                                                TSO19220
         IC        R7,4(R5)            SEOL THE MICRO WANTS             TSO19230
         S         R7,SPACE            UNCHAR (SUBTRACT ' ')            TSO19240
         STC       R7,SEOL                                              TSO19250
         CLC       LRDAT(4),FIVE       ANY MORE DATA?                   TSO19260
         BNH       NOCH                JUST USE DEFAULTS                TSO19270
         MVC       RQUO(1),5(R5)       SET NEW QUOCHAR VALUE            TSO19280
NOCH     MVC       N(4),NUM            SYNCH PACKET NUMBERS             TSO19290
         MVI       STYPE,AY            SET MESSAGE TYPE TO ACK          TSO19300
         MVC       LSDAT(4),=F'6'     SET LENGTH OF DATA SENDING        TSO19310
         L         R5,SPACE            MAKE CHARACTER PRINTABLE         TSO19320
         A         R5,RPSIZ            ADD REC PACKET SIZE              TSO19330
         STC       R5,SDAT             ADD SIZE INFO TO BUFFER          TSO19340
         L         R5,SPACE                                             TSO19350
         A         R5,=F'8'            8 FOR TIMEOUT                    TSO19360
         STC       R5,SDAT+1                                            TSO19370
         L         R5,SPACE            SEND ZERO + " " FOR NPAD         TSO19380
         STC       R5,SDAT+2           WE'RE THE SLOW GUYS              TSO19390
         SR        R5,R5               PAD WITH NULLS                   TSO19400
         L         R3,O1H                                               TSO19410
         XR        R5,R3               CTL FUNCTION (XOR WITH 64)       TSO19420
         STC       R5,SDAT+3           DON'T NEED PADCHAR EITHER        TSO19430
         SR        R5,R5               ZERO IT OUT FOR NEXT TWO GUYS    TSO19440
         IC        R5,REOL             EOL CHAR I NEED                  TSO19450
         A         R5,SPACE            MAKE PRINTABLE                   TSO19460
         STC       R5,SDAT+4                                            TSO19470
         IC        R5,QUOCHAR          MY QUOTE CHAR                    TSO19480
         STC       R5,SDAT+5                                            TSO19490
         L         R15,=A(SPACK)       ADDRESS OF SPACK                 TSO19500
         BALR      R14,R15             SAVE * AND GO TO SPACK           TSO19510
         CLI       STATE,C'A'                                           TSO19520
         BE        RABORT                                               TSO19530
         MVI       STATE,C'F'          SET TO RECEIVE FILE STATE        TSO19540
         MVC       OLDTRY(4),NUMTRY    SAVE TRIAL COUNTER               TSO19550
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            TSO19560
         L         R3,N                                                 TSO19570
         LA        R3,1(R3)            ADD ONE                          TSO19580
         ST        R3,N                STORE VALUE INCREMENTED BY 1     TSO19590
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO19600
         B         RLOOP                                                TSO19610
RN1      CLI       RTYPE,AN            MAYBE IT'S A NAK                 TSO19620
         BNE       RSELSE                                               TSO19630
         MVI       STYPE,AN            SEND A NAK PACKET                TSO19640
         XC        LSDAT,LSDAT         NO DATA                          TSO19650
         L         R15,=A(SPACK)                                        TSO19660
         BALR      R14,R15                                              TSO19670
         B         RLOOP                                                TSO19680
RSELSE   MVI       STATE,C'A'          ELSE,ABORT                       TSO19690
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              TSO19700
         B         RLOOP                                                TSO19710
**********************************************************************  TSO19720
*        PROCESS FILE PACKET                                         *  TSO19730
**********************************************************************  TSO19740
RFILE    CLC       NUMTRY,MAXTRY       EXCEEDED NO. OF TRIALS ALLOWED   TSO19750
         BL        ROK2                NOPE, STILL OK                   TSO19760
         MVI       STATE,C'A'          ABORT IF YES                     TSO19770
         B         RLOOP                                                TSO19780
ROK2     L         R3,NUMTRY                                            TSO19790
         LA        R3,1(R3)            INCREMENT TRIAL COUNTER          TSO19800
         ST        R3,NUMTRY                                            TSO19810
         L         R15,=A(RPACK)       GET ADDRESS OF RPACK             TSO19820
         BALR      R14,R15             GO THERE AND RETURN WHEN DONE    TSO19830
         CLI       RTYPE,AE            ERROR PACKET?                    TSO19840
         BNE       RY2                 MAYBE AN ACK                     TSO19850
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO19860
         MVI       STATE,C'A'          SO WE DO TOO                     TSO19870
         B         RLOOP                                                TSO19880
RY2      CLI       RTYPE,AS            STILL IN INIT STATE?             TSO19890
         BNE       RNZ                 TRY FOR AN EOF                   TSO19900
         CLC       OLDTRY,MAXTRY       CAN WE TRY AGAIN?                TSO19910
         BL        ROLD                                                 TSO19920
         MVI       STATE,C'A'          ELSE, ABORT                      TSO19930
         B         RLOOP                                                TSO19940
ROLD     L         R3,OLDTRY                                            TSO19950
         LA        R3,1(R3)            INCREMENT COUNTER                TSO19960
         ST        R3,OLDTRY                                            TSO19970
         L         R3,N                GET PACKET NUMBER SENT           TSO19980
         BCTR      R3,0                SUBTRACT ONE FROM IT             TSO19990
         C         R3,NUM              NUM MUST EQUAL N-1               TSO20000
         BE        RNUM                                                 TSO20010
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          TSO20020
         B         RNAK                SEND A NAK                       TSO20030
RNUM     MVI       STYPE,AY            ACK PACKET                       TSO20040
         ST        R3,N                MAKE SEND SEQ NO. = N-1          TSO20050
         MVC       LSDAT(4),=F'6'     SET DATA LENGTH VARIABLE          TSO20060
         L         R15,=A(SPACK)                                        TSO20070
         BALR      R14,R15             GO TO SPACK AND RETURN           TSO20080
         CLI       STATE,C'A'                                           TSO20090
         BE        RABORT                                               TSO20100
         L         R4,N                                                 TSO20110
         LA        R4,1(R4)            ADD ONE                          TSO20120
         ST        R4,N                RESTORE N TO PROPER VALUE        TSO20130
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            TSO20140
         B         RLOOP                                                TSO20150
RNZ      CLI       RTYPE,AZ                                             TSO20160
         BNE       RNF                 MAYBE IT'S AN 'F'                TSO20170
         CLC       OLDTRY,MAXTRY       CAN WE TRY AGAIN?                TSO20180
         BL        ROLD2                                                TSO20190
         MVI       STATE,C'A'          ELSE,ABORT                       TSO20200
         B         RLOOP                                                TSO20210
ROLD2    L         R3,OLDTRY                                            TSO20220
         LA        R3,1(R3)            INCREMENT COUNTER                TSO20230
         ST        R3,OLDTRY                                            TSO20240
         L         R3,N                GET PACKET NUMBER SENT           TSO20250
         BCTR      R3,0                SUBTRACT ONE FROM IT             TSO20260
         C         R3,NUM              NUM MUST EQUAL N-1               TSO20270
         BE        RNUM2                                                TSO20280
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          TSO20290
         B         RNAK                SEND A NAK                       TSO20300
RNUM2    MVI       STYPE,AY            ACK PACKET                       TSO20310
         ST        R3,N                SEND SEQ := N-1                  TSO20320
         XC        LSDAT,LSDAT         NO DATA                          TSO20330
         L         R15,=A(SPACK)                                        TSO20340
         BALR      R14,R15                                              TSO20350
         CLI       STATE,C'A'                                           TSO20360
         BE        RABORT                                               TSO20370
         L         R4,N                                                 TSO20380
         LA        R4,1(R4)            ADD ONE                          TSO20390
         ST        R4,N                RESTORE N TO PROPER VALUE        TSO20400
         XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            TSO20410
         B         RLOOP                                                TSO20420
RNF      CLI       RTYPE,AF                                             TSO20430
         BNE       RNB                 WELL, IT'S NOT A FNAME           TSO20440
         CLC       NUM,N               THEY HAVE TO BE EQUAL            TSO20450
         BE        RNUM3                                                TSO20460
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          TSO20470
         B         RNAK                SEND A NAK                       TSO20480
RNUM3    MVI       STYPE,AY            ACK PACKET                       TSO20490
         XC        LSDAT,LSDAT         NO DATA                          TSO20500
OVER     L         R15,=A(SPACK)                                        TSO20510
         BALR      R14,R15             SEND ACK                         TSO20520
         CLI       STATE,C'A'                                           TSO20530
         BE        RABORT                                               TSO20540
         MVC       OLDTRY(4),NUMTRY    KEEP NUMTRY FOR LATER            TSO20550
         XC        NUMTRY,NUMTRY       RESET TO ZERO                    TSO20560
         L         R3,N                                                 TSO20570
         LA        R3,1(R3)            ADD ONE                          TSO20580
         ST        R3,N                INCREMENT COUNTER                TSO20590
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO20600
         MVI       STATE,C'D'          DATA RECEIVE STATE               TSO20610
         B         RLOOP                                                TSO20620
RNB      CLI       RTYPE,AB            SEE IF IT'S A BREAK              TSO20630
         BNE       RNN                 MAYBE GOT A NAK                  TSO20640
         CLC       NUM,N                                                TSO20650
         BE        RNUM4                                                TSO20660
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          TSO20670
         B         RNAK                SEND A NAK                       TSO20680
RNUM4    MVI       STYPE,AY            ACK PACKET                       TSO20690
         XC        LSDAT,LSDAT         NO DATA                          TSO20700
         L         R15,=A(SPACK)                                        TSO20710
         BALR      R14,R15                                              TSO20720
         CLI       STATE,C'A'                                           TSO20730
         BE        RABORT                                               TSO20740
         MVI       STATE,C'C'          COMPLETE STATE                   TSO20750
         B         RLOOP                                                TSO20760
RNN      CLI       RTYPE,AN            SEE IF GOT A NAK                 TSO20770
         BNE       RNELSE                                               TSO20780
RNAK     MVI       STYPE,AN            SEND A NAK PACKET                TSO20790
         XC        LSDAT,LSDAT         NO DATA                          TSO20800
         L         R15,=A(SPACK)                                        TSO20810
         BALR      R14,R15                                              TSO20820
         B         RLOOP               DO NOTHING ON A NAK              TSO20830
RNELSE   MVI       STATE,C'A'          ABORT OTHERWISE                  TSO20840
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              TSO20850
         B         RLOOP                                                TSO20860
**********************************************************************  TSO20870
*        RECEIVE DATA PACKETS                                        *  TSO20880
**********************************************************************  TSO20890
RDATA    CLC       NUMTRY,MAXTRY       HAVE WE EXCEEDED OUR LIMIT?      TSO20900
         BL        ROK3                                                 TSO20910
         MVI       STATE,C'A'          ELSE, ABORT                      TSO20920
         B         RLOOP                                                TSO20930
ROK3     L         R4,NUMTRY                                            TSO20940
         LA        R4,1(R4)            INCREMENT                        TSO20950
         ST        R4,NUMTRY           SAVE INCREMENTED COUNTER         TSO20960
         L         R15,=A(RPACK)                                        TSO20970
         BALR      R14,R15             CALL RPACK                       TSO20980
         CLI       RTYPE,AE            ERROR PACKET?                    TSO20990
         BNE       RY3                 MAYBE AN ACK                     TSO21000
         MVI       ERRNUM,X'0A'        MICRO DIED                       TSO21010
         MVI       STATE,C'A'          WE ABORT TOO                     TSO21020
         B         RLOOP                                                TSO21030
RY3      CLI       RTYPE,AD            IS THIS A DATA PACKET?           TSO21040
         BNE       RDF                 MAYBE IT'S AN FNAME PACKET       TSO21050
         CLC       N,NUM               CHECK FOR RIGHT PACKET           TSO21060
         BNE       DIF                                                  TSO21070
         L         R15,=A(PTCHR)                                        TSO21080
         BALR      R14,R15             PUT CHARACTERS INTO FILE         TSO21090
         LTR       R7,R7               CHECK FOR NO ERROR               TSO21100
         BZ        OKWR                NO ERROR                         TSO21110
         MVI       STATE,C'A'          ABORT ON FILE SYSTEM ERROR       TSO21120
         B         RLOOP                                                TSO21130
OKWR     MVI       STYPE,AY            ACK PACKET                       TSO21140
         XC        LSDAT,LSDAT         NO DATA                          TSO21150
         L         R15,=A(SPACK)                                        TSO21160
         BALR      R14,R15                                              TSO21170
         CLI       STATE,C'A'                                           TSO21180
         BE        RABORT                                               TSO21190
         MVC       OLDTRY(4),NUMTRY    SAVE NUMTRY'S VALUE IN OLDTRY    TSO21200
         XC        NUMTRY,NUMTRY       RESET NUMTRY                     TSO21210
         L         R3,N                                                 TSO21220
         LA        R3,1(R3)                                             TSO21230
         ST        R3,N                INCREMENT COUNTER                TSO21240
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO21250
         B         RLOOP                                                TSO21260
DIF      CLC       OLDTRY,MAXTRY       CAN WE DO IT?                    TSO21270
         BL        DIFNUM                                               TSO21280
         MVI       STATE,C'A'          AND ABORT                        TSO21290
         B         RLOOP                                                TSO21300
DIFNUM   L         R4,OLDTRY                                            TSO21310
         LA        R4,1(R4)                                             TSO21320
         ST        R4,OLDTRY           INCREMENT THIS COUNTER           TSO21330
         L         R4,N                                                 TSO21340
         BCTR      R4,0                                                 TSO21350
         C         R4,NUM              NUM MUST EQUAL N-1               TSO21360
         BE        DIFOK                                                TSO21370
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          TSO21380
         B         RDN1                SEND A NAK                       TSO21390
DIFOK    XC        NUMTRY,NUMTRY       RESET COUNTER TO ZERO            TSO21400
         MVI       STYPE,AY            ACK PACKET                       TSO21410
         XC        LSDAT,LSDAT         NO DATA                          TSO21420
         ST        R4,N                SET N TO N-1 TO RESEND PACKET    TSO21430
         L         R15,=A(SPACK)                                        TSO21440
         BALR      R14,R15             SEND THE PACKET                  TSO21450
         CLI       STATE,C'A'                                           TSO21460
         BE        RABORT                                               TSO21470
         L         R4,N                                                 TSO21480
         LA        R4,1(R4)            ADD ONE                          TSO21490
         ST        R4,N                RESTORE N TO PROPER VALUE        TSO21500
         B         RLOOP               AND RETURN                       TSO21510
RDF      CLI       RTYPE,AF            SENDING FILENAME AGAIN?          TSO21520
         BNE       RDZ                                                  TSO21530
         CLC       OLDTRY,MAXTRY       CAN WE DO IT?                    TSO21540
         BL        FILOVER             TRYING IT AGAIN                  TSO21550
         MVI       STATE,C'A'          IF NO, ABORT                     TSO21560
         B         RLOOP                                                TSO21570
FILOVER  L         R4,OLDTRY                                            TSO21580
         LA        R4,1(R4)                                             TSO21590
         ST        R4,OLDTRY           SAVE INCREMENTED VALUE           TSO21600
         L         R4,N                                                 TSO21610
         BCTR      R4,0                NEED VALUE OF N-1                TSO21620
         C         R4,NUM              N-1 MUST EQUAL NUM               TSO21630
         BE        FILOK                                                TSO21640
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          TSO21650
         B         RDN1                SEND A NAK                       TSO21660
FILOK    XC        NUMTRY,NUMTRY       RESET TO ZERO                    TSO21670
         XC        LSDAT,LSDAT         NO DATA                          TSO21680
         MVI       STYPE,AY            ACK PACKET AGAIN                 TSO21690
         ST        R4,N                SET N TO N-1 FOR NOW             TSO21700
OVRWRT   L         R15,=A(SPACK)                                        TSO21710
         BALR      R14,R15                                              TSO21720
         CLI       STATE,C'A'                                           TSO21730
         BE        RABORT                                               TSO21740
         L         R4,N                                                 TSO21750
         LA        R4,1(R4)            ADD ONE                          TSO21760
         ST        R4,N                RESTORE N TO PROPER VALUE        TSO21770
         B         RLOOP               AND RETURN                       TSO21780
RDZ      CLI       RTYPE,AZ            IS THIS AN EOF PACKET?           TSO21790
         BNE       RDN                                                  TSO21800
         CLC       N,NUM               ARE THEY EQUAL                   TSO21810
         BE        RDOK                                                 TSO21820
         MVI       ERRNUM,X'08'        PREVIOUS PACKET MISSING          TSO21830
         B         RDN1                SEND A NAK                       TSO21840
RDOK     MVI       STYPE,AY            ACK THE PACKET                   TSO21850
         XC        LSDAT,LSDAT         NO DATA                          TSO21860
         L         R15,=A(SPACK)                                        TSO21870
         BALR      R14,R15                                              TSO21880
         MVC       OLDTRY(4),NUMTRY    SAVE NUMTRY'S VALUE HERE         TSO21890
         XC        NUMTRY,NUMTRY       AND RESET COUNTER                TSO21900
         L         R3,N                                                 TSO21910
         LA        R3,1(R3)                                             TSO21920
         ST        R3,N                STORE VALUE INCREMENTED BY 1     TSO21930
         NC        N(4),=X'0000003F'   MASK TO GET MOD 64               TSO21940
         MVI       STATE,C'F'          TRY FOR ANOTHER FILE             TSO21950
         B         RLOOP                                                TSO21960
RDN      CLI       RTYPE,AN            DO WE NEED TO SEND A NAK?        TSO21970
         BNE       RDELSE                                               TSO21980
RDN1     MVI       STYPE,AN            SEND A NAK                       TSO21990
         XC        LSDAT,LSDAT         NO DATA                          TSO22000
         L         R15,=A(SPACK)                                        TSO22010
         BALR      R14,R15                                              TSO22020
         B         RLOOP                                                TSO22030
RDELSE   MVI       STATE,C'A'          UNRECOGNIZED PACKET - ABORT      TSO22040
         MVI       ERRNUM,X'07'        ILLEGAL PACKET TYPE              TSO22050
         B         RLOOP                                                TSO22060
SAYNO    MVI       STYPE,AN            SEND A NAK PACKET                TSO22070
         XC        LSDAT,LSDAT         NO DATA                          TSO22080
         MVI       ERRNUM,X'0B'        ILLEGAL FILENAME ERROR           TSO22090
         L         R15,=A(SPACK)                                        TSO22100
         BALR      R14,R15                                              TSO22110
         B         RLOOP                                                TSO22120
**********************************************************************  TSO22130
*        RECEIVE ABORT PROCESS                                       *  TSO22140
**********************************************************************  TSO22150
RABORT   DS        0H                                                   TSO22160
         CLI       ERRNUM,X'0A'        DID THE MICRO DIE?               TSO22170
         BE        RNOERRP             NO ERROR PACKET IF SO            TSO22180
         MVI       STYPE,AE            ERROR PACKET                     TSO22190
         MVC       LSDAT(4),=F'20'     ALL MSGS ARE THIS LONG           TSO22200
         MVC       N(4),NUM            SYNCH PACKET NUMBERS             TSO22210
         SR        R5,R5                                                TSO22220
         IC        R5,ERRNUM                                            TSO22230
         M         R4,=F'20'           OFFSET := ERRNUM * 20            TSO22240
         LA        R5,ERRTAB(R5)                                        TSO22250
         MVC       SDAT(20),0(R5)      SPACK NEEDS THE DATA HERE        TSO22260
         TR        SDAT(20),ETOA                                        TSO22270
         L         R15,=A(SPACK)                                        TSO22280
         BALR      R14,R15             SEND ERROR PACKET & DIE          TSO22290
RNOERRP  LA        R15,4               SET A NON-ZERO RETCODE           TSO22300
         B         RECRET              PREPARE TO LEAVE                 TSO22310
**********************************************************************  TSO22320
*        RECEIVE COMPLETE PROCESS                                    *  TSO22330
**********************************************************************  TSO22340
RCOMP    SR        R15,R15             RETCODE OF ZERO                  TSO22350
RECRET   L         R13,4(R13)                                           TSO22360
         L         R14,12(R13)                                          TSO22370
         LM        R0,R12,20(R13)                                       TSO22380
         BR        14                                                   TSO22390
         EJECT                                                          TSO22400
**********************************************************************  TSO22410
*                                                                    *  TSO22420
*  ROUTINE TO PUT A CHARACTER IN OUTPUT BUFFER AND DUMP WHEN FULL    *  TSO22430
*                                                                    *  TSO22440
**********************************************************************  TSO22450
PTCHR    SR        R4,R4               USE TO HOLD QUOCHAR              TSO22460
         SR        R6,R6               USE TO HOLD LRECL                TSO22470
         SR        R8,R8               COUNTER WITHIN RDAT              TSO22480
         L         R9,RSAVPL           COUNTER WITHIN RBUF              TSO22490
         IC        R4,RQUO                                              TSO22500
         IC        R6,LRECL                                             TSO22510
         L         R5,LRDAT            COUNTER TO GET ALL DATA          TSO22520
RLUP     SR        R7,R7               USE TO PICK UP CHAR              TSO22530
         LTR       R5,R5               MORE DATA LEFT?                  TSO22540
         BNZ       MOR                 LEAVE IF ALL DONE                TSO22550
         CLI       PREV,X'4D'          ARE WE IN MIDDLE OF LINE?        TSO22560
         BER       R14                 LEAVE IF NOT                     TSO22570
         ST        R9,RSAVPL           SAVE OUR PLACE                   TSO22580
         SR        R7,R7               ZERO RETCODE                     TSO22590
         BR        R14                                                  TSO22600
MOR      BCTR      R5,0                DECREMENT CHAR COUNTER           TSO22610
         IC        R7,RDAT(R8)         GET DATA FROM RDAT               TSO22620
         CR        R7,R4               IS IT THE QUOTE CHARACTER?       TSO22630
         BNE       REGULAR                                              TSO22640
         BCTR      R5,0                DECREMENT CHAR COUNT             TSO22650
         LA        R8,1(R8)            MOVE POINTER                     TSO22660
         IC        R7,RDAT(R8)         PICK UP SPECIAL CHAR             TSO22670
         C         R7,=X'0000004D'     IS IT A CR? (CHAR(CR))           TSO22680
         BNE       NOCR                WRITE OUT RECORD IF YES          TSO22690
         MVI       PREV,X'4D'          JUST HAD A CR                    TSO22700
         LA        R8,1(R8)            IGNORE CONTROL CHAR              TSO22710
         B         RFIN                                                 TSO22720
NOCR     C         R7,=X'0000004A'     HOW ABOUT A LF? (CHAR(LF))       TSO22730
         BNE       NOLF                IF YES, WRITE OUT RECORD         TSO22740
         LA        R8,1(R8)            IGNORE CONTROL CHAR              TSO22750
         CLI       PREV,X'4D'          WAS LAST THING CR?               TSO22760
         BNE       RFIN                NOPE, THEN KEEP ON               TSO22770
         B         RLUP                IGNORE LF IF PREV=CR             TSO22780
NOLF     CR        R7,R4               IS IT THE QUOCHAR                TSO22790
         BE        REGULAR             DON'T CONVERT IF IT IS           TSO22800
         A         R7,O1H              ADD ^O100                        TSO22810
         N         R7,=X'0000007F'     GET MOD ^O200                    TSO22820
REGULAR  STC       R7,RBUF(R9)         STORE CHAR IN RBUF               TSO22830
         LA        R9,1(R9)            MOVE RBUF COUNTER                TSO22840
         LA        R8,1(R8)            MOVE RDAT COUNTER                TSO22850
         MVI       PREV,X'00'          BLANK OUT CR IF WAS THERE        TSO22860
         C         R9,=F'255'          ONLY 256 CHARS ALLOWED           TSO22870
         BNH       RLUP                AND CONTINUE                     TSO22880
         LR        R10,R9              USE MAX LENGTH OF 256            TSO22890
         B         WRFIL               AND WRITE TO FILE                TSO22900
RFIN     LTR       R10,R9              GET DATA SIZE                    TSO22910
         BZ        FUDGE               GOTTA FAKE A BLANK LINE          TSO22920
         C         R7,=X'0000004D'     IS IT A CR?  (CHAR(CR))          TSO22930
         BE        WRFIL                                                TSO22940
         C         R7,=X'0000004A'     HOW ABOUT A LF? (CHAR(LF))       TSO22950
         BE        WRFIL                                                TSO22960
         ST        R10,RSAVPL          SAVE DATA RECEIVED SO FAR        TSO22970
         SR        R7,R7               ZERO RETCODE                     TSO22980
         BR        14                                                   TSO22990
FUDGE    MVI       RBUF,X'20'          MAKE FIRST CHAR A SPACE          TSO23000
         LA        R10,1(R10)          LENGTH OF ONE                    TSO23010
WRFIL    XC        RSAVPL,RSAVPL       RESET THE POINTER                TSO23020
         TR        RBUF(256),ATOE      MAKE EBCDIC AGAIN                TSO23030
         CLI       RFM,C'V'            IS IT VARIABLE FORMAT?           TSO23040
         BE        VAR                                                  TSO23050
         CR        R10,R6                                               TSO23060
         BH        PUR                 IGNORE DATA AFTER LRECL VALUE    TSO23070
         CR        R10,R6              PAD OUT TO LRECL SIZE ?          TSO23080
         BE        VAR                 NOPE, IT'S OK.                   TSO23090
         LR        R2,R6               GET LRECL SIZE                   TSO23100
         SR        R2,R10              PAD WITH THIS MANY SPACES        TSO23110
         BCTR      R2,0                MINUS ONE FOR THE 'EX'           TSO23120
         LA        R9,RBUF(R10)        START PADDING HERE               TSO23130
         MVI       0(R9),C' '          PUT IN THE FIRST SPACE           TSO23140
         LTR       R2,R2                                                TSO23150
         BZ        PUR                 DON'T PAD IF SIZE DIF WAS ONE    TSO23160
         BCTR      R2,0                SUBRTRACT SPACE WE JUST ADDED    TSO23170
         EX        R2,PAD              PAD OUT BUFFER                   TSO23180
PUR      LR        R10,R6              LENGTH HAS TO BE THIS SIZE       TSO23190
VAR      DS        0H                                             RJR   TSO23200
         LA        R15,WRITEX                                           TSO23210
         BALR      R15,R15                                              TSO23220
         SR        R9,R9               START AT BEGINNING OF RBUF       TSO23230
         B         RLUP                GET NEXT LINE IF OK              TSO23240
RECSAVE  DS        18F                                                  TSO23250
PAD      MVC       1(0,R9),0(R9)       PAD OUT WITH SPACES              TSO23260
         LTORG                                                          TSO23270
*                                                                       TSO23280
         EJECT                                                          TSO23290
**********************************************************************  TSO23300
*                                                                    *  TSO23310
*  DISK FILE WRITE ROUTE WITH DEBUGGING CODE                         *  TSO23320
*                                                                    *  TSO23330
**********************************************************************  TSO23340
WRITEX   DS        0H                                                   TSO23350
         USING     PARMS,R11                                            TSO23360
         STM       R12,R15,WRITSAVE                                     TSO23370
         BALR      R12,0                                                TSO23380
         USING     *,R12                                                TSO23390
         LA        R0,RBUF             POINT TO RBUF                    TSO23400
         TM        KEROUT+(DCBRECFM-IHADCB),DCBRECV VARIABLE?           TSO23410
         BZ        WRITEX2             NO, THEN DON'T ADJUST            TSO23420
         LA        R0,RBUF-4           POINT TO RDW                     TSO23430
         LR        R15,R10             GET THE LENGTH                   TSO23440
         AH        R15,=H'4'           INCLUDE LENGTH OF RDW            TSO23450
         SR        R1,R1                                                TSO23460
         STH       R1,RBUF-2           CLEAR RDW                        TSO23470
         IC        R1,LRECL            GET LRECL                        TSO23480
         CR        R15,R1              IS THE RECORD GT MAX LRECL?      TSO23490
         BNH       *+6                 NO, THEN IT'S OK                 TSO23500
         LR        R15,R1              ELSE SET TO MAX                  TSO23510
         STH       R15,RBUF-4                                           TSO23520
WRITEX2  DS        0H                                                   TSO23530
         PUT       KEROUT,(R0)                                          TSO23540
         TM        DEBUG+(DCBOFLGS-IHADCB),DCBOFOPN  IS IT OPEN?        TSO23550
         BZ        WRNODBG                                              TSO23560
         MVC       WRKBUFF(2),=H'12'                                    TSO23570
         XC        WRKBUFF+2(2),WRKBUFF+2                               TSO23580
         MVC       WRKBUFF+4(8),=CL8'QSAM PUT'                          TSO23590
         PUT       DEBUG,WRKBUFF                                        TSO23600
         EX        R10,DBGMVC4                                          TSO23610
         LA        R1,4(,R10)                                           TSO23620
         STH       R1,WRKBUFF                                           TSO23630
         PUT       DEBUG,WRKBUFF                                        TSO23640
WRNODBG  LM        R12,R15,WRITSAVE                                     TSO23650
         BR        R15                                                  TSO23660
DBGMVC4  MVC       WRKBUFF+4(*-*),RBUF                                  TSO23670
         DROP      R11                                                  TSO23680
         DROP      R12                                                  TSO23690
         LTORG                                                          TSO23700
         EJECT                                                          TSO23710
**********************************************************************  TSO23720
*                                                                    *  TSO23730
*        ROUTINE TO PARSE COMMANDS AND CREATE PARSE TABLE            *  TSO23740
*                                                                    *  TSO23750
**********************************************************************  TSO23760
PARSER   STM       R14,R12,12(R13)     SAVE REGISTERS                   TSO23770
         LR        R12,R15             MOVE THE BASE REGISTER           TSO23780
         USING     PARSER,R12          ##                               TSO23790
         L         R11,=A(PARMS)       GET ADDRESS OF WORKAREAS         TSO23800
         USING     PARMS,R11                                            TSO23810
         LR        R3,R0               R3 = TEXT LENGTH                 TSO23820
         BCTR      R1,0                R1 ==> BYTE BEFORE PARM          TSO23830
         LA        R3,0(R1,R3)         R3 ==> END OF LINE               TSO23840
         LA        R2,1                R2 = PARSING INCREMENT           TSO23850
         LA        R5,PTRTBL           R5 ==> TARGET AREA               TSO23860
         LA        R6,4                R6 = POINTER INCREMENT           TSO23870
         STM       R5,R6,PARSELST      SAVE FOR PARSING                 TSO23880
         LA        R7,PTRTBL+PTRTBLL-4 R7 ==> END OF TARGET             TSO23890
*                                                                       TSO23900
SCNTOKEN BXH       R1,R2,SCNFINIS      SCAN FOR PARM START              TSO23910
         CLI       0(R1),C' '          FOUND A BLANK?                   TSO23920
         BE        SCNTOKEN            YES, THEN KEEP LOOKING           TSO23930
         ST        R1,0(,R5)           SAVE PTR TO OPERAND              TSO23940
         BXH       R5,R6,SCNFINIS      BR ON END OF TARGET AREA         TSO23950
SCNLASTC BXH       R1,R2,SCNFINIS      SCAN TO END OF OPERAND           TSO23960
         CLI       0(R1),C' '          IS THIS BLANK AT END OF OPERAND  TSO23970
         BNE       SCNLASTC            IF SO, MOVE TOKEN                TSO23980
         LR        R9,R1               REMEMBER JUST AFTER OPERAND      TSO23990
         B         SCNTOKEN            FIND START OF NEXT OPERAND       TSO24000
SCNFINIS MVI       0(R9),C' '          MARK THE END OF OPERANDS         TSO24010
         ST        R9,0(R5)            SAVE POINTER TO END              TSO24020
         ST        R5,PARSELST+8       SAVE END TARGET                  TSO24030
         LM        R14,R12,12(R13)     RESTORE THE REGISTERS            TSO24040
         BR        R14                 RETURN TO CALLER                 TSO24050
         LTORG                                                          TSO24060
         DROP      R11                                                  TSO24070
         DROP      R12                 DON'T NEED THEM ANYMORE          TSO24080
         EJECT                                                          TSO24090
PARMS    DS        0H                  GLOBAL DATA LIST                 TSO24100
         USING PARMS,R11                                                TSO24110
SNDPKT   DS        CL130               SEND THIS TO MICRO               TSO24120
         ORG       SNDPKT                                               TSO24130
PHDR     DS        X                                                    TSO24140
PLEN     DS        X                                                    TSO24150
PNUM     DS        X                                                    TSO24160
PTYPE    DS        X                                                    TSO24170
PDATA    DS        0C                                                   TSO24180
         ORG       ,                                                    TSO24190
RECPKT   DS        CL130               RECEIVE THIS FROM MICRO          TSO24200
LSDAT    DS        F                   SEND PACKET SIZE                 TSO24210
LRDAT    DS        F                   RECEIVE PACKET SIZE              TSO24220
FLAGS    DC        X'00'               USE TO TEST OUR FLAGS            TSO24230
NAME     DC        18X'20'             NAME OF FILE(S) TO SEND          TSO24240
         DS        0F                                                   TSO24250
         DS        0F                                                   TSO24260
INPUT    DS        CL130               INPUT BUFFER                     TSO24270
         DS        0F                                                   TSO24280
         DS        F                   RDW FOR VARIABLE RECORDS         TSO24290
BUF      DS        CL260               DISK READ INTO HERE              TSO24300
         DS        F                   RDW FOR VARIABLE RECORDS         TSO24310
RBUF     DS        CL260               DISK WRITE FROM HERE             TSO24320
N        DC        F'0'                SEND PACKET NUMBER               TSO24330
NUM      DC        F'0'                RECEIVE PACKET NUMBER            TSO24340
NUMTRY   DC        F'0'                TRIAL COUNTER FOR TRANSFERS      TSO24350
OLDTRY   DS        F                   COUNTER FOR PREVIOUS PACKET      TSO24360
STORLOC  DS        F                   POINTER TO EXTRA STORAGE         TSO24370
MAXPACK  DC        F'94'               MAX PACKET SIZE                  TSO24380
RECL     DS        F                   RECORD LEN (IF RECFM = V)        TSO24390
RPSIZ    DC        F'94'               MAX RECEIVE PACKET SIZE          TSO24400
DSSIZ    DC        F'40'               DEFAULT MAX SEND PACKET SIZE     TSO24410
SPSIZ    DS        F                   SEND PACKET SIZE                 TSO24420
MAXTRY   DC        F'5'                NO. OF TIMES TO RETRY PACKET     TSO24430
IMXTRY   DC        F'16'               NO. OF INITIAL TRIALS ALLOWED    TSO24440
SIZE     DS        F                   MAX SIZE FOR SEND DATA           TSO24450
DEL      DC        F'127'              OCTAL 177 (DELETE CHAR)          TSO24460
ZERO     DC        F'0'                                                 TSO24470
ONE      DC        F'1'                                                 TSO24480
FIVE     DC        F'5'                                                 TSO24490
TWO      DC        F'2'                                                 TSO24500
SPACE    DC        F'32'               ASCII SPACE                      TSO24510
O1H      DC        F'64'               OCTAL 100                        TSO24520
O2H      DC        F'128'              OCTAL 200                        TSO24530
SAVPL    DC        F'0'                POINTER WITHIN BUF,INIT=0        TSO24540
RSAVPL   DC        F'0'                POINTER IN 'PTCHR',INIT=0        TSO24550
DQUOTE   DC        X'23'               DEFAULT QUOTE CHARACTER = #      TSO24560
QUOCHAR  DS        X                   QOUTE CHAR WE'LL SEND            TSO24570
RQUO     DS        X                   MICRO'S QUOTE CHAR               TSO24580
TEMP     DS        F                   TEMPORARY SPACE                  TSO24590
         DS        0D                                                   TSO24600
PKVAR    DS        D                   USE FOR PICKING UP INTEGER       TSO24610
SDAT     DS        CL130               TEMP PLACE FOR SEND DATA         TSO24620
RDAT     DS        CL130               TEMP PLACE FOR RECEIVE DATA      TSO24630
FILNAML  DS    H                   LENGTH OF FILENAME                   TSO24640
FILNAM   DS        CL18                SEND/REC FILENAME                TSO24650
STATE    DS        C                   OUR CURRENT STATE                TSO24660
DEOL     DC        X'0D'               DEFAULT END OF PACKET (CR)       TSO24670
REOL     DS        X                   EOL CHAR I NEED (CR)             TSO24680
SEOL     DS        X                   EOL I'LL SEND                    TSO24690
DSOH     DC        X'01'               DEFAULT START OF HEADER (CTL A)  TSO24700
RSOH     DS        X                   RECEIVE START OF HEADER          TSO24710
SSOH     DS        X                   SEND START OF HEADER             TSO24720
DLRECL   DC        X'50'               DEFAULT LRECL SIZE OF 80         TSO24730
LRECL    DS        X                   LRECL PROGRAM WILL USE           TSO24740
DBLKSIZE DC        H'80'               DEFAULT BLKSIZE OF 80            TSO24750
BLKSIZE  DS        H                   BLKSIZE PROGRAM WILL USE         TSO24760
DTRACK   DC        F'5'                DEFAULT SPACE ALLOCATION         TSO24770
DRECFM   DC        C'F'                DEFAULT WITH FIXED RECFM         TSO24780
RFM      DS        C                   RECFM PROGRAM WILL USE           TSO24790
PREV     DS        C                   PREVIOUS CHAR REC (IN PTCHR)     TSO24800
BLIP     DS        X                   SAVE USER'S BLIP CHAR            TSO24810
LINSIZ   DS        F                   SAVE USER'S CONSOLE LINESIZE     TSO24820
ERRNUM   DS        X                   ERROR NUMBER,IN CASE WE DIE      TSO24830
OLDERR   DS        X                   ERROR OF PREVIOUS EXECUTION      TSO24840
STYPE    DS        C                   TYPE OF PACKET SENT              TSO24850
RTYPE    DS        C                   TYPE OF PACKET RECEIVED          TSO24860
*                                                                       TSO24870
READSAVE DS        4F                                                   TSO24880
WRITSAVE DS        4F                                                   TSO24890
PARSELST DS        3F                  PTRS TO OPERAND STACK            TSO24900
PTRTBL   DS        15F                 OPERAND STACK                    TSO24910
PTRTBLL  EQU       *-PTRTBL            LENGTH OF PTRTBL                 TSO24920
DBLWRK   DS        D                                                    TSO24930
IDSYS    DC        F'2'                MVS TSO                          TSO24940
DDNAME   DC        CL8' '              DDNAME TO ALLOCATE               TSO24950
DSNAME   DC        CL80' '             DSNAME TO ALLOCATE               TSO24960
DSNAMEX  DC        CL80' '             WRKBUFFER                        TSO24970
MEMBER   DC        CL8' '              MEMBER NAME FOR PDS ALLOC        TSO24980
CMSXXX   DC        CL8' '              USED IN CMS ONLY                 TSO24990
CMSYYY   DC        CL8' '                                               TSO25000
CMSZZZ   DC        CL2' '                                               TSO25010
DISP1    DC        F'2'                DISP (0=NEW,1=OLD,2=SHR)         TSO25020
DISP2    DC        F'3'                DISP (0=UNCAT,1=CAT,3=KEEP)      TSO25030
INOUT    DC        F'2'                0=INPUT,1=OUTPUT,2=INOUT)        TSO25040
RECFMX   DC        F'1'                1=FB,2=VBS                       TSO25050
BLKSIZEX DC        F'3600'             FOR NEW DATA SETS ONLY           TSO25060
LRECLX   DC        F'80'               ....                             TSO25070
DEV      DC        CL8'SYSDA'          DEVICE                           TSO25080
TRACK    DC        F'20'               # TRACKS TO ALLOC FOR NEW DSETS  TSO25090
DYNALCRC DC        F'0'                RETURN CODE FROM FUNCTION        TSO25100
WRKBUFF  DS        CL280                                                TSO25110
PREFIX   DC        CL8' '              USERS DSET PREFIX FROM UPT       TSO25120
PREFIXL  DC        F'0'                PREFIX LENGTH-1                  TSO25130
DDELAY   DC        F'2000'             DEFAULT DELAY TIME               TSO25140
DELAY    DS        F                   DELAY TIME                       TSO25150
*                                                                       TSO25160
*  THIS IS THE DYNALC PARM LIST USED FOR BOTH ALLOCATION AND            TSO25170
*  CREATION OF  DATA SETS.                                              TSO25180
*                                                                       TSO25190
DYNAPARM DS 0F                                                          TSO25200
 DC A(IDSYS,DDNAME,DSNAME,MEMBER,CMSXXX,CMSYYY,CMSZZZ,DISP1,DISP2)      TSO25210
 DC A(INOUT,RECFMX,BLKSIZEX,LRECLX,DEV,TRACK)                           TSO25220
 DC X'80',AL3(DYNALCRC)                                                 TSO25230
*                                                                       TSO25240
* TABLE TO TRANSLATE TO UPPER CASE                                      TSO25250
*                                                                       TSO25260
UPPER    DC    256AL1(*-UPPER)                                          TSO25270
         ORG   UPPER+X'81'                                              TSO25280
         DC    C'ABCDEFGHI'                                             TSO25290
         ORG   UPPER+X'91'                                              TSO25300
         DC    C'JKLMNOPQR'                                             TSO25310
         ORG   UPPER+X'A2'                                              TSO25320
         DC    C'STUVWXYZ'                                              TSO25330
         ORG                                                            TSO25340
* THIS IS THE ASCII TO EBCDIC TABLE                                     TSO25350
ATOE     DC        X'00010203372D2E2F1605250B0C0D0E0F'                  TSO25360
         DC        X'101112133C3D322618193F271C1D1E1F'                  TSO25370
         DC        X'405A7F7B5B6C507D4D5D5C4E6B604B61'                  TSO25380
         DC        X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'                  TSO25390
         DC        X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'                  TSO25400
         DC        X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'                  TSO25410
         DC        X'79818283848586878889919293949596'                  TSO25420
         DC        X'979899A2A3A4A5A6A7A8A9C04FD0A107'                  TSO25430
*THIS IS THE EBCDIC TO ASCII CONVERSION TABLE                           TSO25440
*CHARACTERS NOT REPRESENTABLE IN ASCII ARE REPLACED BY A NULL           TSO25450
ETOA     DC        X'000102030009007F0000000B0C0D0E0F'                  TSO25460
*G       DC        X'1011121300000800181900001C1D1E1F'                  TSO25470
         DC        X'10111213000D0800181900001C1D1E1F'                  TSO25480
         DC        X'00000000000A171B0000000000050607'                  TSO25490
         DC        X'0000160000000004000000001415001A'                  TSO25500
         DC        X'20000000000000000000002E3C282B7C'                  TSO25510
         DC        X'2600000000000000000021242A293B5E'                  TSO25520
         DC        X'2D2F00000000000000007C2C255F3E3F'                  TSO25530
         DC        X'000000000000000000603A2340273D22'                  TSO25540
         DC        X'00616263646566676869007B00000000'                  TSO25550
         DC        X'006A6B6C6D6E6F707172007D00000000'                  TSO25560
         DC        X'007E737475767778797A0000005B0000'                  TSO25570
         DC        X'000000000000000000000000005D0000'                  TSO25580
         DC        X'7B414243444546474849000000000000'                  TSO25590
         DC        X'7D4A4B4C4D4E4F505152000000000000'                  TSO25600
         DC        X'5C00535455565758595A000000000000'                  TSO25610
         DC        X'303132333435363738397C0000000000'                  TSO25620
*                                                                       TSO25630
* TABLE OF ERROR MESSAGES (IN CASE WE ABORT)                            TSO25640
ERRTAB   DC        CL20'Bad send-packet size'    ERR MSG #0             TSO25650
         DC        CL20'Bad message number'      ERR MSG #1             TSO25660
         DC        CL20'Unrecognized state'      ERR MSG #2             TSO25670
         DC        CL20'No SOH encountered'      ERR MSG #3             TSO25680
         DC        CL20'Bad character count'     ERR MSG #4             TSO25690
         DC        CL20'Bad checksum'            ERR MSG #5             TSO25700
         DC        CL20'Disk is full'            ERR MSG #6             TSO25710
         DC        CL20'Illegal packet type'     ERR MSG #7             TSO25720
         DC        CL20'Lost a packet'           ERR MSG #8             TSO25730
         DC        CL20'Micro sent a NAK'        ERR MSG #9             TSO25740
         DC        CL20'Micro aborted'           ERR MSG #10            TSO25750
         DC        CL20'Illegal file name'       ERR MSG #11            TSO25760
         DC        CL20'Invalid lrecl'           ERR MSG #12            TSO25770
         DC        CL20'Permanent I/O error'     ERR MSG #13            TSO25780
         DC        CL20'Disk is read-only'       ERR MSG #14            TSO25790
         DC        CL20'Recfm conflict'          ERR MSG #15            TSO25800
         DC        CL20'Err allocating space'    ERR MSG #16            TSO25810
DATASET CAMLST     NAME,DSNAME,,WRKBUFF                                 TSO25820
KERIN DCB DDNAME=KERIN,DSORG=PS,MACRF=(GM),                            XTSO25830
               EODAD=INEOF                                              TSO25840
KEROUT DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,      XTSO25850
               RECFM=VB                                                 TSO25860
DEBUG  DCB DDNAME=DEBUG,DSORG=PS,MACRF=(PM),LRECL=260,BLKSIZE=2048,    XTSO25870
               RECFM=VB                                                 TSO25880
MODDCBF DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=80,     XTSO25890
               RECFM=FB                                                 TSO25900
MODDCBFL EQU *-MODDCBF                                                  TSO25910
MODDCBV DCB DDNAME=KEROUT,DSORG=PS,MACRF=(PM),LRECL=80,BLKSIZE=84,     XTSO25920
               RECFM=VB                                                 TSO25930
MODDCBVL EQU *-MODDCBV                                                  TSO25940
         END KERMIT                                                     TSO25950
