*COPY                                                 IK0CMD            03000000
         TITLE 'USNTRF Routine - execute main loop'                     03001000
* Execute Kermit commands (beginning with default TAKE files)           03002000
* Entry: environment already set up                                     03003000
* Exit: R15=0                                                           03004000
*       ERRNUM set appropriately                                        03005000
USNTRF   ENTER                                                          03006000
         LA    0,KRMPROT                                       @SC86295 03007000
         LA    1,USNCMD      Full list of commands             @SC87117 03008000
         BAL   14,LOOPS      Set up loop return                @SC86295 03009000
         LA    2,USRTAKE                                                03010000
         LA    1,LUSRT       Length of name                    @SC86295 03011000
         BAL   9,LUPTIN      Test user KERMINI                 @SC86295 03012000
           NOP 0             Not found, skip it                @SC86295 03013000
         LA    2,SYSTAKE                                       @SC86135 03014000
         LA    1,LSYST       Length of name                    @SC86295 03015000
         BAL   9,LUPTIN      Test system KERMINI               @SC86295 03016000
           NOP 0             Not found, skip it                @SC86295 03017000
         MVI   ERRNUM,ERRNFT No transfers yet                  @SC86295 03018000
         KCALL SUPFNC,6,E=LOOP                                 @SC86295 03019000
         OI    KFLG,CMDL+SIGN Got command line, suppress banner@SC86295 03020000
         B     LOOP                                            @SC86295 03021000
*                                                                       03022000
KRMININC WTEXT 'Kermit-&KSYS Version &KVRSN (&KDATE.)'         @SC86268 03023000
         WTEXT 'Enter ? for a list of valid commands'                   03024000
         STRTMSGS ,          Any system-specific messages...   @SC87338 03025000
         OI    KFLG,SIGN     Banner done                       @SC86295 03026000
KRMPROB  PTEXT BLANK,1               And leave a blank line             03027000
         B     LUPWRT        Not an error                      @SC86295 03028000
*                                                                       03029000
KRMPROT  TM    KFLG,CMDL                                       @SC86295 03030000
         BZ    KRMPROCL              Go if Not cmd line                 03031000
         NI    KFLG,255-CMDL Turn off command line             @SC86295 03032000
         OI    KFLG,CMDC     Command from cmd line             @SC86295 03033000
         L     1,CBUF                address of cmd                     03034000
         L     0,CLEN        Length                            @SC86171 03035000
         B     LUPPRS        Go process it                     @SC86295 03036000
*                                                                       03037000
KRMPROCL TM    KFLG,CMDC                                       @SC86295 03038000
         BZ    KRMPROR               Go if not cmd line                 03039000
         KCALL SUPFNC,7,E=(KRMXITQ,Z) Go if nothing stacked    @SC86295 03040000
KRMPROR  TM    KFLG,SIGN     Already printed banner?           @SC86295 03041000
         BO    KRMPROX       Yes, or suppressed                @SC86295 03042000
         KCALL SUPFNC,7,E=(KRMININC,Z) Go if nothing stacked   @SC86295 03043000
KRMPROX  LA    3,CMD                                           @SC86295 03044000
         LA    4,KPRPT       Current prompt                    @SC87268 03045000
         SR    0,0                                             @SC87268 03046000
         IC    0,KPRPL       Prompt length                     @SC87268 03047000
         RTEXT (3),PROMPT=((4),(0))                            @SC87268 03048000
         LA    1,CMD         Ptr to command                    @SC86171 03049000
         B     LUPPRS        Go process it                     @SC86295 03050000
*                                                                       03051000
USNCMD   KW    'EXIT',KRMXIT,MIN=2                                      03052000
         KW    'QUIT',KRMXIT                                            03053000
USNCMDX  KW    'BYE',KRMBYE,MIN=3                              @SC86155 03054000
         KW    'DIRECTORY',KRMDIR,MIN=3                        @SC86295 03055000
         KW    'ECHO',KRMECO,MIN=2                                      03056000
         KW    'FINISH',KRMFIN,MIN=3                           @SC86155 03057000
         KW    'GET',KRMGET                                    @SC86155 03058000
         KW    'HELP',KRMHLP                                            03059000
         KW    'LOCAL',LUPTOK,MIN=3                            @SC86295 03060000
         KW    'RECEIVE',KRMREC,MIN=3                                   03061000
         KW    'REMOTE',KRMREM,MIN=3                           @SC86155 03062000
         KW    'SEND',KRMSND,MIN=3                                      03063000
         KW    'SERVER',KRMSRV,MIN=3                                    03064000
         KW    'XECHO',KRMXPE,MIN=2                            @SC86204 03065000
         KW    'XTYPE',KRMNPS,MIN=2                            @SC86204 03066000
SRVKCMD  KW    '&KSYS.',LUPHST,MIN=2  Valid in Server mode ... @SC86295 03067000
         AIF   ('&KSYS' NE 'CMS').CM0Z                         @SC86355 03068000
         KW    'CP',LUPCP,MIN=2                                @SC86295 03069000
.CM0Z    KW    'CWD',LUPCWD,MIN=2                              @SC86295 03070000
         KW    'GIVE',LUPGIV,MIN=2                             @SC87117 03071000
         KW    'HOST',LUPHST,MIN=2                             @SC87253 03072000
         KW    'KERMIT',LUPTOK                                 @SC87343 03073000
         KW    'SET',LUPSET,MIN=3                              @SC86295 03074000
         KW    'SHOW',LUPSHO,MIN=2                             @SC86295 03075000
         KW    'SPACE',LUPSPA,MIN=2                            @SC86295 03076000
         KW    'STATUS',LUPSTA,MIN=2                           @SC86295 03077000
         KW    'TAKE',LUPTAK,MIN=2                             @SC86295 03078000
         KW    'TDUMP',LUPDMP,MIN=2                            @SC86295 03079000
         KW    'TYPE',LUPHSTI,MIN=2                            @SC86295 03080000
         KW                                                             03081000
*                                                                       03082000
KRMECO   L     3,ADR                 Pick rest of line                  03083000
         ICM   4,B'1111',LEN         Remaining data length              03084000
         BNP   KRMPROB               Go if nothing left in cmd          03085000
         B     LUPWRT        Else, print the rest              @SC86295 03086000
*                                                              @SC86155 03087000
KRMREM   KCALL GENCMD,0,E=LUPERK Send remote command           @SC86295 03088000
         B     KRMXFZ                                          @SC87300 03089000
*                                                              @SC86155 03090000
KRMBYE   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03091000
         KCALL GENCMD,AL     Send Logout command               @SC86155 03092000
         B     KRMXFZ                                          @SC87300 03093000
*                                                                       03094000
KRMFIN   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03095000
         KCALL GENCMD,AF     Send Finish command               @SC86155 03096000
         B     KRMXFZ                                          @SC87300 03097000
*                                                                       03098000
KRMGET   LA    0,FFGET+FFRCF                                   @SC86295 03099000
         KCALL FSPEC,JFSPEC  Get foreign filespec              @SC86295 03100000
         BAL   14,LUPCKFN                                      @SC86295 03101000
         LA    0,FFGET                                         @SC86295 03102000
         KCALL FSPEC,FILNAM  Get native filespec, if any       @SC86295 03103000
         BAL   14,LUPCKFN                                      @SC86295 03104000
         BAL   14,LUPCNF     Check for illegal extras          @SC86295 03105000
         LA    0,FFNEW+FFGET                                   @SC87012 03106000
         KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions         @SC87012 03107000
         BAL   8,IPKSET      Set state table, exchange parms   @SC86295 03108000
* Init packet  Rpack interpret input tables                    @SC86155 03109000
         DC    AL1(AY),AL3(0)        ACK'ed                    @SC86155 03110000
         DC    AL1(00),AL3(KRMGETAB) Error                     @SC86155 03111000
         BAL   9,PAKFIL      Copy file specification to buffer @HF86223 03112000
         BAL   9,ENCODEN     Encode file-spec                  @SC86295 03113000
         MVI   STYPE,AR      Packet type = receive initiate    @SC86155 03114000
         KCALL SPACK,E=KRMGETAB Send name                      @SC86155 03115000
         KCALL RECEIV                                          @SC86155 03116000
         B     KRMXFZ                                          @SC86239 03117000
*                                                                       03118000
KRMGETAB KCALL INTINI,0                                        @SC86155 03119000
         B     KRMXFZ                                          @SC87300 03120000
*                                                                       03121000
KRMREC   LA    0,FFRCF                                         @SC86295 03122000
         KCALL FSPEC,FILNAM  Get filespec                      @SC86295 03123000
         BAL   14,LUPCKFN                                      @SC86295 03124000
         BAL   14,LUPCNF     Check for illegal extras          @SC86295 03125000
         LA    0,FFNEW+FFGET                                   @SC87012 03126000
         KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions         @SC87012 03127000
         KCALL INTINI,3,E=KRMXFZ  Initialize for receive       @SC87300 03128000
         KCALL RECEIV                                                   03129000
         B     KRMXFZ                                          @SC86239 03130000
*                                                                       03131000
KRMNPS   OI    FL4,NPS                                         @SC86165 03132000
         MVI   TCTLQ,0       Turn off control quoting          @SC86165 03133000
*                                                                       03134000
KRMSND   LA    0,FFSND                                         @SC86295 03135000
         KCALL FSPEC,IFILE   Get filespec                      @SC86295 03136000
         BAL   14,LUPCKFN                                      @SC86295 03137000
         LA    0,FFSND+FFRCF                                   @SC86295 03138000
         KCALL FSPEC,JFSPEC  Get filespec                      @SC86295 03139000
         BAL   14,LUPCKFN                                      @SC86295 03140000
         BAL   14,LUPCNF     Check for illegal extras          @SC86295 03141000
KRMSNDBG KCALL SEND                                                     03142000
KRMXFZ   SR    3,3                                             @SC86355 03143000
         ICM   3,1,ERRNUM    Ok?                               @SC86355 03144000
         BZ    LOOP          Yes, get next command             @SC86355 03145000
         SLL   3,2           No, convert error number          @SC86355 03146000
         A     3,AERRTAB     Ptr into message table            @SC86355 03147000
         SR    4,4                                             @SC86355 03148000
         IC    4,0(3)        Length                            @SC86355 03149000
         ICM   3,7,1(3)      Message ptr                       @SC86355 03150000
         B     LUPWRTE       Display it and go on              @SC86355 03151000
*                                                                       03152000
KRMXPE   L     5,ADR         Pointer to rest of line           @HF86150 03153000
         ICM   4,15,LEN      Remaining data length             @HF86150 03154000
         BNP   KRMXPEH       Go if nothing specified           @HF86150 03155000
         L     3,RBUF                                          @HF86150 03156000
         MVC   0(256,3),0(5) Copy to disk read buffer          @HF86150 03157000
         AR    4,3           Get end                           @HF86150 03158000
         STM   3,4,TXTPTR    Point to text to copy             @HF86150 03159000
         OI    FL4,SFM+NPS   Data source: text string          @SC86165 03160000
         MVI   TCTLQ,AUP     Turn on control quoting           @SC86165 03161000
         B     KRMSNDBG                                        @SC86165 03162000
*                                                                       03163000
KRMXPEH  PTEXT 'Text string with ^X for cntl-X'                @SC86165 03164000
         B     LUPWRT                                          @SC86295 03165000
*                                                                       03166000
KRMSRV   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03167000
         KCALL SERVER        Call SERVER routine               @SC86295 03168000
         B     KRMXFZ        Return to normal mode             @SC86355 03169000
*                                                                       03170000
KRMDIR   LA    0,FFUTL+FFWLD                                   @SC86295 03171000
         KCALL FSPEC,FILNAM  Get pattern filespec              @SC86295 03172000
         BAL   14,LUPCKFN    Make sure ok                      @SC86295 03173000
         LA    0,13                                            @SC86295 03174000
         KCALL DISKIO,FILNAM Do a DIR on it                    @SC86295 03175000
         B     LOOP                                            @SC86295 03176000
*                                                                       03177000
KRMHLP   KCALL KHELP         Issue help request                @SC86355 03178000
         B     LOOP                                            @SC86355 03179000
*                                                                       03180000
KRMXIT   FTOKN N=KRMXITQ,H=LUPCRH Check for illegal extras     @SC86295 03181000
         B     LUPBAD        Not just QUIT, maybe system Q     @SC86295 03182000
*                                                                       03183000
KRMXITQ  NXTFSET ,END        Flush pending file list           @SC86355 03184000
         L     2,TAKLEVK                                       @SC86295 03185000
KRMXITL  BCTR  2,0                                             @SC86295 03186000
         LTR   3,2           Any pending TAKE files?           @SC86295 03187000
         BM    RTRN0         No                                @SC86295 03188000
         SLA   3,2                                             @SC86295 03189000
         CLOSF TAKTABK(3)    Close the open file               @SC86295 03190000
         B     KRMXITL       Keep checking                     @SC86295 03191000
         LOCALS ,                                              @SC86295 03192000
* See SERVER for mapping                                       @SC86295 03193000
         DS    A             Return adr if no more TAKE stuff  @SC86295 03194000
         DS    A             Adr of command table              @SC86295 03195000
TAKLEVK  DS    F             Take file level                   @SC86295 03196000
TAKTABK  DS    (TAKMAX)F     Tickets for I/O                   @SC86295 03197000
KFLG     DS    X             Local flags in main program       @SC86295 03198000
SIGN     EQU   X'04'         Already printed Kermit banner     @SC86295 03199000
CMDC     EQU   X'02'         Command gotten from cmd                    03200000
CMDL     EQU   X'01'         Data on cmd line                           03201000
USNTRF   EXIT                                                           03202000
         TITLE 'SET Routine - perform SET command options'              03203000
* Set/change values in STORAG.                                          03204000
* Entry: SCANPTR string has option                                      03205000
* Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name          03206000
*       ERRNUM unchanged                                                03207000
SET      ENTER                                                          03208000
         MVI   SETXI,X'97'   XI instruction                    @SC86273 03209000
         NTOKN N=RTRN2                                         @SC86171 03210000
         NI    FL3,255-PXCH  Make sure server renegotiates     @SC86295 03211000
         SCAN  SETCMDKW,RTRN1                                  @SC86295 03212000
         B     RTRN2                                           @SC86295 03213000
*                                                                       03214000
SETOOKW  KW    'OFF',SETOFF,MIN=2                              @SC87166 03215000
         KW    'ON',SETON,MIN=2                                @SC87166 03216000
         KW    ,                                               @SC87166 03217000
*                                                                       03218000
SETROFF  KW    'OFF',0,MIN=2                                   @SC87166 03219000
SETRAW   KW    'RAW',SETDEBRW                                  @SC86316 03220000
SETCMDOO KW    'OFF',SETOFFS,MIN=2                             @SC87166 03221000
SETONKW  KW    'ON',SETONS,MIN=2                               @SC87166 03222000
         KW    ,                                               @SC86171 03223000
*                                                                       03224000
SETOFF   EX    0,0(9)        Yes, first turn flag on...        @SC87166 03225000
         EX    0,SETXI       Then off                          @SC86273 03226000
         B     RTRN0                                           @SC87166 03227000
*                                                                       03228000
SETON    EX    0,0(9)        Turn flag on                      @SC87166 03229000
         B     RTRN0                                           @SC87166 03230000
*                                                                       03231000
SETOFFS  B     4(9)                                            @SC87166 03232000
*                                                                       03233000
SETONS   BR    9             Go to ON handler                  @SC87166 03234000
*                                                                       03235000
SETTRKW  KW    'TTY',SETT                                      @SC87166 03236000
         KW    'SERIES1',SETT                                  @SC87166 03237000
         KW    'GRAPHICS',SETT                                 @SC87166 03238000
         KW    'FULLSCREEN',SETT                               @SC87300 03239000
         KW    ,                                               @SC87166 03240000
*                                                                       03241000
SETT     MVC   TRMTP,0(6)                                      @SC87166 03242000
         B     RTRN0                                           @SC87166 03243000
*                                                                       03244000
SETSWT   KW    'CONTINUE',SETOFF                               @SC86171 03245000
         KW    'HALT',SETON                                    @SC86171 03246000
         KW    ,                                               @SC86171 03247000
*                                                                       03248000
SETDSC   KW    'DISCARD',SETOFF                                @SC86225 03249000
         KW    'KEEP',SETON                                    @SC86225 03250000
         KW    ,                                               @SC86225 03251000
*                                                                       03252000
SETPAR   KW    'MARK',SETOFF                                   @SC86316 03253000
         KW    'NONE',SETON                                    @SC86316 03254000
         KW    ,                                               @SC86316 03255000
*                                                                       03256000
SETTABS  LA    4,SETCMDOO                                      @SC87166 03257000
         BAL   14,SETSCN                                       @SC87166 03258000
          B    SETTBON       Turn on                           @SC86355 03259000
         NI    FL2,255-TABS  Turn off                          @SC86355 03260000
         MVC   TABCNT,F0     Clear count                       @SC86355 03261000
         B     RTRN0                                           @SC86295 03262000
SETTBON  OI    FL2,TABS      Turn on                           @SC86355 03263000
         MVC   TABCNT,F0     Clear count                       @SC86355 03264000
         SR    0,0           Init previous tab                 @SC86355 03265000
         LA    3,TABTBL      Point to start of tab table       @TS86100 03266000
         LA    8,255         Limit on tab stops                @SC86355 03267000
         LA    5,TABCNT      End of table                      @SC86355 03268000
SETTBLP  ICM   2,15,LEN      Any more tokens?                  @SC86355 03269000
         BNP   SETTBN        No, done                          @SC86355 03270000
         STC   0,0(3)        Save previous tab                 @SC86355 03271000
         BAL   2,SETNUM      Read number                       @SC86355 03272000
         CLM   0,1,0(3)      Is this tab higher than previous? @SC86355 03273000
         BNH   SETTBSEQ      No, tab out of sequence           @TS86100 03274000
         CR    3,5           Exceeded capacity?                @SC86355 03275000
         BNL   SETTBHI       Yes                               @TS86100 03276000
         STC   0,0(3)        Save tab setting                  @TS86100 03277000
         LA    3,1(3)        Bump counter                      @SC86355 03278000
         B     SETTBLP                                         @SC86355 03279000
SETTBN   LA    0,TABTBL      Point to start of tab table       @SC86355 03280000
         SR    3,0           Get length of table               @SC86355 03281000
         STH   3,TABCNT      Save the tab count                @TS86100 03282000
         B     RTRN0                                           @SC86355 03283000
SETTBHI  PTEXT 'Too many tabs'                                 @SC86355 03284000
         B     SETTBER       Return error                      @SC86355 03285000
SETTBSEQ PTEXT 'Tabs out of sequence'                          @TS86100 03286000
SETTBER  NI    FL2,255-TABS  Turn off                          @SC86355 03287000
         B     SUBERR        Return error                      @TS86100 03288000
*                                                                       03289000
SETLIN   BAL   2,SETFSTR     Get fixed-format string           @SC86166 03290000
         PTEXT 'Bad line'                                      @SC87351 03291000
         KCALL SETMSG,5,E=SUBERR Make sure it's ok             @SC87351 03292000
         B     RTRN0                                           @SC86166 03293000
*                                                                       03294000
SETPRP   LA    0,KPRPT       Ptr to new prompt string          @SC87351 03295000
         KCALL SUPFNC,11     Ok it with system                 @SC87351 03296000
         B     RTRN0                                           @SC87351 03297000
*                                                                       03298000
         KSETPRC ,           System-specific options           @SC86355 03299000
*                                                                       03300000
SETFKW   KW    'LRECL',SHOLR               **COMPAT**          @SC87166 03301000
         KW    'T',SETFT                   **COMPAT**          @SC87166 03302000
         KW    'TYPE',SHOFILT              **COMPAT**          @SC87166 03303000
        KFILKW ,                           **COMPAT**          @SC87166 03304000
SETFIL   KW    'TEXT',SETFILET                                 @SC86133 03305000
         KW    'BINARY',SETFILEB                               @SC86262 03306000
SETDBIN  KW    'D-BINARY',SETFILEB                             @SC86262 03307000
         KW    'V-BINARY',SETFILEB                             @SC86151 03308000
         KW                                                             03309000
*                                                                       03310000
SETFILEB OI    FL1,BINF              Set binary on                      03311000
SETFLR   SR    0,0                                             @SC87012 03312000
         ICM   0,3,LRECL     Record length                     @SC86295 03313000
         ST    0,MAXOUT      Max output buffer size            @SC86295 03314000
         MVC   TYPFIL,0(6)   Save type                         @SC86151 03315000
         B     RTRN0                                           @SC86295 03316000
*                                                                       03317000
SETFILET NI    FL1,255-BINF          Set it OFF                         03318000
         B     SETFLR                                          @SC87012 03319000
*                                                                       03320000
         KFILSET ,                                             @SC87012 03321000
*                                                                       03322000
SETDEB   LA    0,ATOE        EBCDIC log                        @SC86316 03323000
         LA    4,SETRAW                                        @SC86316 03324000
         BAL   14,SETSCN                                       @SC86316 03325000
          B    SETDEBON                                        @SC86273 03326000
SETDEBOF NI    FL1,255-DEBUG         Set it OFF                         03327000
         ST    0,DBGTYP      Save indicator                    @SC86316 03328000
         CLOSF LOGPTR        Done logging                      @SC86135 03329000
         B     RTRN0                                           @SC86295 03330000
*                                                                       03331000
SETDEBRW SR    0,0           No translation for log            @SC86316 03332000
SETDEBON ST    0,DBGTYP      Save indicator                    @SC86316 03333000
         TM    FL1,DEBUG     Already on?                       @SC87012 03334000
         BO    RTRN0         Yes                               @SC87012 03335000
         NI    LOGFLGS,255-APPN                                @SC86295 03336000
         LA    0,L'LOGNAM    Name string length                @SC86295 03337000
         LA    1,LOGNAM      and address                       @SC86295 03338000
         STM   0,1,SCANPTR                                     @SC86295 03339000
         LA    0,FFRCF                                         @SC86295 03340000
         KCALL FSPEC,IFILE   Convert to filespec               @SC86295 03341000
         PTEXT 'DEBUG error'                                   @SC87012 03342000
         OPENF O,IFILE,LOGFDB,LOGPTR,E=SUBERR                  @SC87012 03343000
         OI    FL1,DEBUG     Enable logging                    @SC87012 03344000
         B     RTRN0                                           @SC86295 03345000
*                                                                       03346000
SET8B    NTOKN N=SET8BH,H=SET8BH                               @SC87008 03347000
         LA    4,AAMP        Default value                     @SC87008 03348000
         LA    9,SET8BS                                        @SC87008 03349000
         SCAN  SETONKW,RTRN2                                            03350000
         SR    4,4           Zero value means OFF              @SC87008 03351000
         LTR   7,7           Length=1?                         @SC87008 03352000
         BNZ   SET8BS        No, can't be ON                   @SC87008 03353000
         BAL   2,SETQCH2     Make sure it's valid              @SC87008 03354000
SET8BS   STC   4,EBQC        New value                         @SC87008 03355000
         B     RTRN0                                           @SC87008 03356000
SET8BH   PTEXT 'Must be ON, OFF, or a character'               @SC87008 03357000
         B     SUBERR                                          @SC87008 03358000
*                                                                       03359000
SETSTR   LR    2,14                                            @SC87268 03360000
         MVI   0(8),0        Default to blank                  @SC87166 03361000
         BAL   9,WSP         Remaining data length             @SC86224 03362000
          B    RTRN0         Null string                       @SC86295 03363000
         LR    1,4           Max length allowed                @SC87268 03364000
         CR    6,1                                             @SC86345 03365000
         BH    SETSTRH       Too long                          @SC86345 03366000
         STC   6,0(8)        Save length                       @SC87166 03367000
         LA    8,1(8)        Skip over length byte             @SC87268 03368000
         XR    6,7           Exchange ptr and length           @SC87268 03369000
         XR    7,6                                             @SC87268 03370000
         XR    6,7                                             @SC87268 03371000
         B     SETFST1       Go copy string                    @SC87268 03372000
*                                                                       03373000
SETRCTLQ BAL   2,SETQCHR             Get a char for Receive-Ctl-quote   03374000
         STC   4,RCTLQ(5)    Set receive ctl quote             @SC86164 03375000
         LTR   5,5           Done if SEND                      @SC86223 03376000
         BNZ   RTRN0                                           @SC86295 03377000
         STC   4,DEFPARM+5   Set default for SPAR              @SC86120 03378000
         B     RTRN0                                           @SC86295 03379000
*                                                                       03380000
SETQCHR  NTOKN H=SETQCHRH,N=SETQCHRH                                    03381000
         LTR   7,7                   Token length - 1                   03382000
         BP    SETQCHRH              Pos: token is too long             03383000
SETQCH2  SR    4,4                                             @SC87008 03384000
         IC    4,0(6)        Get the quote char                @SC86120 03385000
         IC    4,ETOA(4)     Get ASCII form                    @SC86120 03386000
         NOTQR SETQCHRH      Go if not 33-62 or 96-126         @SC86120 03387000
         BR    2                                                        03388000
*                                                                       03389000
SETQCHRH PTEXT 'One char with ASCII value 33-62 or 96-126'     @SC86224 03390000
         B     SUBERR                                          @SC86295 03391000
*                                                                       03392000
SETLR    ST    0,MAXOUT      Max output buffer size            @SC87166 03393000
         B     RTRN0                                           @SC86295 03394000
*                                                                       03395000
SETTIMO  BCT   5,RTRN0       Done if rec                       @SC87166 03396000
         TOCHR 0,,DEFPARM+1  Set default for SPAR              @SC86164 03397000
         B     RTRN0                                           @SC86295 03398000
*                                                                       03399000
SETPADN  BCT   5,RTRN0       Done if rec                       @SC87166 03400000
         TOCHR 0,,DEFPARM+2  Set default for SPAR              @SC86164 03401000
         B     RTRN0                                           @SC86295 03402000
*                                                                       03403000
SETPADC  BCT   5,RTRN0       Done if rec                       @SC87166 03404000
         CTL   0,,DEFPARM+3  Set default for SPAR              @SC86164 03405000
         B     RTRN0                                           @SC86295 03406000
*                                                                       03407000
SETEOL   BCT   5,RTRN0       Done if rec                       @SC87166 03408000
         STC   0,S1EOL       Extra copy for prompting          @SC87274 03409000
         TOCHR 0,,DEFPARM+4          Set default for SPAR               03410000
         B     RTRN0                                           @SC86295 03411000
*                                                                       03412000
SETSIZ   C     0,AKMIN       Less than min Kermit size?        @SC87166 03413000
         BL    SETKSIZH      Yes, error                        @SC86164 03414000
         C     0,AKMAX       More than max Kermit size?        @SC86164 03415000
         BNH   SETRPS1       No, skip message call             @TB86196 03416000
         LTR   5,5           SEND?                             @SC86224 03417000
         BNZ   SETKSIZH      Yes, can't set it long            @SC86224 03418000
         LR    6,0           Save value across WTEXT           @SC86316 03419000
         WTEXT 'Type 0 long packets specified'                 @SC86202 03420000
         LR    0,6                                             @SC86316 03421000
SETRPS1  DS    0H                                              @TB86196 03422000
         BCT   5,RTRN0       Done if recv                      @SC86295 03423000
         TOCHR 0,,DEFPARM+0          Set default for SPAR               03424000
         B     RTRN0                                           @SC86295 03425000
*                                                                       03426000
SETKSIZH PTEXT 'Operand must be 20-94 for SEND' KMIN-KMAX      @SC86295 03427000
         B     SUBERR                                          @SC86295 03428000
*                                                                       03429000
SETETOA  LA    3,ETOA        Address of table to change        @SC86265 03430000
         B     SETTET2                                         @SC87117 03431000
SETTET   LA    3,TETOA       Address of table to change        @SC87117 03432000
SETTET2  LA    2,ETOAD       Address of original               @SC87117 03433000
SETTR0   ICM   0,15,LEN      Any more tokens?                  @SC87117 03434000
         BP    SETTR1        Yes, must be numeric              @SC87117 03435000
         MVC   0(256,3),0(2) No, just reset table              @SC87117 03436000
         B     RTRN0                                           @SC87117 03437000
SETTR1   LA    8,255         Limit for each                    @SC87117 03438000
         BAL   2,SETNUM      Get a number for table offset     @SC86295 03439000
         AR    3,0           Save table offset here            @SC86295 03440000
         BAL   2,SETNUM      Get a number for value            @SC86295 03441000
         STC   0,0(3)        Change value                      @SC86295 03442000
         B     RTRN0         All done                          @SC86295 03443000
*                                                                       03444000
SETATOE  LA    3,ATOE        Adr of table to edit              @SC86265 03445000
         B     SETTAT2                                         @SC87117 03446000
SETTAT   LA    3,TATOE       Address of table to change        @SC87117 03447000
SETTAT2  LA    2,ATOED       Address of original               @SC87117 03448000
         B     SETTR0                Use common routine                 03449000
*                                                                       03450000
*                                                                       03451000
* R6 points to token, R7 has length-1.  Convert to binary in R0.        03452000
* Return via R2                                                         03453000
SETNUM2  LR    2,14          Save return                       @SC87166 03454000
SETNUM   NTOKN H=SETNUMH,N=SETNUMH                             @SC86295 03455000
         LA    7,1(7)        Length                            @SC86316 03456000
         BAL   14,GETNUM                                       @SC86316 03457000
          B    SETNUMH                                         @SC86316 03458000
         CLR   0,8           Within limit?                     @SC86295 03459000
         BH    SETNUMH       Too big                           @SC87166 03460000
         CLI   0(2),X'47'    Entered at SETNUM2?               @SC87166 03461000
         BNER  2             No, return immediately            @SC87166 03462000
         LR    14,2          Ptr to caller                     @SC87166 03463000
         S     14,F8         Back up to the LOAD instr         @SC87166 03464000
         MVC   SETXI,0(14)   Copy and modify op instr          @SC87166 03465000
         NC    SETXI(2),=X'F60F'                               @SC87166 03466000
         CLI   SETXI,X'B6'   Was is ICM?                       @SC87166 03467000
         BNE   *+8           No, ok                            @SC87166 03468000
         MVI   SETXI,X'BE'   Yes, make into STCM               @SC87166 03469000
         EX    0,SETXI       Store value                       @SC87166 03470000
         BR    2             Return                            @SC87166 03471000
*                                                                       03472000
SETNUMH  LA    15,CMD+16                                       @SC86295 03473000
SETMAXH  MVC   CMD(26),=C'Operand must be of length '          @SC86295 03474000
         MVI   0(15),C'<'                                      @SC86295 03475000
         LA    15,1(15)                                        @SC86295 03476000
         LR    4,8                                             @SC86345 03477000
         A     4,F1                                            @SC86345 03478000
         BAL   2,EDDEC       Put limit into message            @SC86295 03479000
         LR    4,15          End                               @SC86295 03480000
         LA    3,CMD                                           @SC86295 03481000
         SR    4,3                                             @SC86295 03482000
         B     SUBERR                                          @SC86295 03483000
*                                                                       03484000
SETFSTR  LR    1,9           Save length                       @SC87166 03485000
         NTOKN N=SETFST0,H=SETSTRH                             @SC87166 03486000
         LA    7,1(7)                                          @SC86295 03487000
         CR    7,1           Name too long?                    @SC86295 03488000
         BNH   SETFST1       No, do it                         @SC86295 03489000
SETSTRH  LR    8,1           Copy max length                   @SC86295 03490000
         LA    15,CMD+26     Base message size                 @SC86295 03491000
         B     SETMAXH                                         @SC86295 03492000
SETFST0  SR    7,7           Empty string                      @SC86295 03493000
SETFST1  ICM   7,8,BLANK     Set for blank fill                @SC86295 03494000
         LR    9,1                                             @SC87166 03495000
         MVCL  8,6           Copy name                         @SC87166 03496000
         BR    2                                               @SC86295 03497000
         TITLE 'SHOW Routine - performs SHOW command options'           03498000
* Display current values in STORAG.                                     03499000
* Entry: SCANPTR string has option                                      03500000
* Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name          03501000
*       ERRNUM unchanged                                                03502000
SHOW     ENTER ALT                                             @SC86133 03503000
         LA    0,CMD                                           @SC86227 03504000
         ST    0,SHOPTR      Initialize output ptr             @SC86227 03505000
         MVI   SETXI,X'91'   TM instruction                    @SC87166 03506000
         NTOKN N=SHOALL                                        @SC86133 03507000
         SCAN  SHOCMDS,RTRN1                                   @SC86295 03508000
SHOBAD   B     RTRN2         Invalid operand                   @SC86295 03509000
*                                                                       03510000
SETCMDKW DS    0H                                              @SC87166 03511000
         KW    'ATOE',SETATOE,MIN=4                            @SC87166 03512000
         KW    'ETOA',SETETOA,MIN=4                            @SC87166 03513000
         KW    'FILE-TYPE',SHOFILT,MIN=5                       @SC87166 03514000
         KW    'TATOE',SETTAT,MIN=5                            @SC87166 03515000
         KW    'TETOA',SETTET,MIN=5                            @SC87166 03516000
*                                                                       03517000
SHOCMDS  KW    'RECFM',SHORFM,MIN=4                            @SC87012 03518000
         KW    'LRECL',SHOLR                                   @SC86133 03519000
SHOCMDKW EQU   *             Must match order of code                   03520000
         KW    'TABS-EXPAND',SHOTABS                           @SC86133 03521000
         KW    'EOF',SHOEOF,MIN=3                              @SC86133 03522000
         KW    'DEBUG',SHODEB                                  @SC86133 03523000
         KW    'BLOCK-CHECK',SHOBLK                            @SC86133 03524000
         KW    '8-BIT-QUOTE',SHO8B                             @SC87008 03525000
         KW    'PROMPT',SHOPRP,MIN=2                           @SC87268 03526000
         KW    'LINE',SHOLIN,MIN=3                             @SC87166 03527000
         KW    'CONTROLLER',SHOTRM,MIN=3                       @SC87268 03528000
         KW    'HANDSHAKE',SHOHND                              @SC87274 03529000
         KW    'PARITY',SHOPRTY                                @SC86316 03530000
         KW    'WARNING',SHOWARN                               @SC86133 03531000
         KW    'SYSCMD',SHOSYS,MIN=2                           @SC86295 03532000
         KW    'TTABLE',SHOTTB,MIN=2                           @SC87117 03533000
         KW    'DELAY',SHODLY,MIN=3                            @SC86164 03534000
         KW    'APPEND',SHOAPP,MIN=3                           @SC86203 03535000
         KW    'INCOMPLETE',SHOINC,MIN=3                       @SC86225 03536000
         KW    'TEST',SHOTST,MIN=4                             @SC87166 03537000
        KSETKW ,             Specific parameters               @SC87166 03538000
         KW    'FILE',SHOFIL                                   @SC86295 03539000
         KW    'MARGIN',SHOMRG                                 @SC87253 03540000
         KW    'FOREIGN',SHOFOR,MIN=3                          @HF86223 03541000
         KW    'RETRY',SHORETR,MIN=3                           @SC86345 03542000
         KW    'TAKE',SHOTAK,MIN=3                             @SC86171 03543000
         KW    'RECEIVE',SHORECV,MIN=3                         @SC86133 03544000
         KW    'SEND',SHOSEND,MIN=3                            @SC86224 03545000
         KW    ,                                               @SC86133 03546000
*                                                                       03547000
SHOALL   OI    SFLG,ALLF     Do all                            @SC86295 03548000
         LA    1,SHOCMDKW    Start at beginning                @SC86133 03549000
*                                                                       03550000
*          Each routine begins with R1-> keyword item          @SC86133 03551000
SHOTABS  CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03552000
         BE    SETTABS                                         @SC87166 03553000
         BAL   14,SHOOO      On or off                         @SC86133 03554000
          OI   FL2,TABS                                        @SC87166 03555000
SHOTABSZ LH    5,TABCNT      Count of tabs                     @SC86355 03556000
         LA    3,TABTBL      Ptr to table of tabs              @SC86355 03557000
         BAL   14,SHOLIST    Display list of tab stops, if any @SC86355 03558000
          NOP  0                                               @SC87166 03559000
SHOEOF   BAL   14,SHOOO      On or off                         @SC86133 03560000
          OI   FL2,EOFZ                                        @SC87166 03561000
SHODEB   CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03562000
         BE    SETDEB                                          @SC87166 03563000
         LA    4,SETCMDOO                                      @SC86345 03564000
         CLC   DBGTYP,F0     EBCDIC log?                       @SC86345 03565000
         BNE   *+8           Yes, it's ON or OFF               @SC87166 03566000
         LA    4,SETROFF     No, it's RAW                      @SC87166 03567000
         BAL   14,SHOXY                                        @SC86345 03568000
          OI   FL1,DEBUG                                       @SC87166 03569000
SHOBLK   SR    4,4                                             @SC86133 03570000
         LA    8,3           Limit                             @SC87166 03571000
         IC    4,BCTC        Get block check type              @SC86133 03572000
         BAL   14,SHONUM     Print it                          @SC86133 03573000
          B    RTRN0         OK                                @SC87166 03574000
SHO8B    LA    8,EBQC                                          @SC87008 03575000
         BAL   14,SHOCHRA    Display ASCII char                @SC87008 03576000
          B    SET8B                                           @SC87166 03577000
SHOPRP   LA    8,KPRPL       Ptr to prompt                     @SC87268 03578000
         LA    4,20          Max length                        @SC87268 03579000
         BAL   14,SHOSTR                                       @SC87268 03580000
          B    SETPRP        Do any system-dependent setup     @SC87351 03581000
SHOLIN   LA    8,TRMLIN                                        @SC87166 03582000
         LA    9,L'TRMLIN                                      @SC87166 03583000
         BAL   14,SHOCHRN                                      @SC87166 03584000
          B    SETLIN                                          @SC87166 03585000
SHOTRM   LA    4,SETTRKW                                       @SC87166 03586000
         LA    6,TRMTP                                         @SC87166 03587000
         BAL   14,SHOBRV     Get full name from abbrev.        @SC87166 03588000
          NOP  0                                               @SC87166 03589000
SHOHND   SR    4,4                                             @SC87274 03590000
         IC    4,S1HND                                         @SC87274 03591000
         BAL   14,SHOCTL     Print it                          @SC87274 03592000
          B    RTRN0                                           @SC87274 03593000
SHOPRTY  LA    4,SETPAR                                        @SC87166 03594000
         BAL   14,SHOXY                                        @SC86316 03595000
          OI   FL2,DAT8                                        @SC87166 03596000
SHOWARN  BAL   14,SHOOO      On or off                         @SC86133 03597000
          OI   FL1,REN                                         @SC87166 03598000
SHOSYS   BAL   14,SHOOO      On or off                         @SC86295 03599000
          OI   FL2,PASS                                        @SC87166 03600000
SHOTTB   BAL   14,SHOOO      On or off                         @SC87117 03601000
          OI   FL4,TTAB                                        @SC87166 03602000
SHODLY   L     4,LCLDLY                                        @SC86164 03603000
         BAL   14,SHONBIG    Print it                          @SC86164 03604000
          B    RTRN0                                           @SC87166 03605000
SHOAPP   BAL   14,SHOOO      On or off                         @SC86203 03606000
          OI   FL3,APPN                                        @SC87166 03607000
SHOINC   LA    4,SETDSC      List of possibles                 @SC87166 03608000
         BAL   14,SHOXY                                        @SC86225 03609000
          OI   FL5,KEEP                                        @SC87166 03610000
SHOTST   BAL   14,SHOOO                                        @SC87166 03611000
          OI   FL1,TSTF      Turn on                           @SC87166 03612000
*                                                                       03613000
         KSHOPRC ,           System-specific options           @SC86355 03614000
*                                                                       03615000
SHOFIL   LA    4,SHOFILKW    Ptr to sublist                    @SC87166 03616000
         CLI   SETXI,X'97'   SET or SHOW   **COMPAT**          @SC87166 03617000
         BNE   *+8           SHOW          **COMPAT**          @SC87166 03618000
         LA    4,SETFKW      SET           **COMPAT**          @SC87166 03619000
         BAL   14,SHOGRP                                       @SC86295 03620000
SHOMRG   LA    4,SHOMRGKW    Ptr to sublist                    @SC87253 03621000
         BAL   14,SHOGRP                                       @SC87253 03622000
SHOFOR   LA    4,SHOFORKW    Ptr to sublist                    @SC87166 03623000
         BAL   14,SHOGRP                                       @SC86224 03624000
SHORETR  LA    4,SHORETKW    Ptr to sublist                    @SC87166 03625000
         BAL   14,SHOGRP                                       @SC86345 03626000
SHOTAK   LA    4,SHOTAKKW    Ptr to sublist                    @SC87166 03627000
         BAL   14,SHOGRP                                       @SC86224 03628000
SHORECV  SR    5,5           Index for recv                    @SC86224 03629000
         BAL   14,SHOGRPR                                      @SC86224 03630000
SHOSEND  LA    5,1           Index for send                    @SC86224 03631000
         LA    14,SHOZZW                                       @SC87166 03632000
SHOGRPR  LA    4,SHORECKW    Ptr to common sublist             @SC87166 03633000
SHOGRP   LR    2,14          Save return adr                   @SC87166 03634000
         STM   1,4,SHOTMP    Save top level ptr, return adr    @SC87166 03635000
SETSCN   LR    2,14          Copy return adr (again)           @SC87166 03636000
         TM    SFLG,ALLF     Doing all?                        @SC86295 03637000
         BO    SHORAL2       Yes                               @SC86133 03638000
         NTOKN N=SHORALL                                       @SC86133 03639000
         LR    9,2           ???                               @SC87166 03640000
         SCAN  (4),RTRN1                                       @SC87166 03641000
SHOHLP   HELP  (4),RTRN1                                       @SC87166 03642000
*                                                                       03643000
SHOFILKW KW    'TYPE',SHOFILT                                  @SC86295 03644000
         KW    'LRECL',SHOLR                                   @SC86133 03645000
        KFILKW                                                 @SC87166 03646000
         KW    ,                                               @SC87012 03647000
*                                                                       03648000
SHOMRGKW KW    'LEFT',SHOLFT                                   @SC87253 03649000
         KW    'RIGHT',SHORGT                                  @SC87253 03650000
         KW    ,                                               @SC87253 03651000
*                                                                       03652000
SHORECKW KW    'END-OF-LINE',SHOEOL                            @SC86133 03653000
         KW    'END-OF-PACKET',SHOEOL                          @SC86133 03654000
         KW    'EOL',SHOEOL,MIN=3                              @SC86133 03655000
SHOPSKW  KW    'PACKET-SIZE',SHOSIZ                            @SC86133 03656000
         KW    'PAD-CHAR',SHOPADC,MIN=5                        @SC86164 03657000
         KW    'PADDING',SHOPADN,MIN=3                         @SC86164 03658000
         KW    'QUOTE',SHOQUO                                  @SC86133 03659000
         KW    'START-OF-PACKET',SHOMARK                       @SC86133 03660000
         KW    'TIMEOUT',SHOTIMO                               @SC86164 03661000
         KW    ,                                               @SC86133 03662000
*                                                                       03663000
SHOTAKKW KW    'ECHO',SHOECO,MIN=3                             @SC86171 03664000
         KW    'ERROR-ACTION',SHOHLT,MIN=3                     @SC86171 03665000
         KW    ,                                               @SC86171 03666000
*                                                                       03667000
SHOFORKW KW    'PREFIX',SHOPFX                                 @HF86223 03668000
         KW    'SUFFIX',SHOSFX                                 @HF86223 03669000
         KW    ,                                               @HF86223 03670000
*                                                                       03671000
SHORETKW KW    'INITIAL',SHORETI                               @SC86345 03672000
         KW    'PACKETS',SHORETN                               @SC86345 03673000
         KW    ,                                               @SC86345 03674000
*                                                                       03675000
SHORALL  OI    SFLG,ALLF+ASRF Do just all send/recv items      @SC86295 03676000
         LA    14,SHOHLP     Just help if SET                  @SC87166 03677000
SHORAL2  BAL   2,SHOKW       Get ptr to kw send or receive     @SC86133 03678000
         BER   14            Help for SET                      @SC87166 03679000
         L     15,SHOPTR     Output line buffer ptr            @SC86227 03680000
         LA    1,CMD                                           @SC86227 03681000
         SR    15,1          Anything there?                   @SC86227 03682000
         BNP   SHORAL3       No                                @SC86227 03683000
         ST    1,SHOPTR      Yes, reset ptr                    @SC86227 03684000
         WTEXT (1),(15)      And write it out                  @SC86227 03685000
SHORAL3  DS    0H                                              @SC86227 03686000
         MVC   CMD(2),=C'  '                                   @SC86133 03687000
         MVC   CMD+2(7),0(6) Copy send or receive              @SC86133 03688000
         LA    0,CMD+2(7)    Point past category               @SC86316 03689000
         ST    0,SHOPTR      Save output ptr                   @SC86316 03690000
         L     1,SHOTMP+12   Start at beginning                @SC87166 03691000
         ICM   14,7,0(1)     Ptr to 1st routine                @SC86171 03692000
         BR    14                                              @SC86171 03693000
*                                                                       03694000
SETFT    ICM   15,15,LEN     SET F T ...   **COMPAT**          @SC87166 03695000
         BNP   SETFILET      Nothing after: 'SET FILE-TYPE T'  @SC87166 03696000
*                                                                       03697000
SHOFILT  LA    4,SETFIL      List of possibles                 @SC86151 03698000
         LA    6,TYPFIL                                        @SC87166 03699000
         BAL   14,SHOBRV     Get full name from abbrev.        @SC87166 03700000
          NOP  0                                               @SC87166 03701000
SHOLR    SR    4,4                                             @SC86133 03702000
         L     8,MAXLRC      Upper limit                       @SC87166 03703000
         ICM   4,3,LRECL                                       @SC86133 03704000
         BAL   14,SHONUM     Print it                          @SC86133 03705000
          B    SETLR                                           @SC87166 03706000
         KFILSHO ,                                             @SC87012 03707000
         B     SHOGRPZ                                         @SC86295 03708000
*                                                                       03709000
SHOLFT   L     4,LMARG                                         @SC87253 03710000
         BAL   14,SHONBIG    Print it                          @SC87253 03711000
          B    RTRN0                                           @SC87253 03712000
SHORGT   L     4,RMARG                                         @SC87253 03713000
         BAL   14,SHONBIG    Print it                          @SC87253 03714000
          B    RTRN0                                           @SC87253 03715000
         B     SHOGRPZ                                         @SC87253 03716000
*                                                                       03717000
SHOECO   BAL   14,SHOOO      On or off                         @SC86171 03718000
          OI   FL2,ECHO                                        @SC87166 03719000
SHOHLT   LA    4,SETSWT      List of possibles                 @SC87166 03720000
         BAL   14,SHOXY                                        @SC86171 03721000
          OI   FL5,TKHLT                                       @SC87166 03722000
         B     SHOGRPZ                                         @SC86171 03723000
*                                                                       03724000
SHOPFX   LA    8,PREFIX      Point to prefix                   @HF86223 03725000
         LA    4,FORMAXL     Max length                        @SC87268 03726000
         BAL   14,SHOSTR     Print message                     @SC86224 03727000
          B    RTRN0                                           @SC87268 03728000
SHOSFX   LA    8,SUFFIX      Point to suffix                   @HF86223 03729000
         LA    4,FORMAXL     Max length                        @SC87268 03730000
         BAL   14,SHOSTR     Print message                     @SC86224 03731000
          B    RTRN0                                           @SC87268 03732000
         B     SHOGRPZ                                         @HF86223 03733000
*                                                                       03734000
SHORETI  L     4,MAXTNT      Initial retry limit               @SC86345 03735000
         BAL   14,SHONBIG    Print it                          @SC87166 03736000
          B    RTRN0                                           @SC87166 03737000
SHORETN  L     4,MAXTRY      Normal retry limit                @SC86345 03738000
         BAL   14,SHONBIG    Print it                          @SC87166 03739000
          B    RTRN0                                           @SC87166 03740000
         B     SHOGRPZ                                         @SC86345 03741000
*                                                                       03742000
SHOEOL   SR    4,4                                             @SC86133 03743000
         IC    4,REOL(5)                                       @SC86133 03744000
         BAL   14,SHOCTL     Print it                          @SC87166 03745000
          B    SETEOL                                          @SC87166 03746000
         LA    1,SHOPSKW     Skip aliases                      @SC86133 03747000
SHOSIZ   L     8,=A(KMAXE)   Limit                             @SC87166 03748000
         LR    3,5                                             @SC87166 03749000
         SLA   3,2           Get fullword index                @SC87166 03750000
         L     4,RPSIZ(3)                                      @SC87166 03751000
         BAL   14,SHONUM     Print number                      @SC86133 03752000
          B    SETSIZ                                          @SC87166 03753000
SHOPADC  SR    4,4                                             @SC86164 03754000
         IC    4,RPADC(5)    Pad character                     @SC86164 03755000
         BAL   14,SHOCTL                                       @SC87166 03756000
          B    SETPADC                                         @SC87166 03757000
SHOPADN  SR    4,4                                             @SC86164 03758000
         LA    8,KMAX        Same upper limit as packets       @SC87166 03759000
         IC    4,RPADN(5)    Pad count                         @SC86164 03760000
         BAL   14,SHONUM                                       @SC86164 03761000
          B    SETPADN                                         @SC87166 03762000
SHOQUO   LA    8,RCTLQ(5)                                      @SC86133 03763000
         BAL   14,SHOCHRA    Print as ascii                    @SC86133 03764000
          B    SETRCTLQ                                        @SC87166 03765000
SHOMARK  SR    4,4                                             @SC86133 03766000
         IC    4,RMARK(5)                                      @SC86133 03767000
         BAL   14,SHOCTL                                       @SC87166 03768000
          B    RTRN0                                           @SC87166 03769000
SHOTIMO  SR    4,4                                             @SC86164 03770000
         IC    4,RTIMO(5)    Timeout limit                     @SC86164 03771000
         BAL   14,SHONBIG                                      @SC87166 03772000
          B    SETTIMO                                         @SC87166 03773000
*                                                                       03774000
SHOGRPZ  TM    SFLG,ASRF     Doing just receive/send?          @SC86295 03775000
         BO    SHOZZW        Yes, write last line              @SC86227 03776000
         LM    1,2,SHOTMP    Get top level ptr, return adr     @SC87166 03777000
         LR    14,2                                            @SC86224 03778000
         BAL   2,SHOKW       Get ptr to name                   @SC86133 03779000
         LA    1,0(7,6)      Advance to next                   @SC86133 03780000
         BR    14                                              @SC86224 03781000
*                                                                       03782000
SHOLIST  LTR   5,5           Length of list                    @SC86355 03783000
         BZ    SHOZZ         Empty, we're done                 @SC86355 03784000
         LA    0,CMD+75      Set right margin                  @SC86355 03785000
         MVI   0(15),C' '    Start with blank                  @SC86355 03786000
         B     *+8                                             @SC86355 03787000
SHOLSLP  MVI   0(15),C','    Insert delimiter                  @SC86355 03788000
         LA    15,1(15)                                        @SC86355 03789000
         CR    15,0          Any room?                         @SC86355 03790000
         BL    SHOLSED       Yes, ok                           @SC86355 03791000
         LA    1,CMD         No, dump line                     @SC86355 03792000
         SR    15,1                                            @SC86355 03793000
         WTEXT (1),(15)                                        @SC86355 03794000
         MVI   CMD,C' '                                        @SC86355 03795000
         LA    15,CMD+1      Start indented                    @SC86355 03796000
         LA    0,CMD+75                                        @SC86355 03797000
SHOLSED  SR    4,4                                             @SC86355 03798000
         IC    4,0(3)        Get 1-byte item                   @SC86355 03799000
         BAL   2,EDDEC       Format it                         @SC86355 03800000
         LA    3,1(3)        Point to next item in list        @SC86355 03801000
         BCT   5,SHOLSLP                                       @SC86355 03802000
         B     SHOZZ         Finished list                     @SC86355 03803000
*                                                                       03804000
SHOKW    MVC   SETXI+1(3),1(14) Copy instr operands            @SC87166 03805000
         CLI   SETXI,X'97'   'OI' if SET, but 'TM' if SHOW     @SC87166 03806000
         LA    6,5(1)        Ptr to name                       @SC86133 03807000
         LA    7,0           Preserve CC                       @SC86133 03808000
         IC    7,3(1)        Length (assumes high bytes clear) @SC86133 03809000
         LA    7,1(7)                                          @SC86133 03810000
         BR    2                                               @SC86133 03811000
*                                                                       03812000
SHOCTL   LA    8,ABL-1       Max control character (ASCII)     @SC87166 03813000
         TM    FL1,TSTF                                        @SC86295 03814000
         BZ    SHONUM                                          @SC87166 03815000
SHONBIG  L     8,=F'999999998' Almost anything                 @SC87166 03816000
SHONUM   BAL   2,SHOKW                                         @SC86133 03817000
         BE    SETNUM2       Get value for SET                 @SC87166 03818000
         BAL   2,SHONAM      Copy option name                  @SC86209 03819000
         BAL   2,EDDEC       Edit (R4) as decimal              @SC86295 03820000
         B     SHOZZ                                           @SC86133 03821000
*                                                                       03822000
SHOCHRA  MVC   TMP,0(8)      Copy ascii char                   @SC86133 03823000
         PTEXT SETCMDOO+5,3,AREG=8,LREG=9                      @SC87008 03824000
         TM    TMP,X'60'     Is it printable?                  @SC87008 03825000
         BZ    SHOCHRN       No, say it's OFF                  @SC87008 03826000
         TR    TMP,ATOE      Convert to ebcdic                 @SC86133 03827000
         LA    8,TMP                                           @SC86133 03828000
         B     SHOCHR                                          @SC86224 03829000
SHOSTR   BAL   2,SHOKW       Get ptrs to name                  @SC87268 03830000
         BE    SETSTR        Branch to dispatch for SET        @SC87268 03831000
         SR    9,9           Variable-length string            @SC86224 03832000
         IC    9,0(8)        Get length                        @SC86224 03833000
         LA    8,1(8)        Ptr to text                       @SC86224 03834000
         B     SHOCHRD                                         @SC87268 03835000
SHOCHR   LA    9,1           Length is 1                       @SC86224 03836000
SHOCHRN  BAL   2,SHOKW       Get ptrs to name                  @SC86224 03837000
         BER   14            Branch to dispatch for SET        @SC87166 03838000
SHOCHRD  BAL   2,SHONAM      Copy option name                  @SC87268 03839000
         BAL   2,EDCHAR      Append string at (R8)             @SC87034 03840000
         B     SHOZZ         Print message                     @SC87034 03841000
*                                                                       03842000
SHOBRV   CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03843000
         BE    SETSCN                                          @SC87166 03844000
         LR    9,14          Save return adr                   @SC87166 03845000
         LR    8,1           Save list ptr                     @SC87166 03846000
         LR    1,4           Use list of suboptions            @SC87166 03847000
         SR    7,7           Assume 1-char abbrev              @SC87166 03848000
         ICM   7,8,*         Indicate just search              @SC87166 03849000
         BAL   14,SCAN                                         @SC87166 03850000
          CR   0,0           These two skipped                 @SC87166 03851000
          LR   4,1            if bad value                     @SC87166 03852000
         LR    1,8           Retrieve ptrs                     @SC87166 03853000
         LR    14,9                                            @SC87166 03854000
         B     SHOXY         Display it                        @SC87166 03855000
*                                                                       03856000
SHOOO    LA    4,SETOOKW     Ptr to on/off                     @SC87166 03857000
SHOXY    BAL   2,SHOKW       Set up name                       @SC86133 03858000
         BE    SETSCN        Parse value for SET               @SC87166 03859000
         LA    8,5(4)        Value if off                      @SC86133 03860000
         SR    9,9                                             @SC87166 03861000
         IC    9,3(4)        Length of name                    @SC86133 03862000
         EX    0,SETXI       Test bit                          @SC87166 03863000
         BZ    *+12                                            @SC86133 03864000
         LA    8,6(9,8)      Flag is on, advance               @SC86133 03865000
         IC    9,9(9,4)                                        @SC86133 03866000
         LA    9,1(9)                                          @SC86133 03867000
SHOXL    BAL   2,SHONAM      Copy option name                  @SC86209 03868000
         BAL   2,EDCHAR      Append string at (R8)             @SC86295 03869000
         SR    15,9          Back up to string                 @SC87034 03870000
         TR    0(30,15),LOCASE And make it lower case          @SC87034 03871000
         AR    15,9          Resume                            @SC87034 03872000
SHOZZ    ST    15,SHOPTR     Save end address                  @SC86227 03873000
         LA    1,0(7,6)      Advance to next                   @SC86345 03874000
         LA    14,4(14)      Skip over SET branch              @SC87166 03875000
         CLM   14,7,=AL3(SHOTABSZ)                             @SC86355 03876000
         BER   14            Special treatment for tabs        @SC86355 03877000
         TM    SFLG,ALLF     Doing all?                        @SC86295 03878000
         BOR   14            And resume if yes                 @SC86227 03879000
SHOZZW   LA    1,CMD         No, get address of buffer         @SC86227 03880000
         SR    15,1          Get length                        @SC86227 03881000
         WTEXT (1),(15)      Write it out                      @SC86227 03882000
         B     RTRN0         That's all                        @SC86295 03883000
*                                                                       03884000
SHONAM   LA    15,CMD        Output message buffer             @SC86209 03885000
         L     0,SHOPTR      End of prev. msg                  @SC86227 03886000
         CR    0,15          Empty?                            @SC86227 03887000
         BE    SHON1         Yes, start here                   @SC86227 03888000
         LA    1,CMD+23      2nd column                        @SC86227 03889000
         SR    1,0           Far enough?                       @SC86227 03890000
         BP    SHONF         Yes, blank fill                   @SC86227 03891000
         AH    1,=H'23'      Try 3rd column                    @SC86227 03892000
         BP    SHONF         OK                                @SC86227 03893000
         SR    0,15          No room, dump line                @SC86227 03894000
         WTEXT (15),(0)                                        @SC86227 03895000
         LA    15,CMD        And start over                    @SC86227 03896000
         B     SHON1                                           @SC86227 03897000
SHONF    SR    15,15                                           @SC86295 03898000
         ICM   15,8,BLANK                                      @SC86295 03899000
         MVCL  0,14          Fill with blanks to next column   @SC86227 03900000
         LR    15,0          New output ptr                    @SC86227 03901000
SHON1    MVC   0(40,15),0(6) Copy option name                  @SC87034 03902000
         TR    1(39,15),LOCASE And beautify it                 @SC87034 03903000
         AR    15,7          Space over it                     @SC86209 03904000
         MVC   0(4,15),=C' is '                                @SC87034 03905000
         LA    15,4(15)      Space over 'is'                   @SC86209 03906000
         BR    2                                               @SC86209 03907000
*                                                                       03908000
         LOCALS ,                                              @SC86295 03909000
SHOTMP   DS    4F                                              @SC87166 03910000
SHOPTR   DS    A             More temporaries                  @SC86227 03911000
SETXI    DS    F             XI executable instr               @SC86273 03912000
SFLG     DS    X             Local flags                       @SC86295 03913000
ALLF     EQU   X'80'         Doing SHOW ALL                    @SC86295 03914000
ASRF     EQU   X'40'         Doing SHOW REC or SHOW SEND       @SC86295 03915000
SHOW     EXIT                                                           03916000
         TITLE 'STATUS Routine - display latest error, etc.'   @SC86295 03917000
* Exit: R15=0.  ERRNUM unchanged.                                       03918000
STATUS   ENTER                                                 @SC86156 03919000
         CLI   ERRNUM,ERRNFT Actual error?                     @BS86090 03920000
         BNH   STAMSG        No                                @BS86090 03921000
         CLI   ERRNUM,ERRKCE Last command invalid?             @SC86295 03922000
         BE    STAMSG        Yes, do not show last file        @HF86232 03923000
         CLI   FILNAM,0      File name defined?                @BS86090 03924000
         BE    STAMSG        No                                @BS86090 03925000
         MVC   CMD(16),=CL16'Last file used:'                  @BS86090 03926000
         LA    7,CMD+16      Fill in name                      @BS86090 03927000
         LA    1,FILNAM                                        @SC86295 03928000
         BAL   2,STAFSP      Copy name and print               @SC86295 03929000
STAMSG   ICM   4,15,NSENT    Number of files sent              @SC86295 03930000
         BZ    STASNTZ                                         @SC86295 03931000
         LA    15,CMD        Start of message buffer           @SC86295 03932000
         BAL   2,EDDEC       Format number as decimal          @SC86295 03933000
         LA    0,17(15)      Tentative end of message          @SC86295 03934000
         MVC   0(17,15),=C' files sent last.'                  @SC86295 03935000
         BCT   4,STAPLR                                        @SC86295 03936000
         MVC   5(11,15),6(15) Only one file, make singular     @SC86295 03937000
         BCTR  0,0                                             @SC86295 03938000
STAPLR   BAL   2,STAPMSG     Show message                      @SC86295 03939000
STASNTZ  ICM   0,15,PAKCNT   Any transfer statistics?          @SC86295 03940000
         BZ    STADATR       No, skip it                       @SC86316 03941000
         ICM   6,7,=C'pkt'                                     @SC86295 03942000
         BAL   3,STADPR      Format msg                        @SC86295 03943000
         ICM   0,15,SECTOT   Any duration?                     @SC86295 03944000
         BZ    STADATR       No, must have been very short     @SC86316 03945000
         ICM   6,7,=C'sec'                                     @SC86295 03946000
         BAL   3,STADPR      Format msg                        @SC86295 03947000
         MVC   CMD(16),=C'Disk bytes/sec: '                    @SC86295 03948000
         LA    15,CMD+16                                       @SC86295 03949000
         L     0,SECTOT                                        @SC86295 03950000
         LM    4,5,DSKTOT                                      @SC86295 03951000
         BAL   2,STAVB       Format ratio                      @SC86295 03952000
         BAL   2,STAPM15     Print line                        @SC86295 03953000
STADATR  ICM   4,15,RTRCNT   Any retries?                      @SC86316 03954000
         BZ    STADATZ       No                                @SC86316 03955000
         LA    15,CMD        Yes, issue message                @SC86316 03956000
         BAL   2,EDDEC                                         @SC86316 03957000
         MVC   0(20,15),=C' repeat packets sent'               @SC86316 03958000
         LA    15,20(15)                                       @SC86316 03959000
         BAL   2,STAPM15     Print line                        @SC86316 03960000
         L     1,SECTOT                                        @SC86345 03961000
         BAL   9,OPTPKT      Get best packet size              @SC86345 03962000
         LTR   4,15          Valid?                            @SC86345 03963000
         BNP   STADATZ       No, skip it                       @SC86345 03964000
         MVC   CMD(23),=C'Optimumum packet size: '             @SC86345 03965000
         LA    15,CMD+23                                       @SC86345 03966000
         BAL   2,EDDEC       Format it                         @SC86345 03967000
         BAL   2,STAPM15                                       @SC86345 03968000
STADATZ  ICM   4,15,RECTRC   Any truncated records?            @SC87268 03969000
         BZ    STATRCZ       No, ok                            @SC87268 03970000
         LA    15,CMD        Yes, issue message                @SC87268 03971000
         BAL   2,EDDEC                                         @SC87268 03972000
         MVC   0(18,15),=C' records truncated'                 @SC87268 03973000
         LA    15,18(15)                                       @SC87268 03974000
         BAL   2,STAPM15                                       @SC87268 03975000
STATRCZ  DS    0H                                              @SC87268 03976000
         SR    5,5                                             @SC86156 03977000
         IC    5,ERRNUM      Get offset into error table       @SC86156 03978000
         SLL   5,2           Get fullword index                @SC86156 03979000
         A     5,AERRTAB     Pointer address                   @SC86156 03980000
         L     1,0(5)        Msg ptr                           @SC86156 03981000
         SR    0,0                                             @SC86268 03982000
         SLDL  0,8           Msg length                        @SC86316 03983000
         SRL   1,8           Realign adr                       @SC86316 03984000
         WTEXT (1),(0)       Print message                     @SC86268 03985000
         CLI   ERRNUM,ERRTRC Cancelled?                        @SC86316 03986000
         BNE   STACKAB       No                                @SC86316 03987000
         SR    1,1                                             @SC86316 03988000
         CLI   REASON,15     Within table?                     @SC86316 03989000
         BH    *+8           No, must be new                   @SC86316 03990000
         IC    1,REASON      Ok, get the complaint code        @SC86316 03991000
         SLL   1,3           Index into table                  @SC86316 03992000
         LA    1,STACNTB(1)                                    @SC86316 03993000
         LA    0,8           Length of items                   @SC86316 03994000
         WTEXT (1),(0)                                         @SC86316 03995000
STACKAB  CLI   ERRNUM,ERRABO Micro aborted?                    @BS86090 03996000
         BE    *+12          Yes                               @SC87338 03997000
         CLI   ERRNUM,ERRDIE No, disk I/O error?               @SC87338 03998000
         BNE   STARET        No                                @BS86090 03999000
         ICM   0,15,EMSGL    Yes, any message?                 @SC86268 04000000
         BZ    STARET        No                                @BS86090 04001000
         L     1,EMSGP                                         @BS86090 04002000
         WTEXT (1),(0)       Yes, show it                      @SC86268 04003000
STARET   RET                                                   @SC86295 04004000
*                                                                       04005000
STADPR   MVC   CMD(13),=C'Bytes/pkt: S='                       @SC86295 04006000
         LA    15,CMD+13                                       @SC86295 04007000
         STCM  6,7,CMD+6                                       @SC86295 04008000
         LM    4,5,TOUTOT                                      @SC86295 04009000
         BAL   2,STAVB       Format ratio                      @SC86295 04010000
         MVC   0(3,15),=C' R='                                 @SC86295 04011000
         LA    15,3(15)                                        @SC86295 04012000
         LM    4,5,TINTOT                                      @SC86295 04013000
         BAL   2,STAVB       Format ratio                      @SC86295 04014000
         MVC   0(11,15),=C' requiring '                        @SC86295 04015000
         LA    15,11(15)                                       @SC86295 04016000
         LR    4,0                                             @SC86295 04017000
         BAL   2,EDDEC       Format number of units            @SC86295 04018000
         MVI   0(15),C' '                                      @SC86295 04019000
         STCM  6,7,1(15)                                       @SC86295 04020000
         LA    0,4(15)       End of msg                        @SC86295 04021000
         BAL   2,STAPMSG     Print it                          @SC86295 04022000
         BR    3                                               @SC86295 04023000
*                                                                       04024000
STAVB    DR    4,0           Get ratio                         @SC86295 04025000
         AR    4,4                                             @SC86295 04026000
         CR    4,0                                             @SC86295 04027000
         BL    *+8                                             @SC86295 04028000
         A     5,F1          Round up                          @SC86295 04029000
         LR    4,5                                             @SC86295 04030000
         B     EDDEC         Format it                         @SC86295 04031000
*                                                                       04032000
* Table of reasons for rejecting Attribute packet              @SC86316 04033000
STACNTB  DC    C'-Unknown-Length -Type   -Date   '             @SC86316 04034000
         DC    C'-Creator-Account-Area   -Passwrd'             @SC86316 04035000
         DC    C'-Blksize-Access -Coding -Disp   '             @SC86316 04036000
         DC    C'-Protect-Protect-Origin -Format '             @SC86316 04037000
         TITLE 'DUMP Routine - print translation table'                 04038000
* Display current values in STORAG.                                     04039000
* Entry: SCANPTR string has option                                      04040000
* Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM unchanged.   04041000
DUMP     ENTER ALT                                             @SC86156 04042000
         NTOKN N=DUMPH       A or E?                           @SC86156 04043000
         SCAN  DUMPKW,RTRN1                                    @SC86295 04044000
DUMPH    HELP  DUMPKW,RTRN1                                    @SC86295 04045000
*                                                                       04046000
DUMPKW   KW    'ATOE',DUMPA                                    @SC86156 04047000
         KW    'ETOA',DUMPE                                    @SC86156 04048000
         KW    'NAMES',DMPN                                    @SC86295 04049000
         KW    'TATOE',DUMPTA,MIN=2                            @SC87117 04050000
         KW    'TETOA',DUMPTE,MIN=2                            @SC87117 04051000
         KW    ,                                               @SC86156 04052000
*                                                                       04053000
DMPN     L     5,TSENT       Table ptr                         @SC86295 04054000
         ICM   6,15,NSENT    Number of files sent              @SC86295 04055000
         BNZ   DMPNL                                           @SC86295 04056000
         WTEXT 'No files sent'                                 @SC86295 04057000
         B     RTRN0                                           @SC86295 04058000
DMPNL    LA    7,CMD         Start of message buffer           @SC86295 04059000
         LR    1,5                                             @SC86295 04060000
         BAL   2,STAFSP      Show filespec                     @SC86295 04061000
         LA    5,LFID(5)     Advance ptr to next               @SC86295 04062000
         BCT   6,DMPNL                                         @SC86295 04063000
         B     RTRN0                                           @SC86295 04064000
*                                                                       04065000
DUMPA    LA    3,ATOE                                          @SC86156 04066000
         B     DUMPAE                                          @SC86156 04067000
DUMPE    LA    3,ETOA                                          @SC86156 04068000
         B     DUMPAE                                          @SC87117 04069000
DUMPTA   LA    3,TATOE                                         @SC87117 04070000
         B     DUMPAE                                          @SC87117 04071000
DUMPTE   LA    3,TETOA                                         @SC87117 04072000
DUMPAE   LA    4,4           Bytes per word                    @SC86156 04073000
         LA    5,15(3)       End of 1st line                   @SC86156 04074000
         LA    6,16          Bytes per line                    @SC86156 04075000
         LA    7,256(3)      2 before end of table             @SC86156 04076000
DUMPLL   LA    2,CMD         Output buffer                     @SC86156 04077000
DUMPLW   UNPK  0(9,2),0(5,3) Convert a word                    @SC86156 04078000
         TR    0(8,2),TRHEX  Hex notation                      @SC86156 04079000
         MVI   8(2),C' '     Leave a space between words       @SC86156 04080000
         LA    2,9(2)                                          @SC86156 04081000
         BXLE  3,4,DUMPLW    Do next word                      @SC86156 04082000
         LA    1,CMD         Done line of 4                    @SC86156 04083000
         LA    0,35                                            @SC86268 04084000
         WTEXT (1),(0)       Print it                          @SC86268 04085000
         BXLE  5,6,DUMPLL    Done line, go to next             @SC86156 04086000
         B     RTRN0                                                    04087000
         TITLE 'GIVTAB Routine - save translation table'                04088000
* Save current values in STORAG into a TAKE file on disk                04089000
* Entry: SCANPTR string has option                                      04090000
* Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM unchanged.   04091000
GIVTAB   ENTER ALT                                             @SC87117 04092000
         NTOKN N=GIVH       A or E?                            @SC87117 04093000
         SCAN  GIVKW,RTRN1                                     @SC87117 04094000
GIVH     HELP  GIVKW,RTRN1                                     @SC87117 04095000
*                                                                       04096000
GIVKW    KW    'ATOE',GIVA                                     @SC87117 04097000
         KW    'ETOA',GIVE                                     @SC87117 04098000
         KW    'TATOE',GIVTA,MIN=2                             @SC87117 04099000
         KW    'TETOA',GIVTE,MIN=2                             @SC87117 04100000
         KW    ,                                               @SC87117 04101000
*                                                                       04102000
GIVA     LA    6,ATOE-1                                        @SC87117 04103000
         B     GIVA1                                           @SC87117 04104000
GIVE     LA    6,ETOA-1                                        @SC87117 04105000
         B     GIVE1                                           @SC87117 04106000
GIVTA    LA    6,TATOE-1                                       @SC87117 04107000
GIVA1    LA    0,ATOED                                         @SC87117 04108000
         B     GIVAE                                           @SC87117 04109000
GIVTE    LA    6,TETOA-1                                       @SC87117 04110000
GIVE1    LA    0,ETOAD                                         @SC87117 04111000
GIVAE    SR    15,15                                           @SC87117 04112000
         IC    15,3(1)       Get length of name                @SC87117 04113000
         MVC   GIVBUF(4),=C'SET '                              @SC87117 04114000
         MVC   GIVBUF+4(10),5(1)  Copy name to command         @SC87117 04115000
         LA    15,GIVBUF+5(15)                                 @SC87117 04116000
         MVI   0(15),C' '                                      @SC87117 04117000
         LA    15,1(15)      Get ptr for 1st argument          @SC87117 04118000
         LR    1,0                                             @SC87117 04119000
         BCTR  0,0           Back up to start at "difference"  @SC87117 04120000
         STM   15,1,GIVSV    Save ptrs: cmd, table, table start@SC87117 04121000
         LA    7,257         Table length + 1                  @SC87117 04122000
         LA    0,FFGIV                                         @SC87117 04123000
         KCALL FSPEC,FILNAM,E=GIVFNE  Error                    @SC87117 04124000
         MVI   ERRNUM,ERRNOE Ok now                            @SC87117 04125000
         OPENF O,FILNAM,LOGFDB,GIVPTR,E=GIVOPERR               @SC87117 04126000
GIVLP    LM    15,0,GIVSV    Get output ptr, table scan ptr    @SC87117 04127000
         LA    6,1(6)        Skip last difference              @SC87117 04128000
         AH    0,*-2                                           @SC87117 04129000
         BCTR  7,0           New length left                   @SC87117 04130000
         LR    1,7           Copy length                       @SC87117 04131000
         CLCL  0,6           Find next difference              @SC87117 04132000
         BE    GIVFIN        All done                          @SC87117 04133000
         ST    0,GIVSV+4     Save new ptr                      @SC87117 04134000
         LR    4,0           Get offset                        @SC87117 04135000
         S     4,GIVSV+8                                       @SC87117 04136000
         BAL   2,EDDEC       Write as decimal                  @SC87117 04137000
         MVI   0(15),C' '    Leave space                       @SC87117 04138000
         LA    15,1(15)                                        @SC87117 04139000
         IC    4,0(6)        Get tailored character            @SC87117 04140000
         BAL   2,EDDEC       Write as decimal                  @SC87117 04141000
         LA    2,GIVBUF                                        @SC87117 04142000
         SR    15,2          Length of line                    @SC87117 04143000
         WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR         @SC87117 04144000
         B     GIVLP                                           @SC87117 04145000
GIVWRERR CLOSF GIVPTR        Close output file                 @SC87117 04146000
GIVOPERR PTEXT 'Unable to write file'                          @SC87117 04147000
GIVFNE   WTEXT (3),(4)       Show message                      @SC87117 04148000
         B     RTRN1                                           @SC87117 04149000
GIVFIN   CLOSF GIVPTR,E=GIVOPERR Close output file             @SC87117 04150000
         B     RTRN0                                           @SC86295 04151000
         LOCALS ,                                              @SC86295 04152000
GIVSV    DS    3F            Saved ptrs for saving table       @SC87117 04153000
GIVPTR   DS    A             Ticket for disk I/O               @SC87117 04154000
GIVBUF   DS    CL25          Buffer for new file               @SC87117 04155000
         EXIT                                                  @SC86164 04156000
         TITLE 'GENCMD Routine - send a Generic command'       @SC86155 04157000
* Entry: SCANPTR has string                                             04158000
* Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter               04159000
*       ERRNUM set appropriately                                        04160000
GENCMD   ENTER                                                 @SC86155 04161000
         LA    8,1           One operand                       @SC86295 04162000
         LTR   1,1                                             @SC86295 04163000
         BZ    REMCMD        Parse REMOTE command              @SC86295 04164000
         LA    0,AG          Packet type = generic command     @SC86155 04165000
GENNUL   SR    5,5           NO ARGUMENTS                      @SC86316 04166000
GENFILL  STC   0,STYPE       Set packet type                   @SC86155 04167000
         L     3,RBUF        Put string here                   @SC86155 04168000
         CLI   STYPE,AG      Generic?                          @SC86155 04169000
         BNE   GENOTH1       No subcommand                     @SC86155 04170000
         STC   1,0(3)        Save subcommand byte              @SC86155 04171000
         LA    3,1(3)        Move to next character position   @SC86155 04172000
         B     GENOTH1                                         @SC86295 04173000
GENNXT   NTOKN N=RTRN1       Get next argument                 @SC86295 04174000
         LA    5,1(7)        Length                            @SC86295 04175000
         LR    4,6           Address                           @SC86295 04176000
GENOTH1  LTR   1,5           Any argument?                     @SC86155 04177000
         BZ    GENFILZ       No, done                          @SC86155 04178000
         CLI   STYPE,AG      Generic?                          @SC86155 04179000
         BNE   GENOTH2       No, skip length indicator         @SC86155 04180000
         TOCHR 1,,0(3)       Yes, do it                        @SC86155 04181000
         LA    3,1(3)                                          @SC86155 04182000
GENOTH2  MVC   0(96,3),0(4)  Copy argument                     @SC86155 04183000
         TR    0(96,3),ETOA  in ASCII                          @SC86155 04184000
         AR    3,5           Advance ptr                       @SC86155 04185000
         BCT   8,GENNXT                                        @SC86295 04186000
GENFILZ  S     3,RBUF        Length of buffer                  @SC86155 04187000
         ST    3,RBUFL       Set buffer size                   @SC86155 04188000
         BAL   8,IPKSET      Set state table, exchange parms   @SC86155 04189000
         DC    AL1(AY),AL3(0)        ACK'ed     Must be just   @SC86155 04190000
         DC    AL1(00),AL3(GENABR)   Error.    these 2 items.  @SC86155 04191000
         BAL   8,GENSET      Set state table                   @SC86155 04192000
* Server cmd Rpack interpret input table                       @SC86155 04193000
         DC    AL1(AY),AL3(0)        ACK'ed                    @SC86155 04194000
         DC    AL1(AS),AL3(GENRPL)   Long reply                @SC86155 04195000
         DC    AL1(00),AL3(GENABR)   Error                     @SC86155 04196000
GENSET   BAL   9,ENCODEN     Encode command                    @SC86295 04197000
         BAL   9,INPUTSPK    Send, get response                @SC86295 04198000
         MVI   ERRNUM,ERRNOE No errors                         @SC86155 04199000
         ICM   0,15,DATL     Any short reply?                  @SC86155 04200000
         BZ    GENRET        No, done                          @SC86155 04201000
         NI    FL1,255-EOF   Yes, set flags                    @SC86155 04202000
         XC    WBUFL,WBUFL   Clear old data                    @SC86155 04203000
         OI    LOGFLGS,APPN  DISP=MOD                          @SC86295 04204000
         BAL   2,GENRPS      Set up file name                  @SC86295 04205000
         OPENF O,REPNAM,LOGFDB,FILPTR,E=GENABR                 @SC86295 04206000
         USING FDBD,1                                          @SC86295 04207000
         SR    0,0                                             @SC86295 04208000
         ICM   0,3,FDBLRC                                      @SC86295 04209000
         ST    0,FSIZE       Copy LRECL                        @SC86295 04210000
         MVC   FRECF,FDBRCF  Copy RECFM                        @SC86295 04211000
         DROP  1                                               @SC86155 04212000
GENOPN   KCALL DECODE,E=GENAB2 Copy message to output          @SC86155 04213000
         CLC   WBUFL,F0      Any more?                         @SC86155 04214000
         BE    GENRPZ                                          @SC86155 04215000
         KCALL OUTBUF,E=GENAB2  Yes, copy that as well         @SC86155 04216000
GENRPZ   CLOSF FILPTR                                          @SC86295 04217000
         MVI   ERRNUM,ERRNOE No errors                         @SC86155 04218000
         B     GENFIN                                          @SC86295 04219000
*                                                                       04220000
GENRPL   OI    FL2,SRV       Pretend this is server mode       @SC86155 04221000
         BAL   2,GENRPS      Set up file name                  @SC86295 04222000
         KCALL RECEIV                                          @SC86155 04223000
         NI    FL2,255-SRV                                     @SC86155 04224000
         B     GENFIN                                          @SC86155 04225000
*                                                                       04226000
GENRPS   LA    0,L'REPNAM    Name string length                @SC86295 04227000
         LA    1,REPNAM      and address                       @SC86295 04228000
         STM   0,1,SCANPTR                                     @SC86295 04229000
         LA    0,FFRCF                                         @SC86295 04230000
         KCALL FSPEC,FILNAM  Convert to filespec               @SC86295 04231000
         IC    9,FL3         Save flags                        @SC86295 04232000
         OI    FL3,APPN      Don't erase it                    @SC86295 04233000
         BR    2                                               @SC86295 04234000
*                                                                       04235000
GENAB2   CLOSF FILPTR                                          @SC86295 04236000
GENABR   KCALL ERPACK                                          @SC86155 04237000
GENFIN   STC   9,FL3         Restore flags                     @SC86295 04238000
GENRET   KCALL INTINI,0                                        @SC86155 04239000
         B     RTRN0                                           @SC86295 04240000
*                                                                       04241000
* Make foreign Kermit execute command                                   04242000
REMCMD   NTOKN N=RTRN2                                         @SC86295 04243000
         SCAN  REMCMDKW,RTRN1                                  @SC86295 04244000
         B     RTRN2                                           @SC86295 04245000
*                                                                       04246000
REMCMDKW KW    'COPY',REMCOP,MIN=2                             @SC86295 04247000
         KW    'CWD',REMARG,MIN=3                              @SC86295 04248000
         KW    'DIRECTORY',REMARG,MIN=3                        @SC86155 04249000
         KW    'ERASE',REMARG                                  @SC86155 04250000
         KW    'HELP',REMARG                                   @SC86155 04251000
         KW    'HOST',REMHST,MIN=2                             @SC86155 04252000
         KW    'KERMIT',REMKRM                                 @SC86155 04253000
         KW    'RENAME',REMREN                                 @SC86295 04254000
         KW    'SPACE',REMSPA,MIN=2                            @SC86155 04255000
         KW    'TYPE',REMARG,MIN=2                             @SC86155 04256000
         KW    ,                                               @SC86155 04257000
*                                                                       04258000
REMHST   LA    0,AC          Host command                      @SC86155 04259000
         B     REMPRS                                          @SC86155 04260000
*                                                                       04261000
REMKRM   LA    0,AK          KERMIT command                    @SC86155 04262000
REMPRS   FTOKN N=RTRN1       See if anything given             @SC86295 04263000
         LR    4,7                                             @SC86295 04264000
         LR    5,6           Use whole string                  @SC86295 04265000
         B     GENFILL                                         @SC86295 04266000
*                                                                       04267000
REMSPA   LA    1,AU          Space command                     @SC86155 04268000
         B     REMPRSG                                         @SC86155 04269000
*                                                                       04270000
REMCOP   LA    8,2           Copy: two files                   @SC86295 04271000
         LA    1,AK                                            @SC86295 04272000
         B     REMPRSG                                         @SC86295 04273000
REMREN   LA    8,2           Rename: two files                 @SC86295 04274000
*                                                                       04275000
REMARG   SR    1,1                                             @SC86155 04276000
         IC    1,0(6)        1st letter is abbrev              @SC86155 04277000
         IC    1,ETOA(1)     ASCII                             @SC86155 04278000
REMPRSG  LA    0,AG          (generic)                         @SC86155 04279000
         NTOKN N=GENNUL      Skip any blanks                   @SC86295 04280000
         LA    5,1(7)        Save length                       @SC86295 04281000
         LR    4,6           Save ptr                          @SC86295 04282000
         B     GENFILL       Copy to output                    @SC86155 04283000
         LOCALS ,                                              @SC86295 04284000
REMCMD   EXIT  ,                                               @SC86155 04285000
