*COPY                                                 IK0CMD            03000000
         CHECKVER IK0CMD,4.3                                   @SC90072 03000500
         TITLE 'USNTRF Routine - execute main loop'                     03001000
* Execute Kermit commands (beginning with default TAKE files)           03001500
* Entry: environment already set up                                     03002000
* Exit: R15=0                                                           03002500
*       ERRNUM set appropriately                                        03003000
USNTRF   ENTER                                                          03003500
         LA    0,KRMPROT                                       @SC86295 03004000
         LA    1,USNCMD      Full list of commands             @SC87117 03004500
         BAL   14,LOOPS      Set up loop return                @SC86295 03005000
         LA    2,USRTAKE                                                03005500
         LA    1,LUSRT       Length of name                    @SC86295 03006000
         BAL   9,LUPTIN      Test user KERMINI                 @SC86295 03006500
           NOP 0             Not found, skip it                @SC86295 03007000
         LA    2,SYSTAKE                                       @SC86135 03007500
         LA    1,LSYST       Length of name                    @SC86295 03008000
         BAL   9,LUPTIN      Test system KERMINI               @SC86295 03008500
           NOP 0             Not found, skip it                @SC86295 03009000
         MVI   ERRNUM,ERRNFT No transfers yet                  @SC86295 03009500
         KCALL SUPFNC,6,E=LOOP                                 @SC86295 03010000
         OI    KFLG,CMDL+SIGN Got command line, suppress banner@SC86295 03010500
         B     LOOP                                            @SC86295 03011000
*                                                                       03011500
KRMININC WTEXT 'Kermit-&KSYS Version &KVRSN..&KEDIT &KTAG (&KDATE.)'    03012000
         WTEXT '&ENTHINT'                                      @SC91295 03012500
         OI    KFLG,SIGN     Banner done                       @SC86295 03013000
KRMPROB  PTEXT BLANK,1               And leave a blank line             03013500
         B     LUPWRT        Not an error                      @SC86295 03014000
*                                                                       03014500
KRMPROT  TM    KFLG,CMDL                                       @SC86295 03015000
         BZ    KRMPROCL              Go if Not cmd line                 03015500
         NI    KFLG,255-CMDL Turn off command line             @SC86295 03016000
         OI    KFLG,CMDC     Command from cmd line             @SC86295 03016500
         L     1,CBUF                address of cmd                     03017000
         L     0,CLEN        Length                            @SC86171 03017500
         B     LUPPRS        Go process it                     @SC86295 03018000
*                                                                       03018500
KRMPROCL TM    KFLG,CMDC                                       @SC86295 03019000
         BZ    KRMPROR               Go if not cmd line                 03019500
         KCALL SUPFNC,7,E=(KRMXITQ,Z) Go if nothing stacked    @SC86295 03020000
KRMPROR  TM    KFLG,SIGN     Already printed banner?           @SC86295 03020500
         BO    KRMPROX       Yes, or suppressed                @SC86295 03021000
         KCALL SUPFNC,7,E=(KRMININC,Z) Go if nothing stacked   @SC86295 03021500
KRMPROX  LA    3,CMD                                           @SC86295 03022000
         LA    4,KPRPT       Current prompt                    @SC87268 03022500
         SR    0,0                                             @SC87268 03023000
         IC    0,KPRPL       Prompt length                     @SC87268 03023500
         RTEXT (3),PROMPT=((4),(0))                            @SC87268 03024000
         LA    1,CMD         Ptr to command                    @SC86171 03024500
         B     LUPPRS        Go process it                     @SC86295 03025000
*                                                                       03025500
USNCMD   KW    '&AAAEXIT',KRMXIT,MIN=2                         @SC92300 03026000
         KW    '&AAAQUIT',KRMXIT                               @SC92300 03026500
         AIF   ('&KSYS' NE 'TSO').TS0Z                         @SC88035 03027000
         KW    '&AAAAEND',KRMXIT,MIN=2  Synonym for QUIT       @SC88035 03027500
.TS0Z    ANOP                                                           03028000
USNCMDX  KW    '&AAAABYE',KRMBYE,MIN=3                         @SC86155 03028500
         KW    '&AAAADIR',KRMDIR,MIN=3                         @SC86295 03029000
         KW    '&AAAECHO',KRMECO,MIN=2                         @SC92300 03029500
         KW    '&AAAAFIN',KRMFIN,MIN=3                         @SC86155 03030000
         KW    '&AAAAGET',KRMGET                               @SC86155 03030500
         KW    '&AAAHELP',KRMHLP                               @SC92300 03031000
         KW    '&AALOCAL',LUPTOK,MIN=3                         @SC86295 03031500
         KW    '&RECEIVE',KRMREC,MIN=3                         @SC92300 03032000
         KW    '&REMOTE',KRMREM,MIN=3                          @SC86155 03032500
         KW    '&AAASEND',KRMSND,MIN=3                         @SC92300 03033000
         KW    '&AAASERV',KRMSRV,MIN=3                         @SC92300 03033500
         KW    '&AAXECHO',KRMXPE,MIN=2                         @SC86204 03034000
         KW    '&AAXTYPE',KRMNPS,MIN=2                         @SC86204 03034500
SRVKCMD  KW    '&KSYS.',LUPHST,MIN=2  Valid in Server mode ... @SC86295 03035000
         AIF   ('&KSYS' NE 'CMS').CM0Z                         @SC86355 03035500
         KW    'CP',LUPCP,MIN=2                                @SC86295 03036000
.CM0Z    KW    'CWD',LUPCWD,MIN=2                              @SC86295 03036500
         KW    '&AAAGIVE',LUPGIV,MIN=2                         @SC87117 03037000
         KW    '&AAAHINT',LUPHNTS                              @SC91295 03037500
         KW    '&AAAHOST',LUPHST,MIN=2                         @SC87253 03038000
         KW    'KERMIT',LUPKRM                                 @SC90059 03038500
         KW    '&SIMULAT',LUPSIM,MIN=2                         @SC91312 03039000
USNCSET  KW    '&AAAASET',LUPSET,MIN=3                         @SC91320 03039500
         KW    '&AAASHOW',LUPSHO,MIN=2                         @SC86295 03040000
         KW    '&AASPACE',LUPSPA,MIN=2                         @SC86295 03040500
         KW    '&ASTATUS',LUPSTA,MIN=2                         @SC86295 03041000
         KW    '&AAATAKE',LUPTAK,MIN=2                         @SC86295 03041500
         KW    '&AATDUMP',LUPDMP,MIN=2                         @SC86295 03042000
         KW    '&AAATYPE',LUPHSTI,MIN=TYPMIN                   @SC88018 03042500
         KW    '&VERSION',LUPVERS,MIN=2                        @SC90339 03043000
         KW                                                             03043500
*                                                                       03044000
KRMECO   L     3,ADR                 Pick rest of line                  03044500
         ICM   4,B'1111',LEN         Remaining data length              03045000
         BNP   KRMPROB               Go if nothing left in cmd          03045500
         B     LUPWRT        Else, print the rest              @SC86295 03046000
*                                                              @SC86155 03046500
KRMREM   KCALL GENCMD,0,E=LUPERK Send remote command           @SC86295 03047000
         B     KRMXFZ                                          @SC87300 03047500
*                                                              @SC86155 03048000
KRMBYE   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03048500
         KCALL GENCMD,AL     Send Logout command               @SC86155 03049000
         B     KRMXFZ                                          @SC87300 03049500
*                                                                       03050000
KRMFIN   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03050500
         KCALL GENCMD,AF     Send Finish command               @SC86155 03051000
         B     KRMXFZ                                          @SC87300 03051500
*                                                                       03052000
KRMGET   PTEXT '&FORFSPC - ',AREG=1,LREG=0                     @SC88035 03052500
         BAL   2,USNASKA     Prompt if user omitted args       @SC88035 03053000
         LA    0,FFGET                                         @SC88049 03053500
         KCALL FSPEC,JFSPEC  Get foreign filespec              @SC86295 03054000
         BAL   14,LUPCKFN                                      @SC86295 03054500
         PTEXT '&SYSFSPC - ',AREG=1,LREG=0                     @SC88035 03055000
         BAL   2,USNASKT     Prompt if necessary               @SC88035 03055500
         LA    0,FFGET+FFRCF                                   @SC88049 03056000
         KCALL FSPEC,FILNAM  Get native filespec, if any       @SC86295 03056500
         BAL   14,LUPCKFN                                      @SC86295 03057000
         BAL   14,LUPCNF     Check for illegal extras          @SC86295 03057500
         TM    FL3,APPN      Going to append anyway?           @SC90033 03058000
         BO    USNGCK        Yes, ignore collisions            @SC90033 03058500
         TM    FL1,REN+ROVR  Warning ON and name given?        @SC88089 03059000
         BNO   USNGCK        No, don't check for collision yet @SC88089 03059500
         LA    0,FFNEW+FFGET                                   @SC87012 03060000
         KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions         @SC87012 03060500
USNGCK   DS    0H                                              @SC88089 03061000
         BAL   8,IPKSET      Set state table, exchange parms   @SC86295 03061500
* Init packet  Rpack interpret input tables                    @SC86155 03062000
         DC    AL1(AY),AL3(0)        ACK'ed                    @SC86155 03062500
         DC    XL1'FF',AL3(KRMGETAB) Stop                      @SC88074 03063000
         DC    AL1(00),AL3(KRMGETAB) Error                     @SC86155 03063500
         BAL   9,PAKFIL      Copy file specification to buffer @HF86223 03064000
         BAL   9,ENCODEN     Encode file-spec                  @SC86295 03064500
         MVI   STYPE,AR      Packet type = receive initiate    @SC86155 03065000
         KCALL SPACK,E=KRMGETAB Send name                      @SC86155 03065500
         KCALL RECEIV                                          @SC86155 03066000
         B     KRMXFZ                                          @SC86239 03066500
*                                                                       03067000
KRMGETAB KCALL INTINI,0                                        @SC86155 03067500
         B     KRMXFZ                                          @SC87300 03068000
*                                                                       03068500
KRMREC   LA    0,FFRCF                                         @SC86295 03069000
         KCALL FSPEC,FILNAM  Get filespec                      @SC86295 03069500
         BAL   14,LUPCKFN                                      @SC86295 03070000
         BAL   14,LUPCNF     Check for illegal extras          @SC86295 03070500
         TM    FL3,APPN      Going to append anyway?           @SC90033 03071000
         BO    USNRCK        Yes, ignore collisions            @SC90033 03071500
         TM    FL1,REN+ROVR  Warning ON and name given?        @SC88089 03072000
         BNO   USNRCK        No, don't check for collision yet @SC88089 03072500
         LA    0,FFNEW+FFGET                                   @SC87012 03073000
         KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions         @SC87012 03073500
         TM    FL4,NMCHNG                                      @SC90061 03074000
         BZ    USNRCK                                          @SC90061 03074500
         PTEXT '&COLDISC'                                      @SC90061 03075000
         CLI   CLSNFL,C'D'                                     @SC90061 03075500
         BE    LUPWRTE                                         @SC90061 03076000
USNRCK   DS    0H                                              @SC88089 03076500
         KCALL INTINI,3,E=KRMXFZ  Initialize for receive       @SC87300 03077000
         MVI   RTYPE,0       No packet read yet                @SC88074 03077500
         KCALL RECEIV                                                   03078000
         B     KRMXFZ                                          @SC86239 03078500
*                                                                       03079000
KRMNPS   OI    FL4,NPS                                         @SC86165 03079500
         MVI   TCTLQ,0       Turn off control quoting          @SC86165 03080000
*                                                                       03080500
KRMSND   PTEXT '&SYSFSPC - ',AREG=1,LREG=0                     @SC88035 03081000
         BAL   2,USNASKA     Prompt if necessary               @SC88035 03081500
         SR    6,6           No extra files yet                @SC88306 03082000
         L     7,MSNDBUF     Start of buffer                   @SC88306 03082500
USNSND1  DS    0H                                              @SC88306 03083000
         LA    0,FFSND                                         @SC88035 03083500
         KCALL FSPEC,IFILE   Get filespec                      @SC86295 03084000
         BAL   14,LUPCKFN                                      @SC86295 03084500
         PTEXT '&FORFSPC - ',AREG=1,LREG=0                     @SC88035 03085000
         BAL   2,USNASKT     Prompt if user omitted args       @SC88035 03085500
         LA    0,FFSND+FFRCF                                   @SC86295 03086000
         KCALL FSPEC,JFSPEC  Get filespec                      @SC86295 03086500
         BAL   14,LUPCKFN                                      @SC86295 03087000
         CLI   BRK,C','      Multi-file option?                @SC88306 03087500
         BNE   USNSND2                                         @SC88306 03088000
         A     6,F1          Count files to send               @SC88306 03088500
         PTEXT '&MANYFIL'                                      @SC88306 03089000
         CH    6,=Y(MSNDMAX) Too many?                         @SC88306 03089500
         BH    LUPINV        Too bad                           @SC88306 03090000
         MVC   0(LFSTF,7),IFILE Save filespecs + options       @SC89218 03090500
         LA    7,LFSTF(,7)   Advance ptr into buffer           @SC89218 03091000
         PTEXT '&SYSFSPC - ',AREG=1,LREG=0                     @SC88306 03091500
         BAL   2,USNASKT     Prompt if necessary               @SC88306 03092000
         B     USNSND1       Go for another name               @SC88306 03092500
USNSND2  ST    7,MSNDPTR     Save buffer scan ptr              @SC88306 03093000
         BAL   14,LUPCNF     Check for illegal extras          @SC86295 03093500
KRMSNDBG KCALL SEND,0                                          @SC90239 03094000
KRMXFZ   SR    3,3                                             @SC86355 03094500
         ICM   3,1,ERRNUM    Ok?                               @SC86355 03095000
         BZ    LOOP          Yes, get next command             @SC86355 03095500
         KCALL PEMSG         No, convert error number          @SC91064 03096000
         OI    FL5,CMERR     Note error                        @SC91064 03096500
         B     LOOP                                            @SC91064 03097000
*                                                                       03097500
USNASKA  NI    KFLG,255-PRMP Assume no prompting               @SC88035 03098000
         FTOKN N=USNASK      Check for some text waiting       @SC88035 03098500
         BR    2             Ok, use it                        @SC88035 03099000
USNASKT  TM    KFLG,PRMP     Is prompting required?            @SC88035 03099500
         BZR   2             No, ok                            @SC88035 03100000
USNASK   OI    KFLG,PRMP     Must prompt for both filespecs    @SC88035 03100500
         LA    3,CMD         Use input buffer                  @SC88035 03101000
         ST    3,ADR                                           @SC88035 03101500
         RTEXT (3),PROMPT=((1),(0)) Ask for filespec           @SC88035 03102000
         ST    0,LEN         Save string length                @SC88035 03102500
         BR    2                                               @SC88035 03103000
*                                                                       03103500
KRMXPE   L     5,ADR         Pointer to rest of line           @HF86150 03104000
         ICM   4,15,LEN      Remaining data length             @HF86150 03104500
         BNP   KRMXPEH       Go if nothing specified           @HF86150 03105000
         L     3,RBUF                                          @HF86150 03105500
         MVC   0(256,3),0(5) Copy to disk read buffer          @HF86150 03106000
         AR    4,3           Get end                           @HF86150 03106500
         STM   3,4,TXTPTR    Point to text to copy             @HF86150 03107000
         OI    FL4,SFM+NPS   Data source: text string          @SC86165 03107500
         XC    FLNOPTS(LFOPTS),FLNOPTS                         @SC91116 03108000
         MVI   TCTLQ,AUP     Turn on control quoting           @SC86165 03108500
         MVC   MSNDPTR,MSNDBUF No extra files                  @SC88306 03109000
         B     KRMSNDBG                                        @SC86165 03109500
*                                                                       03110000
KRMXPEH  PTEXT '&XTYPMSG'                                      @SC86165 03110500
         B     LUPWRT                                          @SC86295 03111000
*                                                                       03111500
KRMSRV   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03112000
         KCALL SERVER        Call SERVER routine               @SC86295 03112500
         B     KRMXFZ        Return to normal mode             @SC86355 03113000
*                                                                       03113500
KRMDIR   LA    0,FFUTL+FFWLD                                   @SC86295 03114000
         KCALL FSPEC,FILNAM  Get pattern filespec              @SC86295 03114500
         BAL   14,LUPCKFN    Make sure ok                      @SC86295 03115000
         PTEXT '&NOTFOUN'    File not found if error here      @SC90264 03115500
         LA    0,13                                            @SC86295 03116000
         KCALL DISKIO,FILNAM,E=LUPFNF Do a DIR on it           @SC90264 03116500
         MVI   ERRNUM,ERRNOE No problem                        @SC90264 03117000
         B     LOOP                                            @SC86295 03117500
*                                                                       03118000
KRMHLP   KCALL KHELP         Issue help request                @SC86355 03118500
         B     LOOP                                            @SC86355 03119000
*                                                                       03119500
KRMXIT   FTOKN N=KRMXITQ,H=LUPCRH Check for illegal extras     @SC86295 03120000
         B     LUPBAD        Not just QUIT, maybe system Q     @SC86295 03120500
*                                                                       03121000
KRMXITQ  NXTFSET ,END        Flush pending file list           @SC86355 03121500
         L     2,TAKLEVK                                       @SC86295 03122000
KRMXITL  BCTR  2,0                                             @SC86295 03122500
         LTR   3,2           Any pending TAKE files?           @SC86295 03123000
         BM    RTRN0         No                                @SC86295 03123500
         SLA   3,2                                             @SC86295 03124000
         CLOSF TAKTABK(3)    Close the open file               @SC86295 03124500
         B     KRMXITL       Keep checking                     @SC86295 03125000
         LOCALS ,                                              @SC86295 03125500
* See SERVER for mapping                                       @SC86295 03126000
         DS    A             Return adr if no more TAKE stuff  @SC86295 03126500
         DS    A             Adr of command table              @SC86295 03127000
TAKLEVK  DS    F             Take file level                   @SC86295 03127500
TAKTABK  DS    (TAKMAX)F     Tickets for I/O                   @SC86295 03128000
KFLG     DS    X             Local flags in main program       @SC86295 03128500
PRMP     EQU   X'10'         Prompting for filespecs           @SC88035 03129000
SIGN     EQU   X'04'         Already printed Kermit banner     @SC86295 03129500
CMDC     EQU   X'02'         Command gotten from cmd                    03130000
CMDL     EQU   X'01'         Data on cmd line                           03130500
USNTRF   EXIT                                                           03131000
         TITLE 'SIMLAT Routine - set up to replay a file'      @SC91312 03131500
* Begin to read a file for supplying incoming packets in lieu  @SC91312 03132000
*   of reading them from the communication line                @SC91312 03132500
* Entry: ADR,LEN point to file name                            @SC91312 03133000
* Exit: R15=0 if ok, 1 if bad (message already printed)        @SC91312 03133500
*     ERRNUM set appropriately                                 @SC91312 03134000
SIMLAT   ENTER ,                                               @SC91312 03134500
         BAL   9,SIMCLS      Close old input file, if any      @SC91312 03135000
         SR    0,0                                             @SC91312 03135500
         KCALL FSPEC,FILNAM,E=SIMERR  Get filespec             @SC91312 03136000
         MVI   ERRNUM,ERRNOE Reset error                       @SC91312 03136500
         FTOKN N=SIMOK,H=SIMCRH                                @SC91312 03137000
         PTEXT '&EXTRAOP'                                      @SC91312 03137500
         B     SIMERR                                          @SC91312 03138000
SIMOK    OPENF I,FILNAM,FILFDB,SIMPTR,E=SIMFNF                 @SC91312 03138500
         B     RTRN0                                           @SC91312 03139000
SIMFNF   BAL   9,SIMCLS      Close input file                  @SC91312 03139500
         MVI   ERRNUM,ERRFNF File not found                    @SC91312 03140000
SIMERF   PTEXT '&SIMSHRT'                                      @SC91312 03140500
         B     SIMERR                                          @SC91312 03141000
*                                                                       03141500
SIMCLS   CLOSF SIMPTR        Close it                          @SC91312 03142000
         BR    9                                               @SC91312 03142500
*                                                                       03143000
SIMCRH   PTEXT '&NOOPERS'                                      @SC91312 03143500
SIMERR   WTEXT (3),(4)       Return error message              @SC91312 03144000
         B     RTRN1                                           @SC91312 03144500
*                                                                       03145000
         LOCALS ,                                              @SC91312 03145500
         EXIT                                                  @SC91312 03146000
         TITLE 'SET Routine - perform SET command options'              03146500
* Set/change values in STORAG.                                          03147000
* Entry: SCANPTR string has option                                      03147500
* Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name          03148000
*       ERRNUM unchanged                                                03148500
SET      ENTER                                                          03149000
         MVI   SETXI,X'97'   XI instruction                    @SC86273 03149500
         NTOKN N=RTRN2                                         @SC86171 03150000
         NI    FL3,255-PXCH  Make sure server renegotiates     @SC86295 03150500
         L     3,=A(SETCMDS)                                   @SC90040 03151000
         USING SETCMDS,3     Address CSECT throughout          @SC90040 03151500
         SCAN  SETCMDKW,RTRN1                                  @SC86295 03152000
         B     RTRN2                                           @SC86295 03152500
*                                                                       03153000
SETCMDS  CSECT                                                 @SC90040 03153500
SETTTKW  KW    'KP',SETTTKP  Special TTABLE option             @SC90278 03154000
         KW    '&AAAAOFF',SETTTF,MIN=2                         @SC92352 03154500
         KW    '&AAAAAON',SETTTN,MIN=2                         @SC92352 03155000
         KW    ,                                               @SC92352 03155500
*                                                                       03156000
SETOOKW  KW    '&AAAAOFF',SETOFF,MIN=2                         @SC87166 03156500
         KW    '&AAAAAON',SETON,MIN=2                          @SC87166 03157000
         KW    ,                                               @SC87166 03157500
*                                                                       03158000
SETOOFRC KW    '&AAAAOFF',SETOFFL,MIN=2                        @SC91275 03158500
SETOFRC  KW    '&AAAAAON',SETONL,MIN=2                         @SC91275 03159000
         KW    '&AFORCED',SETFRC                               @SC91275 03159500
         KW    ,                                               @SC91275 03160000
*                                                                       03160500
SETCMDOO KW    '&AAAAOFF',SETOFFS,MIN=2                        @SC87166 03161000
SETONKW  KW    '&AAAAAON',SETONS,MIN=2                         @SC87166 03161500
         KW    ,                                               @SC86171 03162000
SET      CSECT                                                 @SC90040 03162500
*                                                                       03163000
SETFRC   MVI   LCKFRC,X'21'  Enable FORCE mode                 @SC91275 03163500
         B     SETON                                           @SC91275 03164000
*                                                                       03164500
SETTTF   LA    1,ATOE        Use normal tables                 @SC92352 03165000
         LA    2,ETOA                                          @SC92352 03165500
         STM   1,2,AEPTRS                                      @SC92352 03166000
         B     SETOFF                                          @SC92352 03166500
SETOFFL  MVI   LCKFRC,0      Disable FORCE mode                @SC91275 03167000
SETOFF   EX    0,0(9)        Yes, first turn flag on...        @SC87166 03167500
         EX    0,SETXI       Then off                          @SC86273 03168000
         B     RTRN0                                           @SC87166 03168500
*                                                                       03169000
SETONL   MVI   LCKFRC,0      Disable FORCE mode                @SC91275 03169500
SETON    EX    0,0(9)        Turn flag on                      @SC87166 03170000
         B     RTRN0                                           @SC87166 03170500
*                                                                       03171000
SETOFFS  B     4(9)                                            @SC87166 03171500
*                                                                       03172000
SETONS   BR    9             Go to ON handler                  @SC87166 03172500
*                                                                       03173000
SETCMDS  CSECT                                                 @SC90040 03173500
SETTRKW  KW    '&AAAATTY',SETT,T                               @SC91320 03174000
         KW    '&SERIES1',SETT,S                               @SC91320 03174500
         KW    '&GRAPHIC',SETT,G                               @SC91320 03175000
         KW    '&AAAAAEA',SETT,A                               @SC91320 03175500
         KW    '&VTAMTTY',SETT,V                               @SC91320 03176000
         KW    '&FULLSCR',SETT,F                               @SC92030 03176500
         KW    '&AAANONE',SETT,N                               @SC91320 03177000
         KW    ,                                               @SC87166 03177500
*                                                                       03178000
SETBLKKW KW    '1-BYTE',SETT,1                                 @SC92085 03178500
         KW    '2-BYTE',SETT,2                                 @SC92085 03179000
         KW    '3-BYTE',SETT,3                                 @SC92085 03179500
         KW    '&BLNKFRE',SETT,B                               @SC92085 03180000
         KW    ,                                               @SC92085 03180500
SET      CSECT                                                 @SC90040 03181000
*                                                                       03181500
SETT     MVC   0(1,8),KWCODE(1) Save value in specified field  @SC91320 03182000
         B     RTRN0                                           @SC87166 03182500
*                                                                       03183000
SETCMDS  CSECT                                                 @SC90040 03183500
PFXUNPFX KW    '&PREFIXD',SETCTL1,0                            @SC93173 03184000
         KW    '&UNPREFD',SETCTL1,1                            @SC93173 03184500
         KW    ,                                               @SC93173 03185000
*                                                                       03185500
SETSWT   KW    '&CONTINU',SETOFF                               @SC86171 03186000
         KW    '&AAAHALT',SETON                                @SC86171 03186500
         KW    ,                                               @SC86171 03187000
*                                                                       03187500
SETDSC   KW    '&DISCARD',SETOFF                               @SC86225 03188000
         KW    '&AAAKEEP',SETON                                @SC86225 03188500
         KW    ,                                               @SC86225 03189000
*                                                                       03189500
SETCLSKW KW    '&AAPPEND',SETCLSA,A                            @SC91320 03190000
         KW    '&ABACKUP',SETCLSR,B                            @SC91320 03190500
         KW    '&DISCARD',SETCLSR,D                            @SC91320 03191000
         KW    '&OVERWRI',SETCLSN,O                            @SC91320 03191500
         KW    '&ARENAME',SETCLSR,R                            @SC91320 03192000
         KW    ,                                               @SC90033 03192500
*                                                                       03193000
SETOVWKW KW    '&DEFAULT',SETOFF                               @SC90033 03193500
         KW    '&PRESERV',SETON                                @SC90033 03194000
         KW    ,                                               @SC90033 03194500
*                                                                       03195000
SETPAR   KW    '&AAAMARK',SETOFF                               @SC86316 03195500
         KW    '&AAANONE',SETON                                @SC86316 03196000
         KW    ,                                               @SC86316 03196500
SET      CSECT                                                 @SC90040 03197000
*                                                                       03197500
SETTABS  LA    4,SETCMDOO                                      @SC87166 03198000
         BAL   14,SETSCN                                       @SC87166 03198500
          B    SETTBON       Turn on                           @SC86355 03199000
         NI    FL2,255-TABS  Turn off                          @SC86355 03199500
         MVC   TABCNT,F0     Clear count                       @SC86355 03200000
         B     RTRN0                                           @SC86295 03200500
SETTBON  OI    FL2,TABS      Turn on                           @SC86355 03201000
         MVC   TABCNT,F0     Clear count                       @SC86355 03201500
         SR    0,0           Init previous tab                 @SC86355 03202000
         LA    3,TABTBL      Point to start of tab table       @TS86100 03202500
         LA    8,255         Limit on tab stops                @SC86355 03203000
         LA    5,TABCNT      End of table                      @SC86355 03203500
SETTBLP  ICM   2,15,LEN      Any more tokens?                  @SC86355 03204000
         BNP   SETTBN        No, done                          @SC86355 03204500
         STC   0,0(3)        Save previous tab                 @SC86355 03205000
         BAL   2,SETNUM      Read number                       @SC86355 03205500
         CLM   0,1,0(3)      Is this tab higher than previous? @SC86355 03206000
         BNH   SETTBSEQ      No, tab out of sequence           @TS86100 03206500
         CR    3,5           Exceeded capacity?                @SC86355 03207000
         BNL   SETTBHI       Yes                               @TS86100 03207500
         STC   0,0(3)        Save tab setting                  @TS86100 03208000
         LA    3,1(3)        Bump counter                      @SC86355 03208500
         B     SETTBLP                                         @SC86355 03209000
SETTBN   LA    0,TABTBL      Point to start of tab table       @SC86355 03209500
         SR    3,0           Get length of table               @SC86355 03210000
         STH   3,TABCNT      Save the tab count                @TS86100 03210500
         B     RTRN0                                           @SC86355 03211000
SETTBHI  PTEXT '&MANYTAB'                                      @SC86355 03211500
         B     SETTBER       Return error                      @SC86355 03212000
SETTBSEQ PTEXT '&BADTABS'                                      @TS86100 03212500
SETTBER  NI    FL2,255-TABS  Turn off                          @SC86355 03213000
         B     SUBERR        Return error                      @TS86100 03213500
*                                                                       03214000
SETLIN   BAL   2,SETFSTR     Get fixed-format string           @SC86166 03214500
         PTEXT '&BADCOMM'                                      @SC87351 03215000
         KCALL SETMSG,5,E=SUBERR Make sure it's ok             @SC87351 03215500
         B     RTRN0                                           @SC86166 03216000
*                                                                       03216500
SETPRP   LA    0,KPRPT       Ptr to new prompt string          @SC87351 03217000
         KCALL SUPFNC,11     Ok it with system                 @SC87351 03217500
         B     RTRN0                                           @SC87351 03218000
*                                                                       03218500
SETCLSA  OI    FL3,APPN      Set APPEND ON                     @SC90033 03219000
         NI    FL1,255-REN   ... and "WARN" OFF                @SC90033 03219500
         B     SETCLSZ                                         @SC90033 03220000
SETCLSR  OI    FL1,REN       Set "WARN" ON                     @SC90033 03220500
         B     SETCLSY       ... and APPEND OFF                @SC90033 03221000
SETCLSN  NI    FL1,255-REN                                     @SC90033 03221500
SETCLSY  NI    FL3,255-APPN                                    @SC90033 03222000
SETCLSZ  B     SETT          Save collision code               @SC91320 03222500
*                                                                       03223000
         KSETPRC ,           System-specific options           @SC86355 03223500
*                                                                       03224000
SETCMDS  CSECT                                                 @SC90040 03224500
*  An alternate name must follow immediately the primary.      @SC92113 03225000
*  All primary names must be the same length (with blanks).    @SC92113 03225500
*  (but names not associated in pairs can be any length).      @SC92233 03226000
SETALFKW KW    'LATIN1  ',SETALF1,MIN=6                        @SC91325 03226500
SETALFL1 KW    'L1',SETALFX,MIN=2  Alternate name              @SC90152 03227000
         KW    'ARABIC',SETALF1,MIN=2                          @SC93027 03227500
         KW    'ASCII   ',SETALF1,MIN=2                        @SC90152 03228000
         KW    '&CYRILLC',SETALF1,MIN=2                        @SC90152 03228500
         KW    '&AAGREEK',SETALF1,MIN=2                        @SC90152 03229000
         KW    '&HEBREW',SETALF1,MIN=2                         @SC90152 03229500
         KW    '&JAPNEUC',SETALF1,MIN=3                        @SC91325 03230000
         KW    'KATAKANA',SETALF1,MIN=2                        @SC90152 03230500
         KW    'LATIN2  ',SETALF1,MIN=6                        @SC90152 03231000
         KW    'L2',SETALFX,MIN=2  Alternate name              @SC90152 03231500
         KW    'LATIN3  ',SETALF1,MIN=6                        @SC90152 03232000
         KW    'L3',SETALFX,MIN=2  Alternate name              @SC90152 03232500
         KW    'THAI',SETALF1,MIN=2                            @SC92233 03233000
         KW    '&TRANSPA',SETALF1,MIN=2                        @SC90250 03233500
         KW    ,                                               @SC90040 03234000
SETFALFK KW    'EBCDIC  ',SETALF1,MIN=6                        @SC90040 03234500
         KW    'CP1047',SETALFX,MIN=6  Alternate name          @SC92113 03235000
         KW    'CP037   ',SETALF1,MIN=5                        @SC90040 03235500
         KW    'CP273   ',SETALF1,MIN=5                        @SC90040 03236000
         KW    'CP275   ',SETALF1,MIN=5                        @SC90040 03236500
         KW    'CP277   ',SETALF1,MIN=5                        @SC90040 03237000
         KW    'CP278   ',SETALF1,MIN=5                        @SC90040 03237500
         KW    'CP280   ',SETALF1,MIN=5                        @SC90040 03238000
         KW    'CP281',SETALF1,MIN=5                           @SC91325 03238500
         KW    'CP282   ',SETALF1,MIN=5                        @SC90040 03239000
         KW    'CP284   ',SETALF1,MIN=5                        @SC90040 03239500
         KW    'CP285   ',SETALF1,MIN=5                        @SC90040 03240000
         KW    'CP297   ',SETALF1,MIN=5                        @SC90040 03240500
         KW    'CP290   ',SETALF1,MIN=5                        @SC90040 03241000
         KW    'CP420',SETALF1,MIN=5                           @SC93027 03241500
         KW    'CP424   ',SETALF1,MIN=5                        @SC90040 03242000
         KW    'CP500   ',SETALF1,MIN=5                        @SC90040 03242500
         KW    'CP838',SETALF1,MIN=5                           @SC92233 03243000
         KW    'CP870   ',SETALF1,MIN=5                        @SC90152 03243500
         KW    'CP871   ',SETALF1,MIN=5                        @SC90040 03244000
         KW    'CP875   ',SETALF1,MIN=5                        @SC90040 03244500
         KW    'CP880   ',SETALF1,MIN=5                        @SC90152 03245000
         KW    'CP905   ',SETALF1,MIN=5                        @SC90152 03245500
         KW    '&CZECH',SETALF1,MIN=2                          @SC90152 03246000
         KW    'DKOI    ',SETALF1,MIN=4                        @SC90040 03246500
         KW    'H-EBCDIK-DASH',SETALF1,MIN=3                   @SC91325 03247000
         KW    'KANJI',SETKANJ,MIN=3                           @SC91325 03247500
KANJIF   KW    'FUJITSU-KANJI',SETALF1,MIN=3                   @SC91325 03248000
KANJIH   KW    'HITACHI-KANJI',SETALF1,MIN=3                   @SC91325 03248500
KANJII   KW    'IBM-KANJI',SETALF1,MIN=3                       @SC91325 03249000
         KW    ,                                               @SC90040 03249500
*                                                                       03250000
SETFKW   KW    '&AALRECL',SHOLR           **COMPAT**           @SC87166 03250500
         KW    '&LONGLIN',SHOLNG,MIN=2    **COMPAT**           @SC88120 03251000
         KW    '&COLLISN',SHOCLSN,MIN=2   **COMPAT**           @SC90033 03251500
         KW    '&OVERWRI',SHOOVWR         **COMPAT**           @SC90033 03252000
         AIF   ('&ATTTYPE'(1,1) NE '&AAATEXT'(1,1)).CMPAT01    @SC92300 03252500
         KW    'T',SETFT,T                 **COMPAT**          @SC91320 03253000
.CMPAT01 ANOP                                                  @SC92300 03253500
         KW    '&ATTTYPE',SHOFILT         **COMPAT**           @SC87166 03254000
        KFILKW ,                           **COMPAT**          @SC87166 03254500
         KW    '&CHARSET',SHOFALF,MIN=2                        @SC90040 03255000
SETFIL   KW    '&AAATEXT',SETFILET,T                           @SC91320 03255500
         KW    '&AAAABIN',SETFILEB,B                           @SC91320 03256000
SETDBIN  KW    '&AAADBIN',SETFILEB,D                           @SC91320 03256500
         KW    '&AAAVBIN',SETFILEB,V                           @SC91320 03257000
         KW                                                             03257500
SET      CSECT                                                 @SC90040 03258000
*                                                                       03258500
SETKANJ  L     1,=A(KANJI&KNJLAB) Use default                  @SC91325 03259000
         B     SETALF1                                         @SC91325 03259500
SETALFX  SH    1,=Y(SETALFL1-SETALFKW) Convert to proper entry @SC90152 03260000
SETALF1  MVC   0(LALF,8),=CL(LALF)' '  Fill with blanks        @SC91325 03260500
         IC    14,KWLEN(,1)  Get length-1 of keyword           @SC91325 03261000
         CLM   14,1,SETALF1+1 See if too long for field        @SC91325 03261500
         BNH   *+8           Ok                                @SC91325 03262000
          IC   14,SETALF1+1  Too long, use field length        @SC91325 03262500
         EX    14,SETALFMV   Copy keyword to field             @SC91325 03263000
         LR    0,8           Pass ptr to the changed code      @SC90040 03263500
         KCALL TBLSET,ATOE   Set up translations               @SC90040 03264000
         B     RTRN                                            @SC90040 03264500
SETALFMV MVC   0(,8),KWNAME(1)                                 @SC91325 03265000
*                                                                       03265500
SETFILEB OI    FL1,BINF              Set binary on                      03266000
         B     SETT                                            @SC91320 03266500
*                                                                       03267000
SETFILET NI    FL1,255-BINF          Set it OFF                         03267500
         B     SETT                                            @SC91320 03268000
*                                                                       03268500
SETCMDS  CSECT                                                 @SC90040 03269000
SETLNGKW KW    '&AAAFOLD',SETT,F                               @SC91320 03269500
         KW    '&AAAHALT',SETT,H                               @SC91320 03270000
         KW    '&TRUNCAT',SETT,T                               @SC91320 03270500
         KW    ,                                               @SC88120 03271000
SET      CSECT                                                 @SC90040 03271500
*                                                                       03272000
         KFILSET ,                                             @SC87012 03272500
*                                                                       03273000
SETDEB   BAL   4,SETSCN      Select among possibilities        @SC88168 03273500
         KW    '&AAAAAON',SETDON                               @SC88168 03274000
         KW    '&AAAAOFF',SETDEND,MIN=2                        @SC88168 03274500
SETRAW   KW    '&AAAARAW',SETDRAW                              @SC88168 03275000
         KW    '&AAAAAIO',SETDIO                               @SC88168 03275500
         KW    '&AAALONG',SETDLO                               @SC90222 03276000
         KW    '&AAASAVE',SETDSV                               @SC88168 03276500
         KW    '&AAATIME',SETDTM                               @SC91172 03277000
         KW    ,                                               @SC88168 03277500
SETDEBOF NI    FL1,255-DEBUG         Set it OFF                         03278000
         CLOSF LOGPTR        Done logging                      @SC86135 03278500
         B     RTRN0                                           @SC86295 03279000
*                                                                       03279500
SETDRAW  OI    SHODBG,DBGON+DBGRW   RAW -> ON                  @SC88168 03280000
         B     SETDB1                                          @SC88168 03280500
SETDIO   OI    SHODBG,DBGON+DBGIO   I/O -> ON                  @SC88168 03281000
         B     SETDB1                                          @SC88168 03281500
SETDLO   OI    SHODBG,DBGON+DBGLO+DBGIO LONG-> ON + I/O        @SC90332 03282000
         B     SETDB1                                          @SC90222 03282500
SETDSV   OI    SHODBG,DBGON+DBGSV   SAVE-> ON                  @SC88168 03283000
         B     SETDB1                                          @SC88168 03283500
SETDTM   OI    SHODBG,DBGON+DBGTI   TIME-> ON                  @SC91172 03284000
         B     SETDB1                                          @SC91172 03284500
SETDON   OI    SHODBG,DBGON                                    @SC88168 03285000
SETDB1   ICM   2,15,LEN      Any more options?                 @SC88168 03285500
         BP    SETDEB        Yes, interpret them               @SC88168 03286000
SETDEND  XC    SHODBG,DBGFLG Get changed flags in SHODBG       @SC88168 03286500
         XC    DBGFLG,SHODBG Install new flags                 @SC88168 03287000
         TM    SHODBG,DBGON  ON/OFF changed?                   @SC88168 03287500
         BZ    RTRN0         No, done                          @SC88168 03288000
         TM    DBGFLG,DBGON  Turned ON?                        @SC88168 03288500
         BZ    SETDEBOF      No, turn it off                   @SC88168 03289000
         NI    LOGFLGS,255-APPN                                @SC86295 03289500
         LA    0,L'LOGNAM    Name string length                @SC86295 03290000
         LA    1,LOGNAM      and address                       @SC86295 03290500
         STM   0,1,SCANPTR                                     @SC86295 03291000
         LA    0,FFRCF                                         @SC86295 03291500
         KCALL FSPEC,IFILE   Convert to filespec               @SC86295 03292000
         PTEXT '&DEBGERR'                                      @SC87012 03292500
         OPENF O,IFILE,LOGFDB,LOGPTR,E=SUBERR                  @SC87012 03293000
         OI    FL1,DEBUG     Enable logging                    @SC87012 03293500
         MVI   ERRNUM,ERRNOE Insist no errors                  @SC88168 03294000
         B     RTRN0                                           @SC86295 03294500
*                                                                       03295000
SET8B    NTOKN N=SET8BH,H=SET8BH                               @SC87008 03295500
         LA    4,AAMP        Default value                     @SC87008 03296000
         LA    9,SET8BS                                        @SC87008 03296500
         SCAN  SETONKW,RTRN2                                            03297000
         SR    4,4           Zero value means OFF              @SC87008 03297500
         LTR   7,7           Length=1?                         @SC87008 03298000
         BNZ   SET8BS        No, can't be ON                   @SC87008 03298500
         BAL   2,SETQCH2     Make sure it's valid              @SC87008 03299000
SET8BS   STC   4,EBQC        New value                         @SC87008 03299500
         B     RTRN0                                           @SC87008 03300000
SET8BH   PTEXT '&ONOFFCH'                                      @SC87008 03300500
         B     SUBERR                                          @SC87008 03301000
*                                                                       03301500
SETSTR   LR    2,14                                            @SC87268 03302000
         MVI   0(8),0        Default to blank                  @SC87166 03302500
         BAL   9,WSP         Remaining data length             @SC86224 03303000
          B    RTRN0         Null string                       @SC86295 03303500
         LR    1,4           Max length allowed                @SC87268 03304000
         CR    6,1                                             @SC86345 03304500
         BH    SETSTRH       Too long                          @SC86345 03305000
         STC   6,0(8)        Save length                       @SC87166 03305500
         LA    8,1(8)        Skip over length byte             @SC87268 03306000
         XR    6,7           Exchange ptr and length           @SC87268 03306500
         XR    7,6                                             @SC87268 03307000
         XR    6,7                                             @SC87268 03307500
         B     SETFST1       Go copy string                    @SC87268 03308000
*                                                                       03308500
SETRCTLQ BAL   2,SETQCHR             Get a char for Receive-Ctl-quote   03309000
         STC   4,RCTLQ(5)    Set receive ctl quote             @SC86164 03309500
         LTR   5,5           Done if SEND                      @SC86223 03310000
         BNZ   RTRN0                                           @SC86295 03310500
         STC   4,DEFPARM+5   Set default for SPAR              @SC86120 03311000
         B     RTRN0                                           @SC86295 03311500
*                                                                       03312000
SETQCHR  NTOKN H=SETQCHRH,N=SETQCHRH                                    03312500
         LTR   7,7                   Token length - 1                   03313000
         BP    SETQCHRH              Pos: token is too long             03313500
SETQCH2  SR    4,4                                             @SC87008 03314000
         IC    4,0(6)        Get the quote char                @SC86120 03314500
         IC    4,ETOAD(4)    Get ASCII form                    @SC89301 03315000
         NOTQR SETQCHRH      Go if not 33-62 or 96-126         @SC86120 03315500
         BR    2                                                        03316000
*                                                                       03316500
SETQCHRH PTEXT '&ASCQUOT'                                      @SC86224 03317000
         B     SUBERR                                          @SC86295 03317500
*                                                                       03318000
SETLR    ST    0,MAXOUT      Max output buffer size            @SC87166 03318500
         B     RTRN0                                           @SC86295 03319000
*                                                                       03319500
SETTIMO  BCT   5,RTRN0       Done if rec                       @SC87166 03320000
         TOCHR 0,,DEFPARM+1  Set default for SPAR              @SC86164 03320500
         B     RTRN0                                           @SC86295 03321000
*                                                                       03321500
SETPADN  BCT   5,RTRN0       Done if rec                       @SC87166 03322000
         TOCHR 0,,DEFPARM+2  Set default for SPAR              @SC86164 03322500
         B     RTRN0                                           @SC86295 03323000
*                                                                       03323500
SETPADC  BCT   5,RTRN0       Done if rec                       @SC87166 03324000
         CTL   0,,DEFPARM+3  Set default for SPAR              @SC86164 03324500
         B     RTRN0                                           @SC86295 03325000
*                                                                       03325500
SETEOL   BCT   5,RTRN0       Done if rec                       @SC87166 03326000
         STC   0,S1EOL       Extra copy for prompting          @SC87274 03326500
         TOCHR 0,,DEFPARM+4          Set default for SPAR               03327000
         B     RTRN0                                           @SC86295 03327500
*                                                                       03328000
SETSIZ   C     0,AKMIN       Less than min Kermit size?        @SC87166 03328500
         BL    SETKSIZH      Yes, error                        @SC86164 03329000
         C     0,AKMAX       More than max Kermit size?        @SC86164 03329500
         BNH   SETRPS1       No, skip message call             @TB86196 03330000
         LTR   5,5           SEND?                             @SC86224 03330500
         BNZ   SETKSIZH      Yes, can't set it long            @SC86224 03331000
         L     0,AKMAX       Use max Kermit size for default   @SC90122 03331500
SETRPS1  DS    0H                                              @TB86196 03332000
         BCT   5,RTRN0       Done if recv                      @SC86295 03332500
         TOCHR 0,,DEFPARM+0          Set default for SPAR               03333000
         B     RTRN0                                           @SC86295 03333500
*                                                                       03334000
SETKSIZH PTEXT '&SENDPAK'                                      @SC90122 03334500
         B     SUBERR                                          @SC86295 03335000
*                                                                       03335500
SETCTL   LA    4,PFXUNPFX    Select among possibilities        @SC93173 03336000
         B     SETSCN                                          @SC93173 03336500
SETCTL1  IC    3,KWCODE(1)   Get code (0=>must prefix, 1=>not) @SC93173 03337000
         N     3,F1                                            @SC93173 03337500
         ICM   0,15,LEN      Any more tokens?                  @SC93173 03338000
         BP    SETCTL2       Yes, must be numeric              @SC93173 03338500
         STC   3,CTLTAB      No, just do whole table           @SC93173 03339000
         MVC   CTLTAB+1(159),CTLTAB                            @SC93173 03339500
         B     RTRN0                                           @SC93173 03340000
SETCTL2  LA    8,159         Limit for control list            @SC93173 03340500
         BAL   2,SETNUM      Get a number for table offset     @SC93173 03341000
         LA    7,CTLTAB                                        @SC93173 03341500
         AR    7,0           Ptr to proper table entry         @SC93173 03342000
         STC   3,0(,7)                                         @SC93173 03342500
         B     RTRN0         All done                          @SC93173 03343000
*                                                                       03343500
SETETOA  LA    3,ETOA        Address of table to change        @SC86265 03344000
         NI    ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03344500
         B     SETTET2                                         @SC87117 03345000
SETTET   LA    3,TETOA       Address of table to change        @SC87117 03345500
SETTET2  LA    2,ETOAD       Address of original               @SC87117 03346000
SETTR0   ICM   0,15,LEN      Any more tokens?                  @SC87117 03346500
         BP    SETTR1        Yes, must be numeric              @SC87117 03347000
         MVC   0(256,3),0(2) No, just reset table              @SC87117 03347500
         B     RTRN0                                           @SC87117 03348000
SETTR1   LA    8,255         Limit for each                    @SC87117 03348500
         BAL   2,SETNUM      Get a number for table offset     @SC86295 03349000
         AR    3,0           Save table offset here            @SC86295 03349500
         BAL   2,SETNUM      Get a number for value            @SC86295 03350000
         STC   0,0(3)        Change value                      @SC86295 03350500
         B     RTRN0         All done                          @SC86295 03351000
*                                                                       03351500
SETATOE  LA    3,ATOE        Adr of table to edit              @SC86265 03352000
         NI    ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03352500
         B     SETTAT2                                         @SC87117 03353000
SETTAT   LA    3,TATOE       Address of table to change        @SC87117 03353500
SETTAT2  LA    2,ATOED       Address of original               @SC87117 03354000
         B     SETTR0                Use common routine                 03354500
*                                                                       03355000
SETTTB   LA    4,SETTTKW     List of choices: ON, OFF, KP      @SC90278 03355500
         BAL   14,SHOXY      ON or OFF just handles flag       @SC90278 03356000
SETTTKP   OI   FL4,TTAB      KP comes here and changes table   @SC90278 03356500
         L     1,=A(ATOEKP)  Replacement table (invertible)    @SC90278 03357000
         MVC   TATOE,0(1)                                      @SC90278 03357500
         SR    2,2                                             @SC90278 03358000
         LA    1,255         Now invert into other table       @SC90278 03358500
         IC    2,TATOE(1)                                      @SC90278 03359000
         STC   1,TETOA(2)                                      @SC90278 03359500
         BCT   1,*-8                                           @SC90278 03360000
         MVI   TETOA,0       Null is always null!              @SC90278 03360500
SETTTN   LA    1,TATOE       Use "T" tables                    @SC92352 03361000
         LA    2,TETOA                                         @SC92352 03361500
         STM   1,2,AEPTRS                                      @SC92352 03362000
         B     SETON                                           @SC92352 03362500
*                                                                       03363000
*                                                                       03363500
* R6 points to token, R7 has length-1.  Convert to binary in R0.        03364000
* Return via R2                                                         03364500
SETNUM2  LR    2,14          Save return                       @SC87166 03365000
SETNUM   NTOKN H=SETNUMH,N=SETNUMH                             @SC86295 03365500
         LA    7,1(7)        Length                            @SC86316 03366000
         BAL   14,GETNUM                                       @SC86316 03366500
          B    SETNUMH                                         @SC86316 03367000
         CLR   0,8           Within limit?                     @SC86295 03367500
         BH    SETNUMH       Too big                           @SC87166 03368000
         CLI   0(2),X'47'    Entered at SETNUM2?               @SC87166 03368500
         BNER  2             No, return immediately            @SC87166 03369000
         LR    14,2          Ptr to caller                     @SC87166 03369500
         S     14,F8         Back up to the LOAD instr         @SC87166 03370000
         MVC   SETXI,0(14)   Copy and modify op instr          @SC87166 03370500
         NC    SETXI(2),=X'F60F'                               @SC87166 03371000
         CLI   SETXI,X'B6'   Was is ICM?                       @SC87166 03371500
         BNE   *+8           No, ok                            @SC87166 03372000
         MVI   SETXI,X'BE'   Yes, make into STCM               @SC87166 03372500
         EX    0,SETXI       Store value                       @SC87166 03373000
         BR    2             Return                            @SC87166 03373500
*                                                                       03374000
SETNUMH  LA    15,CMD+&LOPRNUM                                 @SC86295 03374500
SETMAXH  MVC   CMD(&LOPRMUS),=C'&OPRMUB&OPRMUL'                @SC86295 03375000
         MVI   0(15),C'<'                                      @SC86295 03375500
         LA    15,1(15)                                        @SC86295 03376000
         LR    4,8                                             @SC86345 03376500
         A     4,F1                                            @SC86345 03377000
         BAL   2,EDDEC       Put limit into message            @SC86295 03377500
         LR    4,15          End                               @SC86295 03378000
         LA    3,CMD                                           @SC86295 03378500
         SR    4,3                                             @SC86295 03379000
         B     SUBERR                                          @SC86295 03379500
*                                                                       03380000
SETFSTR  LR    1,9           Save length                       @SC87166 03380500
         NTOKN N=SETFST0,H=SETSTRH                             @SC87166 03381000
         LA    7,1(7)                                          @SC86295 03381500
         CR    7,1           Name too long?                    @SC86295 03382000
         BNH   SETFST1       No, do it                         @SC86295 03382500
SETSTRH  LR    8,1           Copy max length                   @SC86295 03383000
         LA    15,CMD+&LOPRMUS Base message size               @SC86295 03383500
         B     SETMAXH                                         @SC86295 03384000
SETFST0  SR    7,7           Empty string                      @SC86295 03384500
SETFST1  ICM   7,8,BLANK     Set for blank fill                @SC86295 03385000
         LR    9,1                                             @SC87166 03385500
         MVCL  8,6           Copy name                         @SC87166 03386000
         BR    2                                               @SC86295 03386500
         TITLE 'SHOW Routine - performs SHOW command options'           03387000
* Display current values in STORAG.                                     03387500
* Entry: SCANPTR string has option                                      03388000
* Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name          03388500
*       ERRNUM unchanged                                                03389000
SHOW     ENTER ALT                                             @SC86133 03389500
         LA    0,CMD                                           @SC86227 03390000
         ST    0,SHOPTR      Initialize output ptr             @SC86227 03390500
         MVI   SETXI,X'91'   TM instruction                    @SC87166 03391000
         L     3,=A(SETCMDS) Addressibility                    @SC90040 03391500
         NTOKN N=SHOALL                                        @SC86133 03392000
         SCAN  SHOCMDAL,RTRN1                                  @SC88293 03392500
SHOBAD   B     RTRN2         Invalid operand                   @SC86295 03393000
*                                                                       03393500
SETCMDS  CSECT                                                 @SC90040 03394000
SETCMDKW DS    0H                                              @SC87166 03394500
         KW    '&AAAATOE',SETATOE,MIN=4                        @SC87166 03395000
         KW    '&CTRLCHR',SETCTL,MIN=8                         @SC93173 03395500
         KW    '&AAAETOA',SETETOA,MIN=4                        @SC87166 03396000
         KW    '&FILTYPE',SHOFILT,MIN=5                        @SC87166 03396500
         KW    '&AATATOE',SETTAT,MIN=5                         @SC87166 03397000
         KW    '&AATETOA',SETTET,MIN=5                         @SC87166 03397500
         KW    GOTO,SHOCMDS  Skip over 'ALL'                   @SC88293 03398000
*                                                                       03398500
SHOATKW  KW    '&ATTLENG',SHOATLN                              @SC90037 03399000
         KW    '&ATTTYPE',SHOATTP                              @SC90037 03399500
         KW    '&ATTDATE',SHOATDT,MIN=2                        @SC90037 03400000
         KW    '&ATTCRET',SHOATCR,MIN=2                        @SC90037 03400500
         KW    '&ATTACCT',SHOATACT,MIN=4                       @SC90037 03401000
         KW    '&ATTAREA',SHOATAR,MIN=2                        @SC90037 03401500
         KW    '&ATTPASS',SHOATPW,MIN=2                        @SC90037 03402000
         KW    '&ATTBLKS',SHOATBLK                             @SC90037 03402500
         KW    '&ATTACSS',SHOATACC,MIN=3                       @SC90037 03403000
         KW    '&ATTENCD',SHOATENC                             @SC90037 03403500
         KW    '&ATTDISP',SHOATDSP,MIN=2                       @SC90037 03404000
         KW    '&ATTPROT',SHOATPRO,MIN=2                       @SC90037 03404500
         KW    '&ATTORIG',SHOATORG                             @SC90037 03405000
         KW    '&ATTFRMT',SHOATFMT                             @SC90037 03405500
         KW    '&ATTSINF',SHOATSFO,MIN=2                       @SC90037 03406000
         KW    '&ATTBLEN',SHOATXLN,MIN=2                       @SC90037 03406500
         KW    '&AAAAEND',SHOATEND,MIN=3                       @SC91109 03407000
         KW    ,                                               @SC90037 03407500
*                                                                       03408000
SHOCMDAL KW    '&AAAAALL',SHOALL,MIN=3                         @SC88293 03408500
SHOCMDS  EQU   *                                               @SC90037 03409000
SHOATCM  KW    '&ATTRIBU',SHOATT,MIN=3                         @SC90037 03409500
*                                                                       03410000
         KW    '&AARECFM',SHORFM,MIN=4                         @SC87012 03410500
         KW    '&AALRECL',SHOLR                                @SC86133 03411000
         KW    '&WARNING',SHOWARN       ***COMPAT***           @SC90033 03411500
         KW    '&AAPPEND',SHOAPP,MIN=3  ***COMPAT***           @SC90033 03412000
         KW    '&AAABAUD',SHOBAUD,MIN=2 ***COMPAT***           @SC90099 03412500
SHOCMDKW EQU   *             Must match order of code                   03413000
         KW    '&TABSEXP',SHOTABS                              @SC86133 03413500
         KW    '&AAAAEOF',SHOEOF,MIN=3                         @SC86133 03414000
         KW    '&AADEBUG',SHODEB                               @SC86133 03414500
         KW    '&BLKCHCK',SHOBLK                               @SC86133 03415000
         KW    '&A8THBQU',SHO8B                                @SC87008 03415500
         KW    '&APROMPT',SHOPRP,MIN=2                         @SC87268 03416000
         KW    '&AAALINE',SHOLIN,MIN=3                         @SC87166 03416500
         KW    '&CONTRLR',SHOTRM,MIN=3                         @SC87268 03417000
         KW    '&HANDSHK',SHOHND                               @SC87274 03417500
         KW    '&AASPEED',SHOBAUD,MIN=2                        @SC90099 03418000
         KW    '&ASYSCMD',SHOSYS,MIN=2                         @SC86295 03418500
         KW    '&TTTABLE',SHOTTB,MIN=2                         @SC87117 03419000
         KW    '&AADELAY',SHODLY,MIN=3                         @SC86164 03419500
         KW    '&INCOMPL',SHOINC,MIN=3                         @SC86225 03420000
         KW    '&AAATEST',SHOTST,MIN=4                         @SC87166 03420500
         KW    '&SRVTIME',SHOSERV,MIN=3                        @SC90045 03421000
        KSETKW ,             Specific parameters               @SC87166 03421500
         KW    '&TRANSFR',SHOTRN,MIN=2                         @SC90040 03422000
         KW    '&AAAFILE',SHOFIL                               @SC86295 03422500
         KW    '&AMARGIN',SHOMRG                               @SC87253 03423000
         KW    '&FOREIGN',SHOFOR,MIN=3                         @HF86223 03423500
         KW    '&AARETRY',SHORETR,MIN=3                        @SC86345 03424000
         KW    '&AAATAKE',SHOTAK,MIN=3                         @SC86171 03424500
         KW    '&RECEIVE',SHORECV,MIN=3                        @SC86133 03425000
         KW    '&AAASEND',SHOSEND,MIN=3                        @SC86224 03425500
         KW    ,                                               @SC86133 03426000
SET      CSECT                                                 @SC90040 03426500
*                                                                       03427000
SHOATT   MVC   SHOTMP(8),SCANPTR   Save string ptrs            @SC90037 03427500
         LA    0,3           Max interesting count             @SC90037 03428000
SHOATL1  NTOKN N=SHOATL2     Count tokens after ATTRIB         @SC90037 03428500
         BCT   0,SHOATL1                            R0=3 => 0  @SC90037 03429000
SHOATL2  MVC   SCANPTR(8),SHOTMP  Restore              2 => 1  @SC90037 03429500
         CLI   SETXI,X'97'   SET?                      1 => 2  @SC90037 03430000
         BE    *+6           Yes, 2 more means "item"  0 => >2 @SC90037 03430500
          BCTR 0,0           No, 1 more means "item"           @SC90037 03431000
         BCT   0,SHOATS      Go if not "item"                  @SC90037 03431500
         LA    4,SHOATKW     List of possible items            @SC90037 03432000
         B     SHOGRP        Do the right one                  @SC90037 03432500
SHOATS   OI    SFLG,ALLF+ASRF  Set to display both levels..    @SC90037 03433000
         BAL   14,SHOOO      Just SET ATT or SHO ATT           @SC90037 03433500
          OI   SCAPA,8                                         @SC90037 03434000
         LA    1,SHOATCM     Point at keywork again (SHO ATT)  @SC90037 03434500
         LA    4,SHOATKW     Do whole list                     @SC90037 03435000
         B     SHOGRP                                          @SC90037 03435500
SHOATLN  BAL   14,SHOOO      Length                            @SC90037 03436000
          OI   ATFLG,ATFLNG                                    @SC90037 03436500
SHOATTP  BAL   14,SHOOO      Type                              @SC90037 03437000
          OI   ATFLG,ATFTYP                                    @SC90037 03437500
SHOATDT  BAL   14,SHOOO      Date                              @SC90037 03438000
          OI   ATFLG,ATFDAT                                    @SC90037 03438500
SHOATCR  BAL   14,SHOOO      Creator                           @SC90037 03439000
          OI   ATFLG,ATFCRE                                    @SC90037 03439500
SHOATACT BAL   14,SHOOO      Account                           @SC90037 03440000
          OI   ATFLG,ATFACT                                    @SC90037 03440500
SHOATAR  BAL   14,SHOOO      Area                              @SC90037 03441000
          OI   ATFLG,ATFARE                                    @SC90037 03441500
SHOATPW  BAL   14,SHOOO      Password                          @SC90037 03442000
          OI   ATFLG,ATFPWD                                    @SC90037 03442500
SHOATBLK BAL   14,SHOOO      Blocksize                         @SC90037 03443000
          OI   ATFLG,ATFBLK                                    @SC90037 03443500
SHOATACC BAL   14,SHOOO      Access                            @SC90037 03444000
          OI   ATFL2,ATFACC                                    @SC90037 03444500
SHOATENC BAL   14,SHOOO      Encoding                          @SC90037 03445000
          OI   ATFL2,ATFENC                                    @SC90037 03445500
SHOATDSP BAL   14,SHOOO      Disposition                       @SC90037 03446000
          OI   ATFL2,ATFDSP                                    @SC90037 03446500
SHOATPRO BAL   14,SHOOO      Protection                        @SC90037 03447000
          OI   ATFL2,ATFPRO                                    @SC90037 03447500
SHOATORG BAL   14,SHOOO      Origin                            @SC90037 03448000
          OI   ATFL2,ATFORG                                    @SC90037 03448500
SHOATFMT BAL   14,SHOOO      Format                            @SC90037 03449000
          OI   ATFL2,ATFFMT                                    @SC90037 03449500
SHOATSFO BAL   14,SHOOO      System info                       @SC90037 03450000
          OI   ATFL2,ATFSFO                                    @SC90037 03450500
SHOATXLN BAL   14,SHOOO      Byte count                        @SC90037 03451000
          OI   ATFL3,ATFXLN                                    @SC90037 03451500
SHOATEND BAL   14,SHOOO      End                               @SC91109 03452000
          OI   ATFL4,ATFEND                                    @SC91109 03452500
         B     SHOGRPZ                                         @SC90037 03453000
*                                                                       03453500
SHOALL   OI    SFLG,ALLF     Do all                            @SC86295 03454000
         SR    0,0           Clear screen (if fullscreen)      @SC90045 03454500
         KCALL SCRNIO                                          @SC90045 03455000
         LA    1,SHOCMDKW    Start at beginning                @SC86133 03455500
*                                                                       03456000
*          Each routine begins with R1-> keyword item          @SC86133 03456500
SHOTABS  CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03457000
         BE    SETTABS                                         @SC87166 03457500
         BAL   14,SHOOO      On or off                         @SC86133 03458000
          OI   FL2,TABS                                        @SC87166 03458500
SHOTABSZ LH    5,TABCNT      Count of tabs                     @SC86355 03459000
         LA    3,TABTBL      Ptr to table of tabs              @SC86355 03459500
         BAL   14,SHOLIST    Display list of tab stops, if any @SC86355 03460000
          NOP  0                                               @SC87166 03460500
SHOEOF   BAL   14,SHOOO      On or off                         @SC86133 03461000
          OI   FL2,EOFZ                                        @SC87166 03461500
SHODEB   CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03462000
         BE    SETDEB                                          @SC87166 03462500
         BAL   14,SHOOO      1st get ON vs. OFF                @SC88168 03463000
          OI   FL1,DEBUG                                       @SC88168 03463500
SHODEBZ  MVC   SHODBG,DBGFLG Copy flags for decoding           @SC88168 03464000
         LA    6,SETRAW      List of options                   @SC88168 03464500
         BAL   4,SHOMULT     See if any extra flags on         @SC88168 03465000
          NOP  0                                               @SC88168 03465500
SHOBLK   LA    4,SETBLKKW                                      @SC92085 03466000
         LA    6,BCTC        Get block check type              @SC92085 03466500
         BAL   14,SHOBRV     Print it                          @SC92085 03467000
          NOP  0             OK                                @SC92085 03467500
SHO8B    LA    8,EBQC                                          @SC87008 03468000
         BAL   14,SHOCHRA    Display ASCII char                @SC87008 03468500
          B    SET8B                                           @SC87166 03469000
SHOPRP   LA    8,KPRPL       Ptr to prompt                     @SC87268 03469500
         LA    4,20          Max length                        @SC87268 03470000
         BAL   14,SHOSTR                                       @SC87268 03470500
          B    SETPRP        Do any system-dependent setup     @SC87351 03471000
SHOLIN   LA    8,TRMLIN                                        @SC87166 03471500
         LA    9,L'TRMLIN                                      @SC87166 03472000
         BAL   14,SHOCHRN                                      @SC87166 03472500
          B    SETLIN                                          @SC87166 03473000
SHOTRM   LA    4,SETTRKW                                       @SC87166 03473500
         LA    6,TRMTP                                         @SC87166 03474000
         BAL   14,SHOBRV     Get full name from abbrev.        @SC87166 03474500
          NOP  0                                               @SC87166 03475000
SHOHND   SR    4,4                                             @SC87274 03475500
         IC    4,S1HND                                         @SC87274 03476000
         BAL   14,SHOCTL     Print it                          @SC87274 03476500
          B    RTRN0                                           @SC87274 03477000
SHOBAUD  L     4,BAUD                                          @SC86164 03477500
         BAL   14,SHONBIG    Print it                          @SC86164 03478000
          B    RTRN0                                           @SC87166 03478500
SHOSYS   BAL   14,SHOOO      On or off                         @SC86295 03479000
          OI   FL2,PASS                                        @SC87166 03479500
SHOTTB   CLI   SETXI,X'97'                                     @SC90278 03480000
         BE    SETTTB        Do SET subcommand separately      @SC90278 03480500
         BAL   14,SHOOO      On or off                         @SC90278 03481000
          OI   FL4,TTAB                                        @SC87166 03481500
SHODLY   L     4,LCLDLY                                        @SC86164 03482000
         BAL   14,SHONBIG    Print it                          @SC86164 03482500
          B    RTRN0                                           @SC87166 03483000
SHOINC   LA    4,SETDSC      List of possibles                 @SC87166 03483500
         BAL   14,SHOXY                                        @SC86225 03484000
          OI   FL1,KEEP                                        @SC90037 03484500
SHOTST   BAL   14,SHOOO                                        @SC87166 03485000
          OI   FL1,TSTF      Turn on                           @SC87166 03485500
SHOSERV  SR    4,4                                             @SC90045 03486000
         IC    4,TIMOSRV     Server timeout (also switch)      @SC90045 03486500
         BAL   14,SHONBIG                                      @SC90045 03487000
          B    RTRN0         Index for server                  @SC90045 03487500
*                                                                       03488000
         KSHOPRC ,           System-specific options           @SC86355 03488500
*                                                                       03489000
SHOTRN   LA    4,SHOTRNKW    Ptr to sublist                    @SC90040 03489500
         BAL   14,SHOGRP                                       @SC90040 03490000
SHOFIL   LA    4,SHOFILKW    Ptr to sublist                    @SC87166 03490500
         CLI   SETXI,X'97'   SET or SHOW   **COMPAT**          @SC87166 03491000
         BNE   *+8           SHOW          **COMPAT**          @SC87166 03491500
         LA    4,SETFKW      SET           **COMPAT**          @SC87166 03492000
         LA    8,TYPFIL      In case just 'SET F T'            @SC91320 03492500
         BAL   14,SHOGRP                                       @SC86295 03493000
SHOMRG   LA    4,SHOMRGKW    Ptr to sublist                    @SC87253 03493500
         BAL   14,SHOGRP                                       @SC87253 03494000
SHOFOR   LA    4,SHOFORKW    Ptr to sublist                    @SC87166 03494500
         BAL   14,SHOGRP                                       @SC86224 03495000
SHORETR  LA    4,SHORETKW    Ptr to sublist                    @SC87166 03495500
         BAL   14,SHOGRP                                       @SC86345 03496000
SHOTAK   LA    4,SHOTAKKW    Ptr to sublist                    @SC87166 03496500
         BAL   14,SHOGRP                                       @SC86224 03497000
SHORECV  SR    5,5           Index for recv                    @SC86224 03497500
         BAL   14,SHOGRPR                                      @SC86224 03498000
SHOSEND  LA    5,1           Index for send                    @SC86224 03498500
         LA    14,SHOZZW                                       @SC87166 03499000
SHOGRPR  LA    4,SHORECKW    Ptr to common sublist             @SC87166 03499500
SHOGRP   LR    2,14          Save return adr                   @SC87166 03500000
         STM   1,4,SHOTMP    Save top level ptr, return adr    @SC87166 03500500
         TM    SFLG,ALLF     Doing all?                        @SC86295 03501000
         BO    SHORAL2       Yes                               @SC86133 03501500
SETSCN   LR    2,14          Copy return adr (again)           @SC87166 03502000
         NTOKN N=SHORALL                                       @SC86133 03502500
         LR    9,2           ???                               @SC87166 03503000
         SCAN  (4),RTRN1                                       @SC87166 03503500
SHOHLP   HELP  (4),RTRN1                                       @SC87166 03504000
*                                                                       03504500
SETCMDS  CSECT                                                 @SC90040 03505000
SHOTRNKW KW    '&LOCKSHF',SHOLCK                               @SC91275 03505500
         KW    '&CHARSET',SHOALF                               @SC91275 03506000
         KW    ,                                               @SC90040 03506500
*                                                                       03507000
SHOFILKW KW    '&ATTTYPE',SHOFILT                              @SC86295 03507500
         KW    '&LONGLIN',SHOLNG,MIN=2                         @SC88120 03508000
         KW    '&COLLISN',SHOCLSN,MIN=2                        @SC90033 03508500
         KW    '&OVERWRI',SHOOVWR                              @SC90033 03509000
         KW    '&AALRECL',SHOLR                                @SC86133 03509500
        KFILKW                                                 @SC87166 03510000
         KW    '&CHARSET',SHOFALF                              @SC90040 03510500
         KW    ,                                               @SC87012 03511000
*                                                                       03511500
SHOMRGKW KW    '&AAALEFT',SHOLFT                               @SC87253 03512000
         KW    '&AARIGHT',SHORGT                               @SC87253 03512500
         KW    ,                                               @SC87253 03513000
*                                                                       03513500
SHORECKW KW    '&ENDOFLI',SHOEOL                               @SC86133 03514000
         KW    '&ENDOFPA',SHOEOL                               @SC86133 03514500
         KW    '&AAAAEOL',SHOEOL,MIN=3                         @SC86133 03515000
         KW    '&PACKLEN',SHOSIZ                               @SC90150 03515500
SHOPSKW  KW    '&PACKSIZ',SHOSIZ                               @SC86133 03516000
         KW    '&PADCHAR',SHOPADC,MIN=5                        @SC86164 03516500
         KW    '&PADDING',SHOPADN,MIN=3                        @SC86164 03517000
         KW    '&AAQUOTE',SHOQUO                               @SC86133 03517500
         KW    '&STARTOP',SHOMARK                              @SC86133 03518000
         KW    '&TIMEOUT',SHOTIMO                              @SC86164 03518500
         KW    '&APARITY',SHOPRTY                              @SC88288 03519000
         KW    ,                                               @SC86133 03519500
*                                                                       03520000
SHOTAKKW KW    '&AAAECHO',SHOECO,MIN=3                         @SC86171 03520500
         KW    '&ERRACTI',SHOHLT,MIN=3                         @SC86171 03521000
         KW    ,                                               @SC86171 03521500
*                                                                       03522000
SHOFORKW KW    '&APREFIX',SHOPFX                               @HF86223 03522500
         KW    '&ASUFFIX',SHOSFX                               @HF86223 03523000
         KW    ,                                               @HF86223 03523500
*                                                                       03524000
SHORETKW KW    '&INITIAL',SHORETI                              @SC86345 03524500
         KW    '&PACKETS',SHORETN                              @SC86345 03525000
         KW    ,                                               @SC86345 03525500
SET      CSECT                                                 @SC90040 03526000
*                                                                       03526500
SHORALL  OI    SFLG,ALLF+ASRF Do just all send/recv items      @SC86295 03527000
         LA    14,SHOHLP     Just help if SET                  @SC87166 03527500
SHORAL2  BAL   2,SHOKW       Get ptr to kw send or receive     @SC86133 03528000
         BER   14            Help for SET                      @SC87166 03528500
         L     15,SHOPTR     Output line buffer ptr            @SC86227 03529000
         LA    1,CMD                                           @SC86227 03529500
         SR    15,1          Anything there?                   @SC86227 03530000
         BNP   SHORAL3       No                                @SC86227 03530500
         ST    1,SHOPTR      Yes, reset ptr                    @SC86227 03531000
         WTEXT (1),(15)      And write it out                  @SC86227 03531500
SHORAL3  DS    0H                                              @SC86227 03532000
         MVC   CMD(2),=C'  '                                   @SC86133 03532500
         MVC   CMD+2(15),0(6) Copy send or receive or ...      @SC89226 03533000
         LA    0,CMD+2(7)    Point past category               @SC86316 03533500
         ST    0,SHOPTR      Save output ptr                   @SC86316 03534000
         L     1,SHOTMP+12   Start at beginning                @SC87166 03534500
         ICM   14,7,KWADR(1) Ptr to 1st routine                @SC90239 03535000
         BR    14                                              @SC86171 03535500
*                                                                       03536000
SHOLCK   LA    4,SETOOFRC    On, Off, Forced                   @SC91275 03536500
         CLI   SETXI,X'97'   SET or SHOW?                      @SC91275 03537000
         BE    SHOLCK1       SET - do it directly              @SC91275 03537500
         TM    LCKFRC,1                                        @SC91275 03538000
         BZ    SHOLCK1                                         @SC91275 03538500
         LA    4,SETOFRC     Just Forced                       @SC91275 03539000
SHOLCK1  BAL   14,SHOXY      Get ON vs. OFF or FORCED          @SC91275 03539500
          OI   SCAPA,X'20'                                     @SC91275 03540000
*                                                                       03540500
SHOALF   LA    4,SETALFKW    NOTE: this must be last parm      @SC90040 03541000
         LA    8,TRNALF      Ptr to transfer character name    @SC90040 03541500
         B     SHOALFC       Processing same as file char set  @SC90040 03542000
*                                                                       03542500
         AIF   ('&ATTTYPE'(1,1) NE '&AAATEXT'(1,1)).CMPAT02    @SC92300 03543000
SETFT    ICM   15,15,LEN     SET F T ...   **COMPAT**          @SC87166 03543500
         LA    8,TYPFIL      In case just 'SET F T'            @SC91320 03544000
         BNP   SETFILET      Nothing after: 'SET FILE-TYPE T'  @SC87166 03544500
.CMPAT02 ANOP                                                  @SC92300 03545000
*                                                                       03545500
SHOFILT  LA    4,SETFIL      List of possibles                 @SC86151 03546000
         LA    6,TYPFIL                                        @SC87166 03546500
         BAL   14,SHOBRV     Get full name from abbrev.        @SC87166 03547000
          NOP  0                                               @SC87166 03547500
SHOLNG   LA    4,SETLNGKW    List of possibles                 @SC88120 03548000
         LA    6,TRNCFL                                        @SC88120 03548500
         BAL   14,SHOBRV     Get full name from abbrev.        @SC88120 03549000
          NOP  0                                               @SC88120 03549500
SHOCLSN  LA    4,SETCLSKW    List of COLLISION options         @SC90033 03550000
         LA    6,CLSNFL                                        @SC90033 03550500
         BAL   14,SHOBRV                                       @SC90033 03551000
          NOP  0                                               @SC90033 03551500
SHOOVWR  LA    4,SETOVWKW    List of possibles                 @SC90033 03552000
         BAL   14,SHOXY                                        @SC90033 03552500
          OI   FL3,SVATT                                       @SC90033 03553000
SHOLR    SR    4,4                                             @SC86133 03553500
         L     8,MAXLRC      Upper limit                       @SC87166 03554000
         ICM   4,3,FILLRC                                      @SC88120 03554500
         BAL   14,SHONUM     Print it                          @SC86133 03555000
          B    SETLR                                           @SC87166 03555500
         KFILSHO ,                                             @SC87012 03556000
SHOFALF  LA    4,SETFALFK    NOTE: this must be last parm      @SC90040 03556500
         LA    8,FILALF      Ptr to file character name        @SC90040 03557000
         LA    9,2*LALF                                        @SC91325 03557500
         CLC   FILALF,FILALF2                                  @SC91325 03558000
         BNE   SHOALF2                                         @SC91325 03558500
SHOALFC  LA    9,LALF                                          @SC91325 03559000
SHOALF2  DS    0H                                              @SC91325 03559500
         BAL   14,SHOCHRN    Get name                          @SC90040 03560000
          B    SETSCN                                          @SC90040 03560500
         B     SHOGRPZ                                         @SC86295 03561000
*                                                                       03561500
SHOLFT   L     4,LMARG                                         @SC87253 03562000
         BAL   14,SHONBIG    Print it                          @SC87253 03562500
          B    RTRN0                                           @SC87253 03563000
SHORGT   L     4,RMARG                                         @SC87253 03563500
         BAL   14,SHONBIG    Print it                          @SC87253 03564000
          B    RTRN0                                           @SC87253 03564500
         B     SHOGRPZ                                         @SC87253 03565000
*                                                                       03565500
SHOWARN  BAL   14,SHOOO      On or off   ***COMPAT***          @SC90033 03566000
          OI   FL1,REN                                         @SC90033 03566500
SHOAPP   BAL   14,SHOOO      On or off   ***COMPAT***          @SC90033 03567000
          OI   FL3,APPN                                        @SC90033 03567500
*                                                                       03568000
SHOECO   BAL   14,SHOOO      On or off                         @SC86171 03568500
          OI   FL2,ECHO                                        @SC87166 03569000
SHOHLT   LA    4,SETSWT      List of possibles                 @SC87166 03569500
         BAL   14,SHOXY                                        @SC86171 03570000
          OI   FL5,TKHLT                                       @SC87166 03570500
         B     SHOGRPZ                                         @SC86171 03571000
*                                                                       03571500
SHOPFX   LA    8,PREFIX      Point to prefix                   @HF86223 03572000
         LA    4,FORMAXL     Max length                        @SC87268 03572500
         BAL   14,SHOSTR     Print message                     @SC86224 03573000
          B    RTRN0                                           @SC87268 03573500
SHOSFX   LA    8,SUFFIX      Point to suffix                   @HF86223 03574000
         LA    4,FORMAXL     Max length                        @SC87268 03574500
         BAL   14,SHOSTR     Print message                     @SC86224 03575000
          B    RTRN0                                           @SC87268 03575500
         B     SHOGRPZ                                         @HF86223 03576000
*                                                                       03576500
SHORETI  L     4,MAXTNT      Initial retry limit               @SC86345 03577000
         BAL   14,SHONBIG    Print it                          @SC87166 03577500
          B    RTRN0                                           @SC87166 03578000
SHORETN  L     4,MAXTRY      Normal retry limit                @SC86345 03578500
         BAL   14,SHONBIG    Print it                          @SC87166 03579000
          B    RTRN0                                           @SC87166 03579500
         B     SHOGRPZ                                         @SC86345 03580000
*                                                                       03580500
SHOEOL   SR    4,4                                             @SC86133 03581000
         IC    4,REOL(5)                                       @SC86133 03581500
         BAL   14,SHOCTL     Print it                          @SC87166 03582000
          B    SETEOL                                          @SC87166 03582500
         LA    1,SHOPSKW     Skip aliases                      @SC86133 03583000
SHOSIZ   L     8,=A(KMAXE)   Limit                             @SC87166 03583500
         LR    3,5                                             @SC87166 03584000
         SLA   3,2           Get fullword index                @SC87166 03584500
         L     4,RPSIZ(3)                                      @SC87166 03585000
         BAL   14,SHONUM     Print number                      @SC86133 03585500
          B    SETSIZ                                          @SC87166 03586000
SHOPADC  SR    4,4                                             @SC86164 03586500
         IC    4,RPADC(5)    Pad character                     @SC86164 03587000
         BAL   14,SHOCTL                                       @SC87166 03587500
          B    SETPADC                                         @SC87166 03588000
SHOPADN  SR    4,4                                             @SC86164 03588500
         LA    8,KMAX        Same upper limit as packets       @SC87166 03589000
         IC    4,RPADN(5)    Pad count                         @SC86164 03589500
         BAL   14,SHONUM                                       @SC86164 03590000
          B    SETPADN                                         @SC87166 03590500
SHOQUO   LA    8,RCTLQ(5)                                      @SC86133 03591000
         BAL   14,SHOCHRA    Print as ascii                    @SC86133 03591500
          B    SETRCTLQ                                        @SC87166 03592000
SHOMARK  SR    4,4                                             @SC86133 03592500
         IC    4,RMARK(5)                                      @SC86133 03593000
         BAL   14,SHOCTL                                       @SC87166 03593500
          B    RTRN0                                           @SC87166 03594000
SHOTIMO  SR    4,4                                             @SC86164 03594500
         IC    4,RTIMO(5)    Timeout limit                     @SC86164 03595000
         BAL   14,SHONBIG                                      @SC87166 03595500
          B    SETTIMO                                         @SC87166 03596000
SHOPRTY  LA    4,SETPAR                                        @SC88288 03596500
         LA    3,RPRTY(5)    Ptr to proper flag                @SC88288 03597000
         BAL   14,SHOXY                                        @SC88288 03597500
          OI   0(3),DAT8                                       @SC88288 03598000
*                                                                       03598500
SHOGRPZ  TM    SFLG,ASRF     Doing just receive/send?          @SC86295 03599000
         BO    SHOZZW        Yes, write last line              @SC86227 03599500
         LM    1,2,SHOTMP    Get top level ptr, return adr     @SC87166 03600000
         LR    14,2                                            @SC86224 03600500
         BAL   2,SHOKW       Get ptr to name                   @SC86133 03601000
         LA    1,0(7,6)      Advance to next                   @SC86133 03601500
         BR    14                                              @SC86224 03602000
*                                                                       03602500
SHOMULT  LR    5,1           Save ptr to current option        @SC88168 03603000
         LR    1,6           Use ptr to list of suboptions     @SC88168 03603500
SHOMULQ  ICM   14,7,KWADR(1) Get ptr to handler (assume OI x,y)@SC90239 03604000
         BAL   2,SHOKW       Get ptrs to KW string, fix SETXI  @SC88168 03604500
         EX    0,SETXI       TM x,y                            @SC88168 03605000
         BNO   SHOMULP       Not this one                      @SC88168 03605500
         MVI   0(15),C','    Yes, punctuate display            @SC88168 03606000
         LA    15,1(15)                                        @SC88168 03606500
         LR    8,6                                             @SC88168 03607000
         LR    9,7                                             @SC88168 03607500
         BAL   2,EDCHAR      Copy this KW to display           @SC88168 03608000
SHOMULP  LA    1,0(7,6)      On to next in list                @SC88168 03608500
         CLI   KWLEN(1),254  End of list?                      @SC90239 03609000
         BL    SHOMULQ       No, keep checking                 @SC88168 03609500
         LR    14,4          Proper place for return adr       @SC88168 03610000
         LR    1,5           Restore ptr to current option     @SC88168 03610500
         B     SHOZZZ        End of item                       @SC88168 03611000
*                                                                       03611500
SHOLIST  LTR   5,5           Length of list                    @SC86355 03612000
         BZ    SHOZZ         Empty, we're done                 @SC86355 03612500
         LA    0,CMD+75      Set right margin                  @SC86355 03613000
         MVI   0(15),C' '    Start with blank                  @SC86355 03613500
         B     *+8                                             @SC86355 03614000
SHOLSLP  MVI   0(15),C','    Insert delimiter                  @SC86355 03614500
         LA    15,1(15)                                        @SC86355 03615000
         CR    15,0          Any room?                         @SC86355 03615500
         BL    SHOLSED       Yes, ok                           @SC86355 03616000
         LA    1,CMD         No, dump line                     @SC86355 03616500
         SR    15,1                                            @SC86355 03617000
         WTEXT (1),(15)                                        @SC86355 03617500
         MVI   CMD,C' '                                        @SC86355 03618000
         LA    15,CMD+1      Start indented                    @SC86355 03618500
         LA    0,CMD+75                                        @SC86355 03619000
SHOLSED  SR    4,4                                             @SC86355 03619500
         IC    4,0(3)        Get 1-byte item                   @SC86355 03620000
         BAL   2,EDDEC       Format it                         @SC86355 03620500
         LA    3,1(3)        Point to next item in list        @SC86355 03621000
         BCT   5,SHOLSLP                                       @SC86355 03621500
         B     SHOZZ         Finished list                     @SC86355 03622000
*                                                                       03622500
SHOKW    MVC   SETXI+1(3),1(14) Copy instr operands            @SC87166 03623000
         CLI   SETXI,X'97'   'OI' if SET, but 'TM' if SHOW     @SC87166 03623500
         LA    6,KWNAME(1)   Ptr to name                       @SC90239 03624000
         LA    7,0           Preserve CC                       @SC86133 03624500
         IC    7,KWLEN(1)    Length (assumes high bytes clear) @SC90239 03625000
         LA    7,1(7)                                          @SC86133 03625500
         BR    2                                               @SC86133 03626000
*                                                                       03626500
SHOCTL   LA    8,ABL-1       Max control character (ASCII)     @SC87166 03627000
         CLI   TRMTP,C'F'    Full-screen non-transparent?      @SC92030 03627500
         BE    SHONBIG       Yes, allow any packet char, etc.  @SC92030 03628000
         TM    FL1,TSTF                                        @SC86295 03628500
         BZ    SHONUM                                          @SC87166 03629000
SHONBIG  L     8,=F'999999998' Almost anything                 @SC87166 03629500
SHONUM   BAL   2,SHOKW                                         @SC86133 03630000
         BE    SETNUM2       Get value for SET                 @SC87166 03630500
         BAL   2,SHONAM      Copy option name                  @SC86209 03631000
         BAL   2,EDDEC       Edit (R4) as decimal              @SC86295 03631500
         B     SHOZZ                                           @SC86133 03632000
*                                                                       03632500
SHOCHRA  MVC   TMP,0(8)      Copy ascii char                   @SC86133 03633000
         PTEXT SETOOKW+KWNAME,3,AREG=8,LREG=9                  @SC91320 03633500
         TM    TMP,X'60'     Is it printable?                  @SC87008 03634000
         BZ    SHOCHRN       No, say it's OFF                  @SC87008 03634500
         TR    TMP,ATOED     Convert to EBCDIC                 @SC89301 03635000
         LA    8,TMP                                           @SC86133 03635500
         B     SHOCHR                                          @SC86224 03636000
SHOSTR   BAL   2,SHOKW       Get ptrs to name                  @SC87268 03636500
         BE    SETSTR        Branch to dispatch for SET        @SC87268 03637000
         SR    9,9           Variable-length string            @SC86224 03637500
         IC    9,0(8)        Get length                        @SC86224 03638000
         LA    8,1(8)        Ptr to text                       @SC86224 03638500
         B     SHOCHRD                                         @SC87268 03639000
SHOCHR   LA    9,1           Length is 1                       @SC86224 03639500
SHOCHRN  BAL   2,SHOKW       Get ptrs to name                  @SC86224 03640000
         BER   14            Branch to dispatch for SET        @SC87166 03640500
SHOCHRD  BAL   2,SHONAM      Copy option name                  @SC87268 03641000
         BAL   2,EDCHAR      Append string at (R8)             @SC87034 03641500
         B     SHOZZ         Print message                     @SC87034 03642000
*                                                                       03642500
SHOBRV   CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03643000
         LR    8,6           Save ptr to code field            @SC91320 03643500
         BE    SETSCN                                          @SC87166 03644000
         LR    9,14          Save return adr                   @SC87166 03644500
         LR    8,1           Save list ptr                     @SC87166 03645000
         LR    1,4           Use list of suboptions            @SC87166 03645500
         ICM   7,4,0(6)      Use code to look up               @SC91320 03646000
         ICM   7,8,*         Indicate just search              @SC87166 03646500
         BAL   14,SCAN                                         @SC87166 03647000
          CR   0,0           These two skipped                 @SC87166 03647500
          LR   4,1            if bad value                     @SC87166 03648000
         LR    1,8           Retrieve ptrs                     @SC87166 03648500
         LR    14,9                                            @SC87166 03649000
         B     SHOXY         Display it                        @SC87166 03649500
*                                                                       03650000
SHOOO    LA    4,SETOOKW     Ptr to on/off                     @SC87166 03650500
SHOXY    BAL   2,SHOKW       Set up name                       @SC86133 03651000
         BE    SETSCN        Parse value for SET               @SC87166 03651500
         LA    8,KWNAME(4)   Value if off                      @SC90239 03652000
         SR    9,9                                             @SC87166 03652500
         IC    9,KWLEN(4)    Length of name - 1                @SC90239 03653000
         EX    0,SETXI       Test bit                          @SC87166 03653500
         BZ    *+12                                            @SC86133 03654000
          LA   8,KWNAME+1(9,8) Flag is on, advance to other    @SC90239 03654500
          IC   9,KWNAME+1(9,4) Length-1 of other item          @SC90239 03655000
         LA    9,1(9)                                          @SC86133 03655500
SHOXL    BAL   2,SHONAM      Copy option name                  @SC86209 03656000
         BAL   2,EDCHAR      Append string at (R8)             @SC86295 03656500
         SR    15,9          Back up to string                 @SC87034 03657000
         TR    0(30,15),LOCASE And make it lower case          @SC87034 03657500
         AR    15,9          Resume                            @SC87034 03658000
SHOZZ    LA    1,0(7,6)      Advance to next option            @SC88168 03658500
SHOZZZ   ST    15,SHOPTR     Save end of display buffer        @SC88168 03659000
         L     3,=A(SETCMDS) Recover base reg.                 @SC90040 03659500
         LA    14,4(14)      Skip over SET branch              @SC87166 03660000
         CLM   14,7,=AL3(SHOTABSZ)                             @SC86355 03660500
         BER   14            Special treatment for tabs        @SC86355 03661000
         CLM   14,7,=AL3(SHODEBZ)                              @SC88168 03661500
         BER   14            Special treatment for DEBUG, too  @SC88168 03662000
         TM    SFLG,ALLF     Doing all?                        @SC86295 03662500
         BOR   14            And resume if yes                 @SC86227 03663000
SHOZZW   LA    1,CMD         No, get address of buffer         @SC86227 03663500
         SR    15,1          Get length                        @SC86227 03664000
         WTEXT (1),(15)      Write it out                      @SC86227 03664500
         B     RTRN0         That's all                        @SC86295 03665000
*                                                                       03665500
SHONAM   LA    15,CMD        Output message buffer             @SC86209 03666000
         L     0,SHOPTR      End of prev. msg                  @SC86227 03666500
         CR    0,15          Empty?                            @SC86227 03667000
         BE    SHON1         Yes, start here                   @SC86227 03667500
         LA    1,CMD+23      2nd column                        @SC86227 03668000
         SR    1,0           Far enough?                       @SC86227 03668500
         BP    SHONF         Yes, blank fill                   @SC86227 03669000
         AH    1,=H'23'      Try 3rd column                    @SC86227 03669500
         BP    SHONF         OK                                @SC86227 03670000
         SR    0,15          No room, dump line                @SC86227 03670500
         WTEXT (15),(0)                                        @SC86227 03671000
         LA    15,CMD        And start over                    @SC86227 03671500
         B     SHON1                                           @SC86227 03672000
SHONF    SR    15,15                                           @SC86295 03672500
         ICM   15,8,BLANK                                      @SC86295 03673000
         MVCL  0,14          Fill with blanks to next column   @SC86227 03673500
         LR    15,0          New output ptr                    @SC86227 03674000
SHON1    MVC   0(40,15),0(6) Copy option name                  @SC87034 03674500
         TR    1(39,15),LOCASE And beautify it                 @SC87034 03675000
         AR    15,7          Space over it                     @SC86209 03675500
         INITSTR '&AAAAAIS'                                    @SC92300 03676000
         BR    2                                               @SC86209 03676500
         DROP  3                                               @SC90040 03677000
*                                                                       03677500
         LOCALS ,                                              @SC86295 03678000
SHOTMP   DS    4F                                              @SC87166 03678500
SHOPTR   DS    A             More temporaries                  @SC86227 03679000
SETXI    DS    F             XI executable instr               @SC86273 03679500
SFLG     DS    X             Local flags                       @SC86295 03680000
ALLF     EQU   X'80'         Doing SHOW ALL                    @SC86295 03680500
ASRF     EQU   X'40'         Doing SHOW REC or SHOW SEND       @SC86295 03681000
SHODBG   DS    X             Temp for DEBUG flags              @SC88168 03681500
SHOW     EXIT                                                           03682000
         TITLE 'STATUS Routine - display latest error, etc.'   @SC86295 03682500
* Exit: R15=0.  ERRNUM unchanged.                                       03683000
STATUS   ENTER                                                 @SC86156 03683500
         CLI   ERRNUM,ERRNFT Actual error?                     @BS86090 03684000
         BNH   STAMSG        No                                @BS86090 03684500
         CLI   ERRNUM,ERRKCE Last command invalid?             @SC86295 03685000
         BE    STAMSG        Yes, do not show last file        @HF86232 03685500
         CLI   FILNAM,0      File name defined?                @BS86090 03686000
         BE    STAMSG        No                                @BS86090 03686500
         INITSTR '&LASTFIL',CMD,REG=7                          @SC92300 03687000
         LA    1,FILNAM                                        @SC86295 03687500
         BAL   2,STAFSP      Copy name and print               @SC86295 03688000
STAMSG   ICM   4,15,NSENT    Number of files sent              @SC86295 03688500
         BZ    STASNTZ                                         @SC86295 03689000
         LA    15,CMD        Start of message buffer           @SC86295 03689500
         BAL   2,EDDEC       Format number as decimal          @SC86295 03690000
         INITSTR '&FSENLST'                                    @SC92300 03690500
         BAL   2,STAPM15     Show message                      @SC86295 03691000
STASNTZ  ICM   0,15,PAKCNT   Any transfer statistics?          @SC86295 03691500
         BZ    STADATR       No, skip it                       @SC86316 03692000
         ICM   6,7,=C'&PKTABBR'                                @SC86295 03692500
         BAL   3,STADPR      Format msg                        @SC86295 03693000
         ICM   0,15,SECTOT   Any duration?                     @SC86295 03693500
         BZ    STADATR       No, must have been very short     @SC86316 03694000
         ICM   6,7,=C'&SECABBR'                                @SC86295 03694500
         BAL   3,STADPR      Format msg                        @SC86295 03695000
         INITSTR '&BYTPSEC',CMD                                @SC92300 03695500
         L     0,SECTOT                                        @SC86295 03696000
         LM    4,5,DSKTOT                                      @SC86295 03696500
         BAL   2,STAVB       Format ratio                      @SC86295 03697000
         ICM   1,15,BAUD     Efficiency only if speed defined  @SC93014 03697500
         BNP   STADEFCZ                                        @SC93014 03698000
         MVC   0(3,15),=C' = '                                 @SC93014 03698500
         LA    15,3(,15)                                       @SC93014 03699000
         M     4,=F'1000'    *10*100 for bits/byte and percent @SC93014 03699500
         L     0,BAUD        Compute percentage of line speed  @SC93014 03700000
         BAL   2,STAVB       Format ratio                      @SC93014 03700500
         INITSTR '% (&AASPEED.&AAAAAIS'  Remind of rating      @SC93014 03701000
         L     4,BAUD                                          @SC93014 03701500
         BAL   2,EDDEC                                         @SC93014 03702000
         MVI   0(15),C')'                                      @SC93014 03702500
         LA    15,1(,15)                                       @SC93014 03703000
STADEFCZ DS    0H                                              @SC93014 03703500
         BAL   2,STAPM15     Print line                        @SC86295 03704000
STADATR  ICM   4,15,RTRCNT   Any retries?                      @SC86316 03704500
         BZ    STADATZ       No                                @SC86316 03705000
         LA    15,CMD        Yes, issue message                @SC86316 03705500
         BAL   2,EDDEC                                         @SC86316 03706000
         INITSTR '&REPTCNT'                                    @SC92300 03706500
         BAL   2,STAPM15     Print line                        @SC86316 03707000
         XC    TINSV(48),TINSV Completely clear data           @SC88325 03707500
         KCALL OPTPKT        Get best packet size              @SC88325 03708000
         LTR   4,15          Valid?                            @SC86345 03708500
         BNP   STADATZ       No, skip it                       @SC86345 03709000
         INITSTR '&OPTSIZE',CMD                                @SC92300 03709500
         BAL   2,EDDEC       Format it                         @SC86345 03710000
         BAL   2,STAPM15                                       @SC86345 03710500
STADATZ  ICM   4,15,RECTRC   Any truncated records?            @SC87268 03711000
         BZ    STATRCZ       No, ok                            @SC87268 03711500
         LA    15,CMD        Yes, issue message                @SC87268 03712000
         BAL   2,EDDEC                                         @SC87268 03712500
         INITSTR '&MRCTRNC'                                    @SC92300 03713000
         BAL   2,STAPM15                                       @SC87268 03713500
STATRCZ  DS    0H                                              @SC87268 03714000
         ICM   4,15,RECFLD   Any folded records?               @SC88120 03714500
         BZ    STATFDZ       No, ok                            @SC88120 03715000
         LA    15,CMD        Yes, issue message                @SC88120 03715500
         BAL   2,EDDEC                                         @SC88120 03716000
         INITSTR '&RECFOLD'                                    @SC92300 03716500
         BAL   2,STAPM15                                       @SC88120 03717000
STATFDZ  DS    0H                                              @SC88120 03717500
STAPEMSG DS    0H                                              @SC91064 03718000
         SR    5,5                                             @SC86156 03718500
         IC    5,ERRNUM      Get offset into error table       @SC86156 03719000
         SLL   5,2           Get fullword index                @SC86156 03719500
         A     5,=A(ERRTAB)  Pointer address                   @SC89215 03720000
         L     1,0(5)        Msg ptr                           @SC86156 03720500
         SR    0,0                                             @SC86268 03721000
         SLDL  0,8           Msg length                        @SC86316 03721500
         SRL   1,8           Realign adr                       @SC86316 03722000
         WTEXT (1),(0)       Print message                     @SC86268 03722500
         CLI   ERRNUM,ERRTRC Cancelled?                        @SC86316 03723000
         BNE   STACKAB       No                                @SC86316 03723500
         SR    1,1                                             @SC86316 03724000
         CLI   REASON,STACNN Within table?                     @SC90033 03724500
         BH    *+8           No, must be new                   @SC86316 03725000
         IC    1,REASON      Ok, get the complaint code        @SC86316 03725500
         SLL   1,3           Index into table                  @SC86316 03726000
         LA    1,STACNTB(1)                                    @SC86316 03726500
         LA    0,8           Length of items                   @SC86316 03727000
         WTEXT (1),(0)                                         @SC86316 03727500
STACKAB  CLI   ERRNUM,ERRABO Micro aborted?                    @BS86090 03728000
         BE    *+12          Yes                               @SC87338 03728500
         CLI   ERRNUM,ERRDIE No, disk I/O error?               @SC87338 03729000
         BNE   STARET        No                                @BS86090 03729500
         ICM   0,15,EMSGL    Yes, any message?                 @SC86268 03730000
         BZ    STARET        No                                @BS86090 03730500
         L     1,EMSGP                                         @BS86090 03731000
         WTEXT (1),(0)       Yes, show it                      @SC86268 03731500
STARET   TM    FL1,TSTF                                        @SC89089 03732000
         BZ    RTRN0         Skip this message unless testing  @SC89089 03732500
         LM    3,4,STKLO     Get start and end of stack use    @SC89089 03733000
         SR    4,3           Get length (is mult. of 8)        @SC89089 03733500
         SRL   4,3           Convert to doublewords            @SC89089 03734000
         LA    15,CMD        Sart of msg buffer                @SC89089 03734500
         BAL   2,EDDEC       Format number                     @SC89089 03735000
         INITSTR '&DWRDSTK'                                    @SC92300 03735500
         BAL   2,STAPM15                                       @SC89089 03736000
         B     RTRN0                                           @SC89089 03736500
*                                                                       03737000
STADPR   INITSTR '&ZZBYTES',CMD                                @SC92300 03737500
         MVC   0(8,15),=C'/___: S='                            @SC92300 03738000
         STCM  6,7,1(15)     Fill in unit name (pkt or sec)    @SC92300 03738500
         LA    15,8(,15)                                       @SC92300 03739000
         LM    4,5,TOUTOT                                      @SC86295 03739500
         BAL   2,STAVB       Format ratio                      @SC86295 03740000
         MVC   0(3,15),=C' R='                                 @SC86295 03740500
         LA    15,3(15)                                        @SC86295 03741000
         LM    4,5,TINTOT                                      @SC86295 03741500
         BAL   2,STAVB       Format ratio                      @SC86295 03742000
         INITSTR '&REQUIRG'                                    @SC92300 03742500
         LR    4,0                                             @SC86295 03743000
         BAL   2,EDDEC       Format number of units            @SC86295 03743500
         MVI   0(15),C' '                                      @SC86295 03744000
         STCM  6,7,1(15)                                       @SC86295 03744500
         LA    0,4(15)       End of msg                        @SC86295 03745000
         BAL   2,STAPMSG     Print it                          @SC86295 03745500
         BR    3                                               @SC86295 03746000
*                                                                       03746500
STAVB    DR    4,0           Get ratio                         @SC86295 03747000
         AR    4,4                                             @SC86295 03747500
         CR    4,0                                             @SC86295 03748000
         BL    *+8                                             @SC86295 03748500
         A     5,F1          Round up                          @SC86295 03749000
         LR    4,5                                             @SC86295 03749500
         B     EDDEC         Format it                         @SC86295 03750000
*                                                                       03750500
* Display just error message and its backup explanations.      @SC91064 03751000
*  (same as STATUS)                                            @SC91064 03751500
PEMSG    ENTER ALT                                             @SC91064 03752000
         B     STAPEMSG      Do it                             @SC91064 03752500
*                                                                       03753000
* Table of reasons for rejecting Attribute packet              @SC86316 03753500
STACNTB  DC    C'-&ATTUNK.-&ATTLEN.-&ATTTYP.-&ATTDAT.'         @SC92300 03754000
         DC    C'-&ATTCRE.-&ATTACC.-&ATTARE.-&ATTPAS.'         @SC92300 03754500
         DC    C'-&ATTBLK.-&ATTACS.-&ATTENC.-&ATTDIS.'         @SC92300 03755000
         DC    C'-&ATTPRO.-&ATTPRO.-&ATTORI.-&ATTFRM.'         @SC92300 03755500
         DC    C'-&ATTSIN.-&ATTBLE.'                           @SC92300 03756000
         DC    (32-(*-STACNTB)/8)CL8'-??'                      @SC91109 03756500
         DC    C'-&AAAAEN.'                          32-       @SC92300 03757000
STACNCLS EQU   (*-STACNTB)/8 One extra reason stuck on the end @SC90033 03757500
         DC    C'-&COLLIS.'                                    @SC92300 03758000
STACNN   EQU   (*-STACNTB)/8-1                                 @SC90033 03758500
         LOCALS ,                                              @SC91109 03759000
         EXIT                                                  @SC91109 03759500
         TITLE 'DUMP Routine - print translation table'                 03760000
* Display current values in STORAG.                                     03760500
* Entry: SCANPTR string has option                                      03761000
* Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM unchanged.   03761500
DUMP     ENTER ,                                               @SC91109 03762000
         NTOKN N=DUMPH       A or E?                           @SC86156 03762500
         SCAN  DUMPKW,RTRN1                                    @SC86295 03763000
DUMPH    HELP  DUMPKW,RTRN1                                    @SC86295 03763500
*                                                                       03764000
DUMPKW   KW    '&AAAATOE',DUMPA                                @SC86156 03764500
         KW    '&CTRLCHR',DUMPCT                               @SC93173 03765000
         KW    '&AAAETOA',DUMPE                                @SC86156 03765500
         KW    '&AANAMES',DMPN                                 @SC86295 03766000
         KW    '&AATATOE',DUMPTA,MIN=2                         @SC87117 03766500
         KW    '&AATETOA',DUMPTE,MIN=2                         @SC87117 03767000
         AIF   ('&KTRACE' NE 'YES').NODUMTR                    @SC92169 03767500
         KW    '&AATRACE',DUMPTR,MIN=2                         @SC92169 03768000
.NODUMTR ANOP                                                  @SC92169 03768500
         KW    ,                                               @SC86156 03769000
*                                                                       03769500
DUMPTR   KTRACE DUMP         Dump trace table (only if enabled)@SC92169 03770000
*                                                                       03770500
DMPN     L     5,TSENT       Table ptr                         @SC86295 03771000
         ICM   6,15,NSENT    Number of files sent              @SC86295 03771500
         BNZ   DMPNL                                           @SC86295 03772000
         WTEXT '&NOFSENT'                                      @SC86295 03772500
         B     RTRN0                                           @SC86295 03773000
         USING ACTBUF,5                                        @SC91172 03773500
DMPNL    LA    7,CMD         Start of message buffer           @SC86295 03774000
         SR    15,15                                           @SC91172 03774500
         ICM   15,7,ACTBEG   Starting time                     @SC91172 03775000
         BAL   2,DMPTIM                                        @SC91172 03775500
         LA    0,FFDSP                                         @SC88092 03776000
         KCALL FSPEC,ACTFID  Copy name for display             @SC91172 03776500
         MVC   0(2,15),=C' ('                                  @SC88092 03777000
         LA    15,2(15)                                        @SC88092 03777500
         ICM   4,15,ACTSIZ   Get file size                     @SC91172 03778000
         BAL   2,EDDEC       Format into message               @SC88092 03778500
         MVC   0(2,15),=C'k)'                                  @SC88092 03779000
         LA    15,2(15)                                        @SC88092 03779500
         SR    2,2                                             @SC88092 03780000
         ICM   2,1,ACTERR    Get corresponding error code      @SC91172 03780500
         BZ    DMPNN         No error, that's fine             @SC88092 03781000
         SLL   2,2                                             @SC88092 03781500
         A     2,=A(ERRTAB)  Get ptr into error table          @SC89215 03782000
         SR    3,3                                             @SC88092 03782500
         IC    3,0(2)        Length of message                 @SC88092 03783000
         L     2,0(2)        And message ptr                   @SC88092 03783500
         MVC   0(4,15),=C' -- '                                @SC88092 03784000
         MVC   4(50,15),0(2) Copy message                      @SC88092 03784500
         LA    15,4(3,15)                                      @SC88092 03785000
         CLI   ACTERR,ERRTRC Cancelled?                        @SC91172 03785500
         BNE   DMPNN         No                                @SC91172 03786000
         SR    1,1                                             @SC91172 03786500
         CLI   ACTREA,STACNN Within table?                     @SC91172 03787000
         BH    *+8           No, must be new                   @SC91172 03787500
          IC   1,ACTREA      Ok, get the complaint code        @SC91172 03788000
         SLL   1,3           Index into table                  @SC91172 03788500
         A     1,=A(STACNTB)                                   @SC91172 03789000
         MVI   0(15),C' '    Leave a space                     @SC91172 03789500
         MVC   1(8,15),0(1)  Copy to message                   @SC91172 03790000
         LA    15,9(,15)     Length of items                   @SC91172 03790500
DMPNN    BAL   2,STAPM15     Display name (+ error)            @SC88092 03791000
         A     5,FLFID1      Next filespec                     @SC88092 03791500
         BCT   6,DMPNL                                         @SC86295 03792000
         LA    7,CMD         Start of message buffer           @SC91172 03792500
         ICM   15,15,TRANEND Quitting time                     @SC92210 03793000
         BAL   2,DMPTIM                                        @SC91172 03793500
         LR    15,7                                            @SC92300 03794000
         INITSTR '&FINISHD'                                    @SC92300 03794500
         BAL   2,STAPM15                                       @SC91172 03795000
         B     RTRN0                                           @SC86295 03795500
         DROP  5                                               @SC91172 03796000
* Display TOD from R15 as hh:mm:ss in buffer at R7;            @SC91172 03796500
*   return via R2; clobber R1,R4,R14,R15; update R7.           @SC91172 03797000
DMPTIM   LA    1,8           Length of output string           @SC91172 03797500
         BCTR  7,0           Allow for index to start at 1     @SC91172 03798000
         SR    4,4           Clear divisor                     @SC91172 03798500
DMTLP    IC    4,DVSR-1(1)   Get next divisor                  @SC91172 03799000
         LTR   4,4           See if time for a colon           @SC91172 03799500
         BNZ   DMTDIG        Not yet...                        @SC91172 03800000
         LA    14,C':'       Yes, put in colon                 @SC91172 03800500
         B     DMTSTOR                                         @SC91172 03801000
DMTDIG   SR    14,14         Set up next division              @SC91172 03801500
         DR    14,4          Get remainder for next digit      @SC91172 03802000
         LA    14,C'0'(,14)  Convert to printable              @SC91172 03802500
DMTSTOR  STC   14,0(1,7)     Store character in buffer         @SC91172 03803000
         BCT   1,DMTLP                                         @SC91172 03803500
         MVI   9(7),C' '     Leave a blank                     @SC91172 03804000
         LA    7,10(,7)      Space over string                 @SC91172 03804500
         BR    2                                               @SC91172 03805000
DVSR     DC    AL1(6,10,0,6,10,0,6,10)                         @SC91172 03805500
*                                                                       03806000
DUMPCT   LA    3,CTLTAB                                        @SC93173 03806500
         LA    7,160(,3)     End of table                      @SC93173 03807000
         B     DUMPAEX                                         @SC93173 03807500
DUMPA    LA    3,ATOE                                          @SC86156 03808000
         B     DUMPAE                                          @SC86156 03808500
DUMPE    LA    3,ETOA                                          @SC86156 03809000
         B     DUMPAE                                          @SC87117 03809500
DUMPTA   LA    3,TATOE                                         @SC87117 03810000
         B     DUMPAE                                          @SC87117 03810500
DUMPTE   LA    3,TETOA                                         @SC87117 03811000
DUMPAE   LA    7,256(,3)     End of table                      @SC93173 03811500
DUMPAEX  LA    4,4           Bytes per word                    @SC93173 03812000
         LA    5,15(3)       End of 1st line                   @SC86156 03812500
         LA    6,16          Bytes per line                    @SC86156 03813000
DUMPLL   LA    2,CMD         Output buffer                     @SC86156 03813500
DUMPLW   UNPK  0(9,2),0(5,3) Convert a word                    @SC86156 03814000
         TR    0(8,2),TRHEX  Hex notation                      @SC86156 03814500
         MVI   8(2),C' '     Leave a space between words       @SC86156 03815000
         LA    2,9(2)                                          @SC86156 03815500
         BXLE  3,4,DUMPLW    Do next word                      @SC86156 03816000
         LA    1,CMD         Done line of 4                    @SC86156 03816500
         LA    0,35                                            @SC86268 03817000
         WTEXT (1),(0)       Print it                          @SC86268 03817500
         BXLE  5,6,DUMPLL    Done line, go to next             @SC86156 03818000
         B     RTRN0                                                    03818500
         SPACE 3                                               @SC91172 03819000
* Extra entry point for dumping TOD (in sec) from R0 into buf  @SC91172 03819500
* at R1 and return updated buffer ptr in R15                   @SC91172 03820000
DUMPTOD  ENTER ALT                                             @SC91172 03820500
         LR    15,0          Time in sec                       @SC91172 03821000
         LR    7,1           Buffer ptr                        @SC91172 03821500
         BAL   2,DMPTIM      Dump it                           @SC91172 03822000
         LR    15,7                                            @SC91172 03822500
         B     RTRN                                            @SC91172 03823000
         TITLE 'GIVTAB Routine - save translation table'                03823500
* Save current values in STORAG into a TAKE file on disk                03824000
* Entry: SCANPTR string has option                                      03824500
* Exit: R15=0 if ok, R15=1 if error or help needed.  ERRNUM set         03825000
*       appropriately as long as command syntax is ok, else unchanged.  03825500
GIVTAB   ENTER ALT                                             @SC87117 03826000
         NTOKN N=GIVH       A or E?                            @SC87117 03826500
         SCAN  GIVKW,RTRN1                                     @SC87117 03827000
GIVH     HELP  GIVKW,RTRN1                                     @SC87117 03827500
*                                                                       03828000
GIVKW    KW    '&AAAATOE',GIVA                                 @SC87117 03828500
         KW    '&CTRLCHR',GIVCTL                               @SC93173 03829000
         KW    '&AAAETOA',GIVE                                 @SC87117 03829500
         KW    '&AATATOE',GIVTA,MIN=2                          @SC87117 03830000
         KW    '&AATETOA',GIVTE,MIN=2                          @SC87117 03830500
         KW    ,                                               @SC87117 03831000
*                                                                       03831500
GIVCTL   LA    6,CTLTAB-1    Permission to transmit "as is"    @SC93173 03832000
         LA    0,=160X'01'   Assume most are permitted         @SC93173 03832500
LA161    LA    5,161         Length of table (+ 1)             @SC93173 03833000
         B     GIVANY                                          @SC93173 03833500
GIVA     LA    6,ATOE-ATOE   ATOE table is first in storage    @SC90040 03834000
         B     GIVSET                                          @SC90040 03834500
GIVE     LA    6,ETOA-ATOE   i.e., 256                         @SC90040 03835000
GIVSET   LR    7,1           Save ptr to cmd option            @SC90040 03835500
         XR    0,0           Quit if invalid pair              @SC90040 03836000
         L     1,CBUF                                          @SC90040 03836500
         KCALL TBLSET,E=RTRN1 Load base tables into CBUF       @SC90040 03837000
         LA    0,0(6,1)      R0->base table                    @SC90040 03837500
         LA    6,ATOE-1(6)   R6->working table - 1             @SC90040 03838000
         LR    1,7           R1->item in keywords list         @SC90040 03838500
         B     GIVAE                                           @SC90040 03839000
GIVTA    LA    6,TATOE-1                                       @SC87117 03839500
GIVA1    LA    0,ATOED                                         @SC87117 03840000
         B     GIVAE                                           @SC87117 03840500
GIVTE    LA    6,TETOA-1                                       @SC87117 03841000
GIVE1    LA    0,ETOAD                                         @SC87117 03841500
GIVAE    LA    5,257         Length of table (+ 1)             @SC93173 03842000
GIVANY   SR    15,15                                           @SC93173 03842500
         IC    15,0(1)       Get length of name                @SC88298 03843000
         INITSTR '&AAAASET',GIVBUF,REG=7                       @SC92300 03843500
         MVI   0(7),C' '                                       @SC92300 03844000
         MVC   1(20,7),KWNAME(1) Copy name to command          @SC93173 03844500
         LA    15,2(15,7)                                      @SC92300 03845000
         MVI   0(15),C' '                                      @SC87117 03845500
         LA    15,1(15)      Get ptr for 1st argument          @SC87117 03846000
         LR    1,0                                             @SC87117 03846500
         BCTR  0,0           Back up to start at "difference"  @SC87117 03847000
         STM   15,1,GIVSV    Save ptrs: cmd, table, table start@SC87117 03847500
         LR    7,5           Table length + 1                  @SC93173 03848000
         LA    0,FFGIV                                         @SC87117 03848500
         KCALL FSPEC,FILNAM,E=GIVFNE  Error                    @SC87117 03849000
         MVI   ERRNUM,ERRNOE Ok now                            @SC87117 03849500
         OPENF O,FILNAM,LOGFDB,GIVPTR,E=GIVOPERR               @SC87117 03850000
         CH    5,LA161+2     See if doing controls             @SC93173 03850500
         BNE   GIVLP         No, just start loop               @SC93173 03851000
         L     4,GIVSV                                         @SC93173 03851500
         MVC   0(,4),=CL1'&UNPREFD' First, set all unprefixed  @SC93173 03852000
         LA    15,1(,4)                                        @SC93173 03852500
         LA    2,GIVBUF                                        @SC93173 03853000
         SR    15,2          Length of line                    @SC93173 03853500
         WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR         @SC93173 03854000
         MVC   0(,4),=CL1'&PREFIXD' Then reset infividuals     @SC93173 03854500
         MVI   1(4),C' '                                       @SC93173 03855000
         LA    4,2(,4)                                         @SC93173 03855500
         ST    4,GIVSV                                         @SC93173 03856000
GIVLP    LM    15,0,GIVSV    Get output ptr, table scan ptr    @SC87117 03856500
         A     6,F1          Skip last difference              @SC93173 03857000
         A     0,F1                                            @SC93173 03857500
         BCTR  7,0           New length left                   @SC87117 03858000
         LR    1,7           Copy length                       @SC87117 03858500
         CLCL  0,6           Find next difference              @SC87117 03859000
         BE    GIVFIN        All done                          @SC87117 03859500
         ST    0,GIVSV+4     Save new ptr                      @SC87117 03860000
         LR    4,0           Get offset                        @SC87117 03860500
         S     4,GIVSV+8                                       @SC87117 03861000
         BAL   2,EDDEC       Write as decimal                  @SC87117 03861500
         CH    5,LA161+2     Doing controls?                   @SC93173 03862000
         BE    GIVWRT        Yes, skip value                   @SC93173 03862500
         MVI   0(15),C' '    Leave space                       @SC87117 03863000
         LA    15,1(15)                                        @SC87117 03863500
         IC    4,0(6)        Get tailored character            @SC87117 03864000
         BAL   2,EDDEC       Write as decimal                  @SC87117 03864500
GIVWRT   DS    0H                                              @SC93173 03865000
         LA    2,GIVBUF                                        @SC87117 03865500
         SR    15,2          Length of line                    @SC87117 03866000
         WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR         @SC87117 03866500
         B     GIVLP                                           @SC87117 03867000
GIVWRERR CLOSF GIVPTR        Close output file                 @SC87117 03867500
GIVOPERR PTEXT '&NOWRITE'                                      @SC87117 03868000
GIVFNE   WTEXT (3),(4)       Show message                      @SC87117 03868500
         B     RTRN1                                           @SC87117 03869000
GIVFIN   CLOSF GIVPTR,E=GIVOPERR Close output file             @SC87117 03869500
         B     RTRN0                                           @SC86295 03870000
         LOCALS ,                                              @SC86295 03870500
GIVSV    DS    3F            Saved ptrs for saving table       @SC87117 03871000
GIVPTR   DS    A             Ticket for disk I/O               @SC87117 03871500
         DS    (MAXDOF)X     Leave room for data offset        @SC90264 03872000
GIVBUF   DS    CL25          Buffer for new file               @SC87117 03872500
         AIF   ('&KTRACE' NE 'YES').NODUMTB                    @SC92169 03873000
         ORG   GIVSV                                           @SC92169 03873500
DUMTBL   DS    (45*16)X                                        @SC92169 03874000
.NODUMTB ANOP                                                  @SC92169 03874500
         EXIT                                                  @SC86164 03875000
         TITLE 'OPTPKT Routine - compute optimum packet size'  @SC88325 03875500
* Entry: TINSV contains stack of data                                   03876000
* Exit: R15=0 if no limit, else optimum packet size                     03876500
OPTPKT   ENTER ,                                               @SC88325 03877000
         LM    1,2,TINTOT    Get byte count                    @SC88325 03877500
         AL    2,TOUTOT+4                                      @SC88325 03878000
         BC    12,*+8                                          @SC88092 03878500
         AL    1,F1                                            @SC88325 03879000
         AL    1,TOUTOT                                        @SC88325 03879500
         LM    3,4,PAKCNT    Get packets, errors               @SC88325 03880000
         L     5,CSECTOT     Get time (elapsed, if done)       @SC88325 03880500
         LM    6,9,TINSV     3rd-last snapshot                 @SC88325 03881000
         MVC   TINSV(32),TINSV+16 Shift snapshots back         @SC88325 03881500
         STM   2,5,TINSV+32  And insert latest                 @SC88325 03882000
         LTR   4,4           Any errors ever?                  @SC88325 03882500
         BZ    RTRN0         No, use max buffer                @SC88325 03883000
         SLR   2,6           Get incremental counts: bytes,    @SC88325 03883500
         SR    3,7           ... packets,                      @SC88325 03884000
         BP    *+8                                             @SC89275 03884500
          LA   3,1           Mustn't divide by 0!              @SC89275 03885000
         SR    4,8           ... errors,                       @SC88325 03885500
         BP    *+8                                             @SC88325 03886000
          LA   4,1           Mustn't divide by 0!              @SC88325 03886500
         SR    5,9           ... and csec.                     @SC88325 03887000
         BNM   *+8                                             @SC88325 03887500
          A    5,=F'1759218604' Wraps by 2**44/10000           @SC88325 03888000
         LR    7,4           Save error count                  @SC88325 03888500
         M     4,BAUD        Total possible transmission       @SC88325 03889000
         C     4,=F'500'                                       @SC88325 03889500
         BNL   RTRN0                                           @SC88325 03890000
         D     4,=F'1000'    Correct for 10 baud, 100 csec     @SC88325 03890500
         SR    5,2           Possible - actual                 @SC88325 03891000
         BNP   RTRN0         ??                                @SC88325 03891500
         MR    6,3           Errors * packets                  @SC88325 03892000
         SLA   3,4           Packets * 16 (16 apprx 19)        @SC88325 03892500
         SR    2,3           Useful bytes                      @SC88325 03893000
         LR    3,2                                             @SC88325 03893500
         SLR   2,2           Prepare divide                    @SC88325 03894000
         DR    2,7                                             @SC88325 03894500
         MR    2,5                                             @SC88325 03895000
*  Compute sq rt of value in (2,3), return in 15.  Uses 2,3,4,5,14.     03895500
SQRT     LR    14,2          Copy for sqrt                     @SC86345 03896000
         LR    15,3                                            @SC86345 03896500
         LA    4,31          Count bits                        @SC86345 03897000
SQRL1    CL    2,=XL4'10000000'                                @SC86345 03897500
         BNL   SQRL2         Justified now                     @SC86345 03898000
         SLDL  2,2           Keep shifting                     @SC86345 03898500
         BCT   4,SQRL1                                         @SC86345 03899000
SQRL2    LCR   4,4                                             @SC86345 03899500
         AL    2,=XL4'10000000'  1st guess at sqrt             @SC86345 03900000
         SRDL  2,62(4)       Shift back                        @SC86345 03900500
         LTR   3,3                                             @SC86345 03901000
         BNP   SQRX          Too small anyway                  @SC86345 03901500
         LA    2,3                                             @SC86345 03902000
SQRL3    LR    4,14                                            @SC86345 03902500
         LR    5,15                                            @SC86345 03903000
         DR    4,3           Get next guess                    @SC86345 03903500
         AR    3,5                                             @SC86345 03904000
         SRA   3,1                                             @SC86345 03904500
         BCT   2,SQRL3                                         @SC86345 03905000
SQRX     LR    15,3                                            @SC86345 03905500
         B     RTRN                                            @SC88325 03906000
         LOCALS ,                                              @SC88325 03906500
         EXIT  ,                                               @SC88325 03907000
         TITLE 'GENCMD Routine - send a Generic command'       @SC86155 03907500
* Entry: SCANPTR has string                                             03908000
* Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter               03908500
*       ERRNUM set appropriately                                        03909000
GENCMD   ENTER                                                 @SC86155 03909500
         LA    8,1           One operand                       @SC86295 03910000
         LTR   1,1                                             @SC86295 03910500
         BZ    REMCMD        Parse REMOTE command              @SC86295 03911000
         LA    0,AG          Packet type = generic command     @SC86155 03911500
GENNUL   SR    5,5           NO ARGUMENTS                      @SC86316 03912000
GENFILL  STC   0,STYPE       Set packet type                   @SC86155 03912500
         L     3,RBUF        Put string here                   @SC86155 03913000
         CLI   STYPE,AG      Generic?                          @SC86155 03913500
         BNE   GENOTH1       No subcommand                     @SC86155 03914000
         STC   1,0(3)        Save subcommand byte              @SC86155 03914500
         LA    3,1(3)        Move to next character position   @SC86155 03915000
         B     GENOTH1                                         @SC86295 03915500
GENNXT   NTOKN N=RTRN1       Get next argument                 @SC86295 03916000
         LA    5,1(7)        Length                            @SC86295 03916500
         LR    4,6           Address                           @SC86295 03917000
GENOTH1  LTR   1,5           Any argument?                     @SC86155 03917500
         BZ    GENFILZ       No, done                          @SC86155 03918000
         CLI   STYPE,AG      Generic?                          @SC86155 03918500
         BNE   GENOTH2       No, skip length indicator         @SC86155 03919000
         TOCHR 1,,0(3)       Yes, do it                        @SC86155 03919500
         LA    3,1(3)                                          @SC86155 03920000
GENOTH2  MVC   0(96,3),0(4)  Copy argument                     @SC86155 03920500
         LA    1,ETOA        Current E-to-A                    @SC91284 03921000
         CLC   =C'&TRANSPA',TRNALF                             @SC91284 03921500
         BNE   *+8                                             @SC91284 03922000
          LA   1,ETOAD       Use default if "transparent"      @SC91284 03922500
         TR    0(96,3),0(1)  in ASCII                          @SC91284 03923000
         AR    3,5           Advance ptr                       @SC86155 03923500
         BCT   8,GENNXT                                        @SC86295 03924000
GENFILZ  S     3,RBUF        Length of buffer                  @SC86155 03924500
         ST    3,RBUFL       Set buffer size                   @SC86155 03925000
         BAL   8,IPKSET      Set state table, exchange parms   @SC86155 03925500
         DC    AL1(AY),AL3(0)        ACK'ed     Must be just   @SC86155 03926000
         DC    XL1'FF',AL3(GENRET)   Stop       these 3        @SC88074 03926500
         DC    AL1(00),AL3(GENAB3)   Error      items.         @SC88074 03927000
         BAL   8,GENSET      Set state table                   @SC86155 03927500
* Server cmd Rpack interpret input table                       @SC86155 03928000
         DC    AL1(AY),AL3(0)        ACK'ed                    @SC86155 03928500
         DC    AL1(AS),AL3(GENRPL)   Long reply                @SC86155 03929000
         DC    AL1(AX),AL3(GENRPX)   Long reply already INIT   @SC88074 03929500
         DC    AL1(AF),AL3(GENRPX)   Long reply already INIT   @SC88074 03930000
         DC    XL1'FF',AL3(GENRET)   Stop                      @SC88074 03930500
         DC    AL1(00),AL3(GENAB3)   Error                     @SC88074 03931000
GENSET   BAL   9,ENCODEN     Encode command                    @SC86295 03931500
         BAL   9,INPUTSPK    Send, get response                @SC86295 03932000
         MVI   ERRNUM,ERRNOE No errors                         @SC86155 03932500
         ICM   0,15,DATL     Any short reply?                  @SC86155 03933000
         BZ    GENRET        No, done                          @SC86155 03933500
         NI    FL1,255-EOF   Yes, set flags                    @SC86155 03934000
         XC    WBUFL,WBUFL   Clear old data                    @SC86155 03934500
         OI    LOGFLGS,APPN  DISP=MOD                          @SC86295 03935000
         BAL   2,GENRPS      Set up file name                  @SC86295 03935500
         OPENF O,FILNAM,LOGFDB,FILPTR,E=GENABR                 @SC89013 03936000
         USING FDBD,1                                          @SC86295 03936500
         L     0,FABLRTR     Get effective record length       @SC88120 03937000
         ST    0,MAXOUT      Save for folding (if need be)     @SC88120 03937500
         ST    0,FSIZE       Copy LRECL                        @SC86295 03938000
         MVC   FRECF,FDBRCF  Copy RECFM                        @SC86295 03938500
         DROP  1                                               @SC86155 03939000
GENOPN   KCALL DECODE,E=GENAB2 Copy message to output          @SC86155 03939500
         ICM   1,15,WBUFL    Check length in buffer            @SC88120 03940000
         BE    GENRPZ                                          @SC86155 03940500
         KCALL OUTBUF,E=GENAB2  Yes, copy that as well         @SC86155 03941000
GENRPZ   CLOSF FILPTR                                          @SC86295 03941500
         MVI   ERRNUM,ERRNOE No errors                         @SC86155 03942000
         B     GENFIN                                          @SC86295 03942500
*                                                                       03943000
GENRPX   CLI   BCTR,A1       This works only with 1-byte check @SC92085 03943500
         BNE   GENAB3                                          @SC88074 03944000
GENRPL   DS    0H            Long reply                        @SC88074 03944500
         BAL   2,GENRPS      Set up file name                  @SC86295 03945000
         KCALL RECEIV                                          @SC86155 03945500
         B     GENFIN                                          @SC86155 03946000
*                                                                       03946500
GENRPS   LA    0,L'REPNAM    Name string length                @SC86295 03947000
         LA    1,REPNAM      and address                       @SC86295 03947500
         STM   0,1,SCANPTR                                     @SC86295 03948000
         LA    0,FFRCF                                         @SC86295 03948500
         KCALL FSPEC,FILNAM  Convert to filespec               @SC86295 03949000
         IC    9,FL3         Save flags                        @SC86295 03949500
         OI    FL3,APPN      Don't erase it                    @SC86295 03950000
         BR    2                                               @SC86295 03950500
*                                                                       03951000
GENAB2   CLOSF FILPTR                                          @SC86295 03951500
         B     GENABR                                          @SC88074 03952000
GENAB3   IC    9,FL3         Save flags                        @SC88074 03952500
GENABR   KCALL ERPACK                                          @SC86155 03953000
GENFIN   STC   9,FL3         Restore flags                     @SC86295 03953500
GENRET   KCALL INTINI,0                                        @SC86155 03954000
         B     RTRN0                                           @SC86295 03954500
*                                                                       03955000
* Make foreign Kermit execute command                                   03955500
REMCMD   NTOKN N=RTRN2                                         @SC86295 03956000
         SCAN  REMCMDKW,RTRN1                                  @SC86295 03956500
         B     RTRN2                                           @SC86295 03957000
*                                                                       03957500
REMCMDKW KW    '&AAACOPY',REMREN,K,MIN=2                       @SC91320 03958000
         KW    'CWD',REMARG,C,MIN=3                            @SC91320 03958500
         KW    '&AAAADIR',REMARG,D,MIN=3                       @SC91320 03959000
         KW    '&AAERASE',REMARG,E                             @SC91320 03959500
         KW    '&AAAHELP',REMARG,H                             @SC91320 03960000
         KW    '&AAAHOST',REMKRM,C,MIN=2                       @SC91320 03960500
         KW    'KERMIT',REMKRM,K                               @SC91320 03961000
         KW    '&AAAMAIL',REMPRT,M                             @SC91320 03961500
         KW    '&AAPRINT',REMPRT,P                             @SC91320 03962000
         KW    '&ARENAME',REMREN,R                             @SC91320 03962500
         KW    '&AASPACE',REMARG,U,MIN=2                       @SC91320 03963000
         KW    '&ASUBMIT',REMPRT,S,MIN=2                       @SC91320 03963500
         KW    '&AAATYPE',REMARG,T,MIN=2                       @SC91320 03964000
         KW    ,                                               @SC86155 03964500
*                                                                       03965000
REMKRM   SR    15,15                                           @SC91320 03965500
         IC    15,KWCODE(1)  Get one-letter code               @SC91320 03966000
         IC    15,ETOAD(15)  ASCIIify it                       @SC91320 03966500
         LR    0,15          Use it in generic command         @SC91320 03967000
REMPRS   FTOKN N=RTRN1       See if anything given             @SC86295 03967500
         LR    4,7                                             @SC86295 03968000
         LR    5,6           Use whole string                  @SC86295 03968500
         B     GENFILL                                         @SC86295 03969000
*                                                                       03969500
REMREN   LA    8,2           Copy or rename: two files         @SC91320 03970000
*                                                                       03970500
REMARG   SR    15,15                                           @SC91320 03971000
         IC    15,KWCODE(1)  Get one-letter code               @SC91320 03971500
         IC    15,ETOAD(15)  ASCIIify it                       @SC91320 03972000
         LR    1,15          Use it in generic command         @SC91320 03972500
REMPRSG  LA    0,AG          (generic)                         @SC86155 03973000
         NTOKN N=GENNUL      Skip any blanks                   @SC86295 03973500
         LA    5,1(7)        Save length                       @SC86295 03974000
         LR    4,6           Save ptr                          @SC86295 03974500
         B     GENFILL       Copy to output                    @SC86155 03975000
*                                                                       03975500
REMPRT   MVC   REMPNM,KWNAME(1) Copy command name from table   @SC90239 03976000
         MVC   REMPCD,KWCODE(1) Copy command code from table   @SC91320 03976500
         MVC   REMLEN,KWLEN(1) And length-1                    @SC90239 03977000
         LA    0,FFSND                                         @SC90239 03977500
         KCALL FSPEC,IFILE,E=REMPFIL Get filespec              @SC90239 03978000
         BAL   9,WSP         Skip to options, if any           @SC90239 03978500
          NOP  0                                               @SC90239 03979000
         XC    LEN,LEN       Now hide the options              @SC90239 03979500
         CH    6,=H'70'      Can we fit options into A-packet? @SC90239 03980000
         BH    REMPER        Doesn't look good                 @SC90239 03980500
         LTR   6,6                                             @SC90239 03981000
         BNM   *+6                                             @SC90239 03981500
          SR   6,6           Don't allow negative count        @SC90239 03982000
         TM    SCAPA,8       Attributes enabled                @SC90239 03982500
         BZ    REMPNO        No, can't do it                   @SC90239 03983000
         TM    ATFL2,ATFDSP  Disposition attribute enabled?    @SC90239 03983500
         BZ    REMPNO        Can't do it                       @SC90239 03984000
         LA    0,FFSND+FFRCF                                   @SC90239 03984500
         KCALL FSPEC,JFSPEC  Default foreign filespec          @SC90239 03985000
         ST    6,LEN         Restore length of options         @SC90239 03985500
         MVC   MSNDPTR,MSNDBUF No extra files                  @SC90239 03986000
         SR    1,1                                             @SC90239 03986500
         IC    1,REMPCD      Pass command code for attribute   @SC91320 03987000
         IC    1,ETOAD(1)    (use ASCII version)               @SC90239 03987500
         KCALL SEND                                            @SC90239 03988000
         B     RTRN0                                           @SC90239 03988500
*                                                                       03989000
REMPFIL  WTEXT (3),(4)                                         @SC90239 03989500
         B     RTRN1         Indicate kermit command error     @SC90239 03990000
REMPNO   WTEXT '&ATTRIBU &AZDISAB'                             @SC90239 03990500
         B     REMPCNT                                         @SC90239 03991000
REMPER   WTEXT '&MANYOPT'                                      @SC90239 03991500
REMPCNT  SR    14,14                                           @SC90239 03992000
         IC    14,REMLEN     Length-1 of command               @SC90239 03992500
         LA    0,L'REMMSG+1(,14)  Length of explanation        @SC90239 03993000
         MVC   REMMSG,=C'&CANNOT'                              @SC90239 03993500
         WTEXT REMMSG,(0)                                      @SC90239 03994000
         B     RTRN1         Indicate kermit command error     @SC90239 03994500
         LOCALS ,                                              @SC86295 03995000
REMLEN   DS    X             Length-1 of command name          @SC90239 03995500
REMMSG   DS    C'&CANNOT'                                      @SC90239 03996000
REMPNM   DS    CL6           MAIL, PRINT, or SUBMIT            @SC90239 03996500
REMPCD   DS    C             M, P, or S                        @SC91320 03997000
REMCMD   EXIT  ,                                               @SC86155 03997500
         TITLE 'TBLSET Routine - set up character set'         @SC90040 03998000
* Define new translation tables                                         03998500
* Entry: Names of table in TRNALF and FILALF, R1->tables                03999000
*        R0->item just changed, if any (else, 0)                        03999500
*        Tables should be a pair with ATOE first                        04000000
* Exit: R15=0 if ok, R15=1 if error ERRNUM unchanged.                   04000500
TBLSET   ENTER ,                                               @SC90040 04001000
         LR    9,1           Save ptr to pair of tables        @SC90040 04001500
         CLC   TRNALF,=CL(LALF)'&TRANSPA'                      @SC91325 04002000
         BE    TBLNUL        Special "set" - no translation    @SC90250 04002500
         LA    1,ATOE        Usual table to fill               @SC90040 04003000
         CR    1,9                                             @SC90040 04003500
         BNE   *+8           Special case, don't enable attr.  @SC90040 04004000
          OI   ATFL2,ATFENC  Now allow Encoding attribute      @SC90040 04004500
         LA    5,TRNTBL      Ptr to list                       @SC90040 04005000
         LA    6,LTRNTBL                                       @SC90040 04005500
         LA    7,TRNTBLZ     Ptr to end of list                @SC90040 04006000
         LA    1,TRNALF      Ptr to transfer set name          @SC90040 04006500
TBLLKP   CLC   0(2*LALF,5),0(1)  Compare both names            @SC91325 04007000
         BE    TBLFND        Got it!                           @SC90040 04007500
         BXLE  5,6,TBLLKP                                      @SC90040 04008000
         LTR   0,0           Which char set just changed?      @SC90040 04008500
         BNZ   TBLFIX        Patch other to make valid combo   @SC90040 04009000
TBLNFND  WTEXT '&UNDEFTR'                                      @SC90040 04009500
         B     RTRN1                                           @SC90040 04010000
*                                                                       04010500
TBLREP   MVC   TRNALF(2*LALF),0(5) Set up new table name       @SC91325 04011000
*  Enter here with R9->tables, R5->needed translation entry    @SC90040 04011500
TBLFND   MVC   CDESPTR,2*LALF+16(5) Save char-set designator   @SC91325 04012000
         LR    1,9           Fill in ATOE table first          @SC91325 04012500
         LM    6,7,2*LALF(5)                                   @SC91325 04013000
         LTR   6,6                                             @SC91325 04013500
         BM    TBLSPEC       Special translation type          @SC91325 04014000
         BAL   2,TBLCPY                                        @SC90040 04014500
         LA    1,256(,9)     Fill in ETOA table second         @SC90040 04015000
         LM    6,7,2*LALF+8(5)                                 @SC91325 04015500
         BAL   2,TBLCPY                                        @SC90040 04016000
         MVC   FILALF2,FILALF Actual set matches logical       @SC91325 04016500
         B     RTRN0                                           @SC90040 04017000
*                                                                       04017500
TBLSPEC  LR    8,7           R7->list of permitted char sets   @SC91325 04018000
TBLSPL1  CLC   FILALF2,0(8)  See if actual file char set is ok @SC91325 04018500
         BE    TBLSPFN       Yes, all done                     @SC91325 04019000
         LA    8,LALF(,8)    Not this one, keep checking       @SC91325 04019500
         CLI   0(8),0        End of list?                      @SC91325 04020000
         BNE   TBLSPL1       No, keep looking                  @SC91325 04020500
         MVC   FILALF,0(7)   Yes, switch to 1st in list        @SC91325 04021000
         LA    0,FILALF      Indicate the file set is changed  @SC91325 04021500
         KCALL TBLSET        Fill in tables (R1->ATOE already) @SC91325 04022000
         MVC   TRNALF(2*LALF),0(5) Restore logical char sets   @SC91325 04022500
         MVC   CDESPTR,2*LALF+16(5) Resave char-set designator @SC91325 04023000
TBLSPFN  DS    0H                                              @SC91325 04023500
         B     RTRN0                                           @SC91325 04024000
*                                                                       04024500
TBLFIX   LA    5,TRNTBL      Ptr to list again                 @SC90040 04025000
         CR    0,1           Giving precedence to transfer set?@SC90040 04025500
         BNE   TBLLKF        No, insist on file set            @SC90040 04026000
TBLLKT   CLC   0(LALF,5),0(1) Compare just transfer set        @SC91325 04026500
         BE    TBLREP        First such entry selects file set @SC90040 04027000
         BXLE  5,6,TBLLKT                                      @SC90040 04027500
TBLLKF   CLC   LALF(LALF,5),LALF(1) Compare just file set      @SC91325 04028000
         BNE   TBLLKFZ       Keep looking                      @SC90040 04028500
         ICM   0,15,LTRNTBL-4(5)   Any preferred transfer set? @SC90040 04029000
         BM    TBLREP        Yes, this very one                @SC90040 04029500
TBLLKFZ  BXLE  5,6,TBLLKF                                      @SC90040 04030000
         B     TBLNFND       Something bizarre happened        @SC90040 04030500
*                                                                       04031000
* Make both tables null translators: at R9 and R9 + 256        @SC90250 04031500
TBLNUL   NI    ATFL2,255-ATFENC  Suppress Encoding attribute   @SC90250 04032000
         LA    7,255                                           @SC90250 04032500
         STC   7,0(7,9)      Fill with self mapping            @SC90250 04033000
         BCT   7,*-4                                           @SC90250 04033500
         MVI   0(9),0        Also map NULL to NULL             @SC90250 04034000
         MVC   256(256,9),0(9) and copy to 2nd table           @SC90250 04034500
         B     RTRN0                                           @SC90250 04035000
*                                                                       04035500
* Entry: R6->Designator string, R7=length                      @SC90040 04036000
* Exit:  Correct table set up and R15=0 if ok, else 1          @SC90040 04036500
TBLATT   ENTER ALT                                             @SC90040 04037000
         LA    1,TBLDS       Start of designator list          @SC90040 04037500
         SR    3,3                                             @SC90040 04038000
TBLALP   ICM   3,1,4(1)      Get length of next item in list   @SC90040 04038500
         BZ    RTRN1         End.  String not found            @SC90040 04039000
         CR    3,7           Right length?                     @SC90040 04039500
         BNE   TBLALQ        No, keep looking                  @SC90040 04040000
         LR    4,3           Get length for EX                 @SC90040 04040500
         BCTR  4,0                                             @SC90040 04041000
         EX    4,TBLACLC     Strings match?                    @SC90040 04041500
         BNE   TBLALQ        No, keep looking                  @SC90040 04042000
         ICM   5,15,0(1)     Yes, get table pointer            @SC90040 04042500
         LR    6,5           Set to scan through tables        @SC90040 04043000
TBLAFLP  CLC   0(LALF,6),0(5) See if still same transfer set   @SC91325 04043500
         BNE   TBLAFND       No, use default ???               @SC90040 04044000
         CLC   FILALF,LALF(6) See if found right local set     @SC91325 04044500
         BE    TBLAFNO       Yes, use this table               @SC90040 04045000
         LA    6,LTRNTBL(,6) No, try next                      @SC90040 04045500
         B     TBLAFLP                                         @SC90040 04046000
TBLAFNO  LR    5,6                                             @SC90040 04046500
TBLAFND  CLC   TRNALF(2*LALF),0(5) Already have this table?    @SC91325 04047000
         BE    RTRN0         Yes, all done                     @SC90040 04047500
         MVC   TRNALF(2*LALF),0(5) Set up new table name       @SC91325 04048000
         LA    9,ATOE        Set ptr to working tables         @SC90040 04048500
         B     TBLFND        Adopt table                       @SC90040 04049000
TBLALQ   LA    1,5(3,1)                                        @SC90040 04049500
         B     TBLALP                                          @SC90040 04050000
TBLACLC  CLC   0(,6),5(1)    Compare against list item         @SC90040 04050500
*                                                                       04051000
* Copy info into table: basic stuff + any "corrections"        @SC90040 04051500
*  R1->table, R6->basic stuff, R7->corrections, if any         @SC90040 04052000
*  R9->ATOE table                                              @SC90250 04052500
TBLCPY   LTR   6,6                                             @SC90040 04053000
         BZ    TBLCPI        No EtoA table - just invert AtoE  @SC90040 04053500
         MVC   0(256,1),0(6) Basic pattern                     @SC90040 04054000
         LTR   7,7           Ptr to modification list          @SC90040 04054500
         BZR   2             No list                           @SC90040 04055000
         SR    6,6                                             @SC90040 04055500
TBLCPL   ICM   6,1,0(7)      Get offset into table             @SC90040 04056000
         BZR   2             End of list                       @SC90040 04056500
         IC    0,1(,7)       Get changed value                 @SC90040 04057000
         STC   0,0(6,1)                                        @SC90040 04057500
         LA    7,2(,7)                                         @SC90040 04058000
         B     TBLCPL                                          @SC90040 04058500
TBLCPI   SR    7,7           Clear work regs.                  @SC90040 04059000
         XC    0(256,1),0(1) Clear out table                   @SC90040 04059500
         LA    7,255                                           @SC90040 04060000
TBLCPIL  IC    6,0(7,9)      Get EBCDIC for (7)                @SC90250 04060500
         STC   7,0(6,1)      And store inverse                 @SC90040 04061000
         BCT   7,TBLCPIL     Do all but NULL                   @SC90040 04061500
         IC    6,0(7,9)      Get EBCDIC for NULL               @SC90250 04062000
         STC   7,0(6,1)      And store inverse                 @SC90250 04062500
         BR    2                                               @SC90040 04063000
*                                                                       04063500
* Format is: CL(LALF)'transfer',CL(LALF)'local'                @SC91325 04064000
*            A(t-to-l,adjusts,l-to-t,adjusts,designator,flag)  @SC90040 04064500
*                     if any   or 0  if any                    @SC90040 04065000
*  Items should be grouped by transfer set, default 1st        @SC90040 04065500
*  Flag is -1 in exactly one entry for each possible file set, @SC90040 04066000
*  but flag is 0 for any others.  "-1" marks preferred entry.  @SC90040 04066500
TRNTBL   DS    0F            Table of translations             @SC90040 04067000
         DC    CL(LALF)'ASCII',CL(LALF)'EBCDIC' *** Default ***@SC91325 04067500
         DC    A(ATOED,0,ETOAD,0,0,0)                          @SC90040 04068000
LTRNTBL  EQU   *-TRNTBL      Item length                       @SC91325 04068500
         DC    CL(LALF)'ASCII',CL(LALF)'CP037'                 @SC91325 04069000
         DC    A(ATOED,ASE37F,ETOAD,0,0,0)                     @SC90040 04069500
         DC    CL(LALF)'ASCII',CL(LALF)'CP500'                 @SC91325 04070000
         DC    A(ATOED,ASE5F,ETOAD,0,0,0)                      @SC90040 04070500
         DC    CL(LALF)'ASCII',CL(LALF)'DKOI'                  @SC91325 04071000
         DC    A(CYTODKOI,ASDKF,DKOITOAS,0,0,0)                @SC90040 04071500
         DC    CL(LALF)'ASCII',CL(LALF)'CP880'                 @SC91325 04072000
         DC    A(CYTODKOI,ASDKF,DKOITOAS,E880ASF,0,0)          @SC90271 04072500
TRNTNCY  DC    CL(LALF)'&CYRILLC',CL(LALF)'DKOI' USSR          @SC91325 04073000
         DC    A(CYTODKOI,0,0,0,TBLDSCY,-1)                    @SC90040 04073500
         DC    CL(LALF)'&CYRILLC',CL(LALF)'CP880' USSR         @SC91325 04074000
         DC    A(CYTODKOI,CYE880F,0,0,TBLDSCY,-1)              @SC90152 04074500
TRNTNAR  DC    CL(LALF)'ARABIC',CL(LALF)'CP420'  Arabic        @SC93027 04075000
         DC    A(ARTOE420,0,0,0,TBLDSAR,-1)                    @SC93027 04075500
TRNTNL1  DC    CL(LALF)'LATIN1',CL(LALF)'EBCDIC'  Default L1   @SC91325 04076000
         DC    A(L1TOE,0,0,0,TBLDSL1,-1)                       @SC90040 04076500
TRNTNCA  DC    CL(LALF)'LATIN1',CL(LALF)'CP037' US, etc        @SC91325 04077000
         DC    A(L1TOE,L1E37F,0,0,TBLDSL1,-1)                  @SC90040 04077500
TRNTNDE  DC    CL(LALF)'LATIN1',CL(LALF)'CP273' Germany        @SC91325 04078000
         DC    A(L1TOE,L1E273F,0,0,TBLDSL1,-1)                 @SC90040 04078500
TRNTNBR  DC    CL(LALF)'LATIN1',CL(LALF)'CP275' Brazil         @SC91325 04079000
         DC    A(L1TOE,L1E275F,0,0,TBLDSL1,-1)                 @SC90040 04079500
TRNTNDK  DC    CL(LALF)'LATIN1',CL(LALF)'CP277' Denmark, Norway@SC91325 04080000
         DC    A(L1TOE,L1E277F,0,0,TBLDSL1,-1)                 @SC90040 04080500
TRNTNSE  DC    CL(LALF)'LATIN1',CL(LALF)'CP278' Finland, Sweden@SC91325 04081000
         DC    A(L1TOE,L1E278F,0,0,TBLDSL1,-1)                 @SC90040 04081500
TRNTNIT  DC    CL(LALF)'LATIN1',CL(LALF)'CP280' Italy          @SC91325 04082000
         DC    A(L1TOE,L1E280F,0,0,TBLDSL1,-1)                 @SC90040 04082500
TRNTNJR  DC    CL(LALF)'LATIN1',CL(LALF)'CP281' Japan          @SC91325 04083000
         DC    A(L1TOE,L1E281F,0,0,TBLDSL1,-1)                 @SC91325 04083500
TRNTNPT  DC    CL(LALF)'LATIN1',CL(LALF)'CP282' Portugal       @SC91325 04084000
         DC    A(L1TOE,L1E282F,0,0,TBLDSL1,-1)                 @SC90040 04084500
TRNTNES  DC    CL(LALF)'LATIN1',CL(LALF)'CP284' Spain          @SC91325 04085000
         DC    A(L1TOE,L1E284F,0,0,TBLDSL1,-1)                 @SC90040 04085500
TRNTNUK  DC    CL(LALF)'LATIN1',CL(LALF)'CP285' UK             @SC91325 04086000
         DC    A(L1TOE,L1E285F,0,0,TBLDSL1,-1)                 @SC90040 04086500
TRNTNFR  DC    CL(LALF)'LATIN1',CL(LALF)'CP297' France         @SC91325 04087000
         DC    A(L1TOE,L1E297F,0,0,TBLDSL1,-1)                 @SC90040 04087500
TRNTNBE  DC    CL(LALF)'LATIN1',CL(LALF)'CP500' Belgium, etc   @SC91325 04088000
         DC    A(L1TOE,L1E5F,0,0,TBLDSL1,-1)                   @SC90040 04088500
TRNTNIS  DC    CL(LALF)'LATIN1',CL(LALF)'CP871' Iceland        @SC91325 04089000
         DC    A(L1TOE,L1E871F,0,0,TBLDSL1,-1)                 @SC90040 04089500
TRNTNL2  DC    CL(LALF)'LATIN2',CL(LALF)'CP870' Yugoslavia     @SC91325 04090000
         DC    A(L2TOE870,0,0,0,TBLDSL2,-1)                    @SC90152 04090500
TRNTNCZ  DC    CL(LALF)'LATIN2',CL(LALF)'&CZECH' Czechoslovakia@SC91325 04091000
         DC    A(L2TOE870,L2ECZF,0,0,TBLDSL2,-1)               @SC90152 04091500
TRNTNL3  DC    CL(LALF)'LATIN3',CL(LALF)'CP905' Turkey         @SC91325 04092000
         DC    A(L3TOE905,0,0,0,TBLDSL3,-1)                    @SC90152 04092500
TRNTNGR  DC    CL(LALF)'&AAGREEK',CL(LALF)'CP875'  Greece      @SC91325 04093000
         DC    A(GRTOE875,0,0,0,TBLDSGR,-1)                    @SC90040 04093500
TRNTNIL  DC    CL(LALF)'&HEBREW',CL(LALF)'CP424' Israel        @SC91325 04094000
         DC    A(L8TOE424,0,0,0,TBLDSHE,-1)                    @SC90040 04094500
TRNTNTH  DC    CL(LALF)'THAI',CL(LALF)'CP838'   Thailand       @SC92233 04095000
         DC    A(THTOE838,0,0,0,TBLDSTH,-1)                    @SC92233 04095500
TRNTNKN  DC    CL(LALF)'&JAPNEUC',CL(LALF)'&KNJDEF.-KANJI'     @SC91325 04096000
         DC    A(-1,TBVJP&KNJLAB,0,0,TBLDSKN,-1)               @SC91325 04096500
         AIF   ('&KNJLAB' EQ 'F').TRNTHIT                      @SC91325 04097000
         DC    CL(LALF)'&JAPNEUC',CL(LALF)'FUJITSU-KANJI'      @SC91325 04097500
         DC    A(-1,TBVJPF,0,0,TBLDSKN,-1)                     @SC91325 04098000
.TRNTHIT AIF   ('&KNJLAB' EQ 'H').TRNTIBM                      @SC91325 04098500
         DC    CL(LALF)'&JAPNEUC',CL(LALF)'HITACHI-KANJI'      @SC91325 04099000
         DC    A(-1,TBVJPH,0,0,TBLDSKN,-1)                     @SC91325 04099500
.TRNTIBM AIF   ('&KNJLAB' EQ 'I').TRNTKZ                       @SC91325 04100000
         DC    CL(LALF)'&JAPNEUC',CL(LALF)'IBM-KANJI'          @SC91325 04100500
         DC    A(-1,TBVJPI,0,0,TBLDSKN,-1)                     @SC91325 04101000
.TRNTKZ  ANOP                                                  @SC91325 04101500
TRNTNJP  EQU   *                                               @SC91325 04102000
         AIF   ('&KNJLAB' EQ 'H').TRNTK1H                      @SC91325 04102500
         DC    CL(LALF)'KATAKANA',CL(LALF)'CP290' Japan        @SC91325 04103000
         DC    A(KATOE290,0,0,0,TBLDSKA,-1)                    @SC91325 04103500
.TRNTK1H DC    CL(LALF)'KATAKANA',CL(LALF)'H-EBCDIK-DASH' Japan@SC91325 04104000
         DC    A(KATOHEBK,0,0,0,TBLDSKA,-1)                    @SC91325 04104500
         AIF   ('&KNJLAB' NE 'H').TRNTK2H                      @SC91325 04105000
         DC    CL(LALF)'KATAKANA',CL(LALF)'CP290' Japan        @SC91325 04105500
         DC    A(KATOE290,0,0,0,TBLDSKA,-1)                    @SC91325 04106000
.TRNTK2H ANOP                                                  @SC91325 04106500
TRNTBLZ  EQU   *-LTRNTBL                                       @SC91325 04107000
*                                                                       04107500
*  List of transfer character set designators                  @SC90040 04108000
TBLDS    EQU   *                                               @SC90040 04108500
TBLDSAR  DC    AL4(TRNTNAR),AL1(6,AI,A6,ASL,A1,A2,A7) I6/127   @SC93027 04109000
TBLDSCY  DC    AL4(TRNTNCY),AL1(6,AI,A6,ASL,A1,A4,A4) I6/144   @SC90040 04109500
TBLDSGR  DC    AL4(TRNTNGR),AL1(6,AI,A6,ASL,A1,A2,A6) I6/126   @SC90040 04110000
TBLDSHE  DC    AL4(TRNTNIL),AL1(6,AI,A6,ASL,A1,A3,A8) I6/138   @SC90040 04110500
TBLDSKA  DC    AL4(TRNTNJP),AL1(6,AI,A1,A4,ASL,A1,A3) I14/13   @SC90040 04111000
TBLDSKN  DC    AL4(TRNTNKN),AL1(9,AI,A1,A4,ASL,A8,A7,ASL,A1,A3) SC91325 04111500
         DC    AL4(TRNTNKN),AL1(7,AI,A1,A4,ASL,A8,A7,AE) I14/87E *TEMP* 04112000
TBLDSL1  DC    AL4(TRNTNL1),AL1(6,AI,A6,ASL,A1,A0,A0) I6/100   @SC90040 04112500
         DC    AL4(TRNTNL1),AL1(6,AI,A2,ASL,A1,A0,A0) **TEMP** @SC90040 04113000
TBLDSL2  DC    AL4(TRNTNL2),AL1(6,AI,A6,ASL,A1,A0,A1) I6/101   @SC90152 04113500
TBLDSL3  DC    AL4(TRNTNL3),AL1(6,AI,A6,ASL,A1,A0,A9) I6/109   @SC90152 04114000
TBLDSTH  DC    AL4(TRNTNTH),AL1(6,AI,A6,ASL,A1,A6,A6) I6/166   @SC92233 04114500
         DC    XL5'0'        End of table                      @SC90040 04115000
*                                                                       04115500
* Lists of file char-sets to go with complex translations      @SC91325 04116000
TBVJPH   DC    CL(LALF)'H-EBCDIK-DASH'                         @SC91325 04116500
TBVJPF   EQU   *                                               @SC91325 04117000
TBVJPI   EQU   *                                               @SC91325 04117500
TBVJP    DC    CL(LALF)'CP290',CL(LALF)'CP500',CL(LALF)'CP281' @SC91325 04118000
         DC    CL(LALF)'H-EBCDIK-DASH'                         @SC91325 04118500
         DC    X'00'                                           @SC91325 04119000
         LOCALS ,                                              @SC90040 04119500
TBLSET   EXIT  ,                                               @SC90040 04120000
TRNTBLD  CSECT                                                 @SC90040 04120500
*                                                                       04121000
*          Corrections:  ASCII      ->   DKOI                  @SC90040 04121500
*          ref: Konstantin Vinogradov (ICSTI)                  @SC90040 04122000
ASDKF    HTBL  60B8,61B9,62BA,63BB,64BC,65BD                   @SC90271 04122500
         DC    X'66BE',X'67BF',X'68CA',X'69CB',X'6ACC',X'6BCD' @SC90040 04123000
         DC    X'6CCE',X'6DCF',X'6EDA',X'6FDB',X'70DC',X'71DD' @SC90040 04123500
         DC    X'72DE',X'73DF',X'74EA',X'75EB',X'76EC',X'77ED' @SC90040 04124000
         DC    X'78EE',X'79EF',X'7AFA',X'7BFB',X'7CFC',X'7DFD' @SC90040 04124500
         HTBL  7EFE,00                                         @SC90271 04125000
*                                                                       04125500
*          Corrections:  LATIN1     ->   CP 037                @SC90040 04126000
*          ref: Andre Pirard (U Liege)                         @SC90040 04126500
L1E37F   DC    X'AC5F',X'DDAD',X'A8BD'                         @SC90040 04127000
ASE37F   DC    X'5BBA',X'5DBB',X'5EB0',X'0'                    @SC90040 04127500
*                                                                       04128000
*          Corrections:  LATIN1     ->   CP 273                @SC90040 04128500
*          ref: Andre Pirard (U Liege)                         @SC90040 04129000
L1E273F  DC    X'214F',X'40B5',X'5B63',X'5CEC',X'5DFC',X'7B43' @SC90040 04129500
         DC    X'7CBB',X'7DDC',X'7E59',X'A2B0',X'A6CC',X'A77C' @SC90040 04130000
         DC    X'A8BD',X'ACBA',X'C44A',X'D6E0',X'DC5A',X'DDAD' @SC90040 04130500
         DC    X'DFA1',X'E4C0',X'F66A',X'FCD0',X'0'            @SC90040 04131000
*                                                                       04131500
*          Corrections:  LATIN1     ->   CP 275                @SC90040 04132000
*          ref: About Type (IBM S544-3516-02)                  @SC90040 04132500
L1E275F  DC    X'214F',X'23EF',X'245A',X'4066',X'5B71',X'5D68' @SC90040 04133000
         DC    X'6046',X'7BCF',X'7CBB',X'7D51',X'A2B0',X'A648' @SC90040 04133500
         DC    X'A8BD',X'ACBA',X'C37B',X'C75B',X'C94A',X'D57C' @SC90040 04134000
         DC    X'DDAD',X'E379',X'E76A',X'E9D0',X'F5C0',X'0'    @SC90040 04134500
*                                                                       04135000
*          Corrections:  LATIN1     ->   CP 277                @SC90040 04135500
*          ref: Andre Pirard (U Liege)                         @SC90040 04136000
L1E277F  DC    X'214F',X'234A',X'2467',X'4080',X'5B9E',X'5D9F' @SC90040 04136500
         DC    X'7B9C',X'7CBB',X'7D47',X'7EDC',X'A2B0',X'A45A' @SC90040 04137000
         DC    X'A670',X'A8BD',X'ACBA',X'C55B',X'C67B',X'D87C' @SC90040 04137500
         DC    X'DDAD',X'E5D0',X'E6C0',X'F86A',X'FCA1',X'0'    @SC90040 04138000
*                                                                       04138500
*          Corrections:  LATIN1     ->   CP 278                @SC90040 04139000
*          ref: Andre Pirard (U Liege)                         @SC90040 04139500
L1E278F  DC    X'214F',X'2363',X'2467',X'40EC',X'5BB5',X'5C71' @SC90040 04140000
         DC    X'5D9F',X'6051',X'7B43',X'7CBB',X'7D47',X'7EDC' @SC90040 04140500
         DC    X'A2B0',X'A45A',X'A6CC',X'A74A',X'A8BD',X'ACBA' @SC90040 04141000
         DC    X'C47B',X'C55B',X'C9E0',X'D67C',X'DDAD',X'E4C0' @SC90040 04141500
         DC    X'E5D0',X'E979',X'F66A',X'FCA1',X'0'            @SC90040 04142000
*                                                                       04142500
*          Corrections:  LATIN1     ->   CP 280                @SC90040 04143000
*          ref: Andre Pirard (U Liege)                         @SC90040 04143500
L1E280F  DC    X'214F',X'23B1',X'40B5',X'5B90',X'5C48',X'5D51' @SC90040 04144000
         DC    X'60DD',X'7B44',X'7CBB',X'7D54',X'7E58',X'A2B0' @SC90040 04144500
         DC    X'A37B',X'A6CD',X'A77C',X'A8BD',X'ACBA',X'B04A' @SC90040 04145000
         DC    X'DDAD',X'E0C0',X'E7E0',X'E8D0',X'E95A',X'ECA1' @SC90040 04145500
         DC    X'F26A',X'F979',X'0'                            @SC90040 04146000
*                                                                       04146500
*          Corrections:  LATIN1     ->   CP 281                @SC91325 04147000
*          ref: IBM C-H 3-220-050 (1989)                       @SC91325 04147500
L1E281F  HTBL  24E0,5BB1,5CB2,5DBB,5EBA,7EBC,A2B0,A34A,A55B    @SC91325 04148000
         HTBL  A8BD,AC5F,AFA1,DDAD,00                          @SC91325 04148500
*                                                                       04149000
*          Corrections:  LATIN1     ->   CP 282                @SC90040 04149500
*          ref: About Type (IBM S544-3516-02)                  @SC90040 04150000
L1E282F  DC    X'214F',X'2366',X'40EF',X'5B4A',X'5C68',X'5D5A' @SC90040 04150500
         DC    X'7B46',X'7CBB',X'7DBE',X'7E48',X'A2B0',X'A6CF' @SC90040 04151000
         DC    X'A8BD',X'ACBA',X'B4D0',X'C37B',X'C7E0',X'D57C' @SC90040 04151500
         DC    X'DDAD',X'E3C0',X'E7A1',X'F56A',X'0'            @SC90040 04152000
*                                                                       04152500
*          Corrections:  LATIN1     ->   CP 284                @SC90040 04153000
*          ref: Andre Pirard (U Liege)                         @SC90040 04153500
L1E284F  DC    X'21BB',X'2369',X'5B4A',X'5D5A',X'5EBA',X'7EBD' @SC90040 04154000
         DC    X'A2B0',X'A649',X'A8A1',X'AC5F',X'D17B',X'DDAD' @SC90040 04154500
         DC    X'F16A',X'0'                                    @SC90040 04155000
*                                                                       04155500
*          Corrections:  LATIN1     ->   CP 285                @SC90040 04156000
*          ref: Andre Pirard (U Liege)                         @SC90040 04156500
L1E285F  DC    X'244A',X'5BB1',X'5DBB',X'5EBA',X'7EBC',X'A2B0' @SC90040 04157000
         DC    X'A35B',X'A8BD',X'AC5F',X'AFA1',X'DDAD',X'0'    @SC90040 04157500
*                                                                       04158000
*          Corrections:  LATIN1     ->   CP 297                @SC90040 04158500
*          ref: Andre Pirard (U Liege)                         @SC90040 04159000
L1E297F  DC    X'214F',X'23B1',X'4044',X'5B90',X'5C48',X'5DB5' @SC90040 04159500
         DC    X'60A0',X'7B51',X'7CBB',X'7D54',X'7EBD',X'A2B0' @SC90040 04160000
         DC    X'A37B',X'A6DD',X'A75A',X'A8A1',X'ACBA',X'B04A' @SC90040 04160500
         DC    X'B579',X'DDAD',X'E07C',X'E7E0',X'E8D0',X'E9C0' @SC90040 04161000
         DC    X'F96A',X'0'                                    @SC90040 04161500
*                                                                       04162000
*          Corrections:  LATIN1     ->   CP 500                @SC90040 04162500
*          ref: Andre Pirard (U Liege)                         @SC90040 04163000
L1E5F    DC    X'A2B0',X'A8BD',X'ACBA',X'DDAD'                 @SC90040 04163500
ASE5F    DC    X'214F',X'5B4A',X'5D5A',X'7CBB',X'0'            @SC90040 04164000
*                                                                       04164500
*          Corrections:  LATIN1     ->   CP 871                @SC90040 04165000
*          ref: About Type (IBM S544-3516-02)                  @SC90040 04165500
L1E871F  DC    X'214F',X'40AC',X'5BAE',X'5CBE',X'5D9E',X'5EEC' @SC90040 04166000
         DC    X'608C',X'7B8E',X'7CBB',X'7D9C',X'7ECC',X'A2B0' @SC90040 04166500
         DC    X'A8BD',X'ACBA',X'B4E0',X'C65A',X'D07C',X'D65F' @SC90040 04167000
         DC    X'DDAD',X'DE4A',X'E6D0',X'F079',X'F6A1',X'FEC0' @SC90040 04167500
         DC    X'0'                                            @SC90040 04168000
*                                                                       04168500
*          Corrections:  CYRILLIC   ->   CP 880                @SC90152 04169000
*          ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04169500
CYE880F  HTBL  A163,A259,A362,A464,A565,A666,A767,A868,A969    @SC90152 04170000
         HTBL  AA70,AB71,AC72,AD73,AE74,AF75,CA57,F144,F242    @SC90152 04170500
         HTBL  F343,F445,F546,F647,F748,F849,F951,FA52,FB53    @SC90152 04171000
         HTBL  FC54,FD55,FEFF,FF56,00                          @SC90152 04171500
*                                                                       04172000
*          Corrections:  LATIN2     ->   CZECH                 @SC90152 04172500
*          ref: Konstantin Vinogradov (ICSTI)                  @SC90152 04173000
L2ECZF   HTBL  A178,A243,A465,A5CE,A671,A8B8,A9DF,AA75,ABEA    @SC90152 04173500
         HTBL  ACAE,ADEE,AEFA,B054,B167,B263,B355,B4EC,B59B    @SC90152 04174000
         HTBL  B645,B858,B9AB,BA51,BBAC,BEB2,BF8D,C0BE,C1B9    @SC90152 04174500
         HTBL  C4DD,C5CD,C8BB,C9ED,CCBD,CDCB,CFBC,D074,D1B6    @SC90152 04175000
         HTBL  D2DA,D3DB,D4DC,D5FE,D6CF,D8DE,D9CC,DAEB,DCCA    @SC90152 04175500
         HTBL  DDEF,E08C,E177,E4A0,E59A,E880,E9AF,EC8B,ED8F    @SC90152 04176000
         HTBL  EF8A,F047,F157,F29D,F39E,F49F,F5FC,F69C,F8AA    @SC90152 04176500
         HTBL  F990,FAAD,FBFD,FC8E,FDB1,00                     @SC90152 04177000
*                                                                       04177500
L1TOE    EQU   *             LATIN1 to EBCDIC                  @SC90040 04178000
*          ref: composite                                      @SC90040 04178500
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04179000
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04179500
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04180000
         HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04180500
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04181000
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04181500
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D 5 C90040 04182000
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04182500
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04183000
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04183500
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04184000
         HTBL  41,AA,4A,B1,9F,B2,6A,B5,BB,B4,9A,8A,B0,CA,AF,BC A C90040 04184500
         HTBL  90,8F,EA,FA,BE,A0,B6,B3,9D,DA,9B,8B,B7,B8,B9,AB B C90040 04185000
         HTBL  64,65,62,66,63,67,9E,68,74,71,72,73,78,75,76,77 C C90040 04185500
         HTBL  AC,69,ED,EE,EB,EF,EC,BF,80,FD,FE,FB,FC,BA,AE,59 D C90040 04186000
         HTBL  44,45,42,46,43,47,9C,48,54,51,52,53,58,55,56,57 E C90040 04186500
         HTBL  8C,49,CD,CE,CB,CF,CC,E1,70,DD,DE,DB,DC,8D,8E,DF F C90040 04187000
*                                                                       04187500
ARTOE420 EQU   *             Arabic ISO (+CP864) to CP420      @SC93027 04188000
*          ref: IBM code page registry                         @SC93027 04188500
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC93027 04189000
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C93027 04189500
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C93027 04190000
         HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C93027 04190500
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C93027 04191000
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C93027 04191500
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,53,54,B6,B7,6D 5 C93027 04192000
         HTBL  CC,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C93027 04192500
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,CE,4F,E1,EC,07 7 C93027 04193000
         HTBL  09,0A,14,1B,2C,20,21,2A,28,29,06,17,24,15,22,23 8 C93027 04193500
         HTBL  30,31,1A,33,34,35,36,08,38,B4,B5,3B,04,B8,B9,45 9 C93027 04194000
         HTBL  41,68,48,FA,FF,51,2B,39,57,59,63,65,79,CA,69,71 A C93027 04194500
         HTBL  DF,EA,EB,ED,EE,EF,FB,FC,FD,FE,AB,C0,77,80,8B,D0 B C93027 04195000
         HTBL  4A,46,47,49,52,9B,55,56,58,62,64,66,67,70,72,73 C C93027 04195500
         HTBL  74,75,76,78,8A,8C,8E,8F,90,9C,A0,6A,5F,A1,E0,9A D C93027 04196000
         HTBL  44,AC,AE,B0,BA,BC,BE,CB,CF,DA,DE,8D,9D,9F,9E,BB E C93027 04196500
         HTBL  43,42,BD,BF,CD,DB,DD,AA,AD,B2,B3,B1,AF,DC,3E,3A F C93027 04197000
*                                                                       04197500
DKOITOAS EQU   *             DKOI (EBCDIC) to ASCII            @SC90040 04198000
*          ref: Konstantin Vinogradov (ICSTI)                  @SC90040 04198500
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04199000
         HTBL  00,01,02,03,1C,09,06,7F,17,0D,0E,0B,0C,0D,0E,0F 0 C90271 04199500
         HTBL  10,11,12,13,1D,05,08,07,18,19,12,0F,1C,1D,1E,1F 1 C90271 04200000
         HTBL  00,01,02,03,04,0A,17,1B,08,09,0A,0B,0C,05,06,07 2 C90271 04200500
         HTBL  10,11,16,13,14,15,16,04,18,19,1A,1B,14,15,1E,1A 3 C90271 04201000
         HTBL  20,20,65,00,00,00,53,49,49,4A,5B,2E,3C,28,2B,21 4 C90271 04201500
         HTBL  26,00,00,00,6B,2D,75,00,00,65,5D,24,2A,29,3B,5E 5 C90271 04202000
         HTBL  2D,2F,00,00,00,53,49,49,4A,00,5C,2C,25,5F,3E,3F 6 C90271 04202500
         HTBL  00,00,6B,00,75,27,60,61,62,40,3A,23,40,27,3D,22 7 C90271 04203000
         HTBL  63,41,42,43,44,45,46,47,48,49,64,65,66,67,68,69 8 C90040 04203500
         HTBL  6A,4A,4B,4C,4D,4E,4F,50,51,52,6B,6C,6D,6E,6F,70 9 C90040 04204000
         HTBL  71,5E,53,54,55,56,57,58,59,5A,72,73,74,75,76,77 A C90271 04204500
         HTBL  78,79,7A,7B,7C,7D,7E,27,60,61,62,63,64,65,66,67 B C90040 04205000
         HTBL  5B,41,42,43,44,45,46,47,48,49,68,69,6A,6B,6C,6D C C90271 04205500
         HTBL  5D,4A,4B,4C,4D,4E,4F,50,51,52,6E,6F,70,71,72,73 D C90271 04206000
         HTBL  5C,1F,53,54,55,56,57,58,59,5A,74,75,76,77,78,79 E C90271 04206500
         HTBL  30,31,32,33,34,35,36,37,38,39,7A,7B,7C,7D,7E,00 F C90040 04207000
*                                                                       04207500
* Corrections for CP880 -> ASCII                               @SC90271 04208000
E880ASF  HTBL  4200,4465,5500,5600,5727,5900,6365,732D,7500    @SC90271 04208500
         HTBL  FF75,00                                         @SC90271 04209000
*                                                                       04209500
CYTODKOI EQU   *             CYRILLIC to DKOI (EBCDIC)         @SC90040 04210000
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04210500
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04211000
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04211500
         HTBL  40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04212000
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04212500
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04213000
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04213500
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04214000
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04214500
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04215000
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,E1 9 C90040 04215500
         HTBL  41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 A C90040 04216000
         HTBL  B9,BA,ED,BF,BC,BD,EC,FA,CB,CC,CD,CE,CF,DA,DB,DC B C90040 04216500
         HTBL  DE,DF,EA,EB,BE,CA,BB,FE,FB,FD,75,EF,EE,FC,B8,DD C C90040 04217000
         HTBL  77,78,AF,8D,8A,8B,AE,B2,8F,90,9A,9B,9C,9D,9E,9F D C90040 04217500
         HTBL  AA,AB,AC,AD,8C,8E,80,B6,B3,B5,B7,B1,B0,B4,76,A0 E C90040 04218000
         HTBL  58,59,62,63,64,65,66,67,68,69,70,71,72,73,74,FF F C90040 04218500
*                                                                       04219000
GRTOE875 EQU   *             Latin/Greek to Greece EBCDIC      @SC90040 04219500
*          ref: Michel Suignard                                @SC90040 04220000
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04220500
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04221000
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04221500
         HTBL  40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04222000
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04222500
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04223000
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04223500
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04224000
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04224500
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04225000
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04225500
         HTBL  74,CE,DE,B0,DC,E1,DF,EB,70,FB,EC,EE,EF,CA,ED,CF A C90040 04226000
         HTBL  90,DA,EA,FA,A0,80,71,DD,72,73,75,FE,76,DB,77,78 B C90040 04226500
         HTBL  CC,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 C C90040 04227000
         HTBL  57,58,FC,59,62,63,64,65,66,67,68,69,B1,B2,B3,B5 D C90040 04227500
         HTBL  CD,8A,8B,8C,8D,8E,8F,9A,9B,9C,9D,9E,9F,AA,AB,AC E C90040 04228000
         HTBL  AD,AE,BA,AF,BB,BC,BD,BE,BF,CB,B4,B8,B6,B7,B9,FD F C90040 04228500
*                                                                       04229000
L8TOE424 EQU   *             Latin/Hebrew to Israel EBCDIC     @SC90040 04229500
*          ref: Jonathan Rosenne (IBM Israel)                  @SC90040 04230000
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04230500
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04231000
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04231500
         HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04232000
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04232500
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04233000
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,BA,E0,BB,B0,6D 5 C90040 04233500
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04234000
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04234500
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04235000
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04235500
         HTBL  74,AA,4A,B1,9F,B2,6A,B5,BD,B4,BF,8A,5F,CA,AF,BC A C90040 04236000
         HTBL  90,8F,EA,FA,BE,A0,B6,B3,9D,DA,E1,8B,B7,B8,B9,AB B C90040 04236500
         HTBL  CB,CC,CD,9C,CE,CF,9E,9B,DD,DE,72,73,70,75,76,77 C C90040 04237000
         HTBL  AC,8C,ED,EE,EB,EF,EC,9A,80,FD,FE,FB,FC,AD,AE,78 D C90040 04237500
         HTBL  41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 E C90040 04238000
         HTBL  58,59,62,63,64,65,66,67,68,69,71,DB,DC,8D,8E,DF F C90040 04238500
*                                                                       04239000
KATOE290 EQU   *             KATAKANA to Japanese EBCDIC (290) @SC90040 04239500
*          ref: C-H 3-3220-050, composite                      @SC91067 04240000
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04240500
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04241000
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04241500
         HTBL  40,5A,7F,7B,E0,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04242000
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04242500
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04243000
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,70,5B,80,B0,6D 5 C91067 04243500
         HTBL  79,62,63,64,65,66,67,68,69,71,72,73,74,75,76,77 6 C91067 04244000
         HTBL  78,8B,9B,AB,B3,B4,B5,B6,B7,B8,B9,C0,4F,D0,A1,07 7 C91067 04244500
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04245000
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,4A 9 C91325 04245500
         HTBL  57,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 A C91325 04246000
         HTBL  58,81,82,83,84,85,86,87,88,89,8A,8C,8D,8E,8F,90 B C90040 04246500
         HTBL  91,92,93,94,95,96,97,98,99,9A,9D,9E,9F,A2,A3,A4 C C90040 04247000
         HTBL  A5,A6,A7,A8,A9,AA,AC,AD,AE,AF,BA,BB,BC,BD,BE,BF D C90040 04247500
         HTBL  59,5F,6A,9C,A0,B1,B2,CA,DA,DF,EA,EB,EC,ED,EE,EF E C91325 04248000
         HTBL  FA,FB,CD,CE,CB,CF,CC,E1,FC,DD,DE,DB,DC,FD,FE,FF F C91325 04248500
*                                                                       04249000
KATOHEBK EQU   *             KATAKANA to Hitachi EBCDIK        @SC91325 04249500
*          ref: Hitachi manual, composite                      @SC91325 04250000
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C91325 04250500
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C91325 04251000
         HTBL  40,4F,7F,7B,E0,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C91325 04251500
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C91325 04252000
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C91325 04252500
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,5B,5A,5F,6D 5 C91325 04253000
         HTBL  79,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75 6 C91325 04253500
         HTBL  76,77,78,80,8B,9B,9C,A0,AB,B0,B1,C0,6A,D0,A1,07 7 C91325 04254000
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C91325 04254500
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,B9 9 C91325 04255000
         HTBL  57,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 A C91325 04255500
         HTBL  58,81,82,83,84,85,86,87,88,89,8A,8C,8D,8E,8F,90 B C91325 04256000
         HTBL  91,92,93,94,95,96,97,98,99,9A,9D,9E,9F,A2,A3,A4 C C91325 04256500
         HTBL  A5,A6,A7,A8,A9,AA,AC,AD,AE,AF,BA,BB,BC,BD,BE,BF D C91325 04257000
         HTBL  B3,B4,B5,B6,B7,B8,B2,CA,DA,DF,EA,EB,EC,ED,EE,EF E C91325 04257500
         HTBL  FA,FB,CD,CE,CB,CF,CC,E1,FC,DD,DE,DB,DC,FD,FE,FF F C91325 04258000
*                                                                       04258500
L2TOE870 EQU   *             Latin-2 to ROECE EBCDIC           @SC90152 04259000
*          ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04259500
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90152 04260000
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90152 04260500
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90152 04261000
         HTBL  40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90152 04261500
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90152 04262000
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90152 04262500
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90152 04263000
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90152 04263500
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90152 04264000
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90152 04264500
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90152 04265000
         HTBL  41,B1,80,BA,9F,77,AA,B5,BD,BC,AF,FD,B9,CA,B8,B4 A C90152 04265500
         HTBL  90,A0,9E,9A,BE,57,8A,70,9D,9C,8F,DD,B7,64,B6,B2 B C90152 04266000
         HTBL  ED,65,62,66,63,78,69,68,67,71,72,73,DA,75,76,FA C C90152 04266500
         HTBL  AC,BB,AB,EE,EB,EF,EC,BF,AE,74,FE,FB,FC,AD,B3,59 D C91067 04267000
         HTBL  CD,45,42,46,43,58,49,48,47,51,52,53,DF,55,56,EA E C90152 04267500
         HTBL  8C,9B,8B,CE,CB,CF,CC,E1,8E,54,DE,DB,DC,8D,44,B0 F C91067 04268000
*                                                                       04268500
L3TOE905 EQU   *             Latin-3 to Turkish EBCDIC         @SC90152 04269000
*          ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04269500
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90152 04270000
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90152 04270500
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90152 04271000
         HTBL  40,4F,FC,EC,B9,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90152 04271500
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90152 04272000
         HTBL  AF,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90152 04272500
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,68,DC,B6,5F,6D 5 C90152 04273000
         HTBL  DA,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90152 04273500
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,48,8F,B3,CC,07 7 C90152 04274000
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90152 04274500
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90152 04275000
         HTBL  41,AA,80,B1,9F,70,BA,B5,BD,5B,7C,5A,BC,CA,AE,B4 A C90152 04275500
         HTBL  90,8A,EA,FA,BE,A0,9A,B7,9D,79,6A,D0,9C,B8,DF,B2 B C90152 04276000
         HTBL  64,65,62,66,63,67,AB,4A,74,71,72,73,78,75,76,77 C C90152 04276500
         HTBL  8E,69,ED,EE,EB,EF,7B,BF,BB,FD,FE,FB,7F,AD,AC,59 D C90152 04277000
         HTBL  44,45,42,46,43,47,8B,C0,54,51,52,53,58,55,56,57 E C90152 04277500
         HTBL  9E,49,CD,CE,CB,CF,A1,E1,9B,DD,DE,DB,E0,8D,8C,B0 F C90152 04278000
*                                                                       04278500
THTOE838 EQU   *             Thai ISO to Thai EBCDIC           @SC92233 04279000
*          ref: IBM code page registry + Trin Tantsetthi       @SC92233 04279500
*               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC92233 04280000
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C92233 04280500
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C92233 04281000
         HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C92233 04281500
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C92233 04282000
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C92233 04282500
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,49,E0,59,69,6D 5 C92233 04283000
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C92233 04283500
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C92233 04284000
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C92233 04284500
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C92233 04285000
         HTBL  41,42,43,44,45,46,47,48,52,53,54,55,56,57,58,62 A C92233 04285500
         HTBL  63,64,65,66,67,68,72,73,74,75,76,77,78,8A,8B,8C B C92233 04286000
         HTBL  8D,8E,8F,9A,9B,9C,9D,9E,9F,AA,AB,AC,AD,AE,AF,BA C C92233 04286500
         HTBL  BB,BC,BD,BE,BF,CB,CC,CD,CE,CF,DA,51,CA,FD,FE,70 D C92233 04287000
         HTBL  DB,DC,DD,DE,DF,EA,EB,EC,ED,EE,EF,FA,FB,FC,71,80 E C92233 04287500
         HTBL  B0,B1,B2,B3,B4,B5,B6,B7,B8,B9,90,A0,4A,5F,6A,E1 F C92233 04288000
*                                                                       04288500
         TITLE 'SETCON Routine - set correct controller type'  @SC91311 04289000
* Set TRMTP after determining that it's fullscreen             @SC91311 04289500
* Entry: R1= flags for desired technique:                      @SC91311 04290000
STCQBIT  EQU   X'01'         WSF Query is allowed              @SC91311 04290500
STCQNS1  EQU   X'02'         WSF Q implies *not* S/1           @SC91311 04291000
STCS1    EQU   X'04'         Always assume S/1                 @SC91311 04291500
STCNOS1  EQU   X'08'         Always assume *not* S/1           @SC91311 04292000
STCNORD  EQU   X'10'         Asynch READ MOD is forbidden      @SC91311 04292500
* Exit: R15=0 if ok.  TRMTP set.                               @SC91311 04293000
SETCON   ENTER                                                 @SC91311 04293500
         STC   1,STCFLGS                                       @SC91311 04294000
         MVI   TRMTP,C'S'    Remember going via S/1            @SC87166 04294500
         TM    STCFLGS,STCS1                                   @SC91311 04295000
         BO    RTRN0         Never check for S/1, assume it    @SC91311 04295500
         TM    STCFLGS,STCNOS1                                 @SC91311 04296000
         BO    STCGRP        Assume not S/1                    @SC91311 04296500
         TM    STCFLGS,STCQBIT+STCQNS1                         @SC91311 04297000
         BO    STCGRP        Definitely not S1                 @SC91311 04297500
         MVC   WRCMDL+4(4),F3  Preset the length to skip       @SC91150 04298000
         L     8,RIOPTRS                                       @SC90173 04298500
         XC    0(9,8),0(8)   Zero out buffer                   @SC88203 04299000
         LA    0,1                                             @SC88203 04299500
         KCALL SCRNIO        Clear screen and set up           @SC88203 04300000
         LA    0,6                                             @SC88203 04300500
         KCALL SCRNIO,STCS1ST,E=(STCSC,M) Issue status request @SC91311 04301000
         TM    STCFLGS,STCNORD READ MOD forbidden?             @SC91311 04301500
         BZ    STCSRST       No, do it                         @SC91311 04302000
         LA    0,7                                             @SC90264 04302500
         KCALL SCRNIO,RIOPTRS,E=(STCSC,NP) Read back screen    @SC91150 04303000
         CLC   =X'5BBC',4(8)                                   @SC90264 04303500
         BE    STCSC         String appeared on screen, not S1 @SC91150 04304000
         CLC   =X'5B60',4(8)                                   @SC93147 04304500
         BE    STCSC         Possible alternate appearance     @SC93147 04305000
         LA    0,6                                             @SC91150 04305500
         KCALL SCRNIO,STCS1STI,E=(STCSC,M) Again, with intrpt. @SC91150 04306000
STCSRST  LA    0,5                                             @SC91311 04306500
         KCALL SCRNIO,RIOPTRS Read back status                 @SC90173 04307000
STCSC    DS    0H                                              @SC91311 04307500
         LA    0,2                                             @SC88203 04308000
         KCALL SCRNIO        Release screen                    @SC88203 04308500
         CLI   0(8),X'E4'    Check for Yale status response    @SC88203 04309000
         BE    *+12          Ok, I trust                       @SC88294 04309500
          CLI  0(8),0        Other possibility                 @SC88294 04310000
          BNE  STCGRP        No, must be something else        @SC88294 04310500
         CLI   3(8),X'11'                                      @SC88203 04311000
         BNE   STCGRP        No, must be something else        @SC88203 04311500
         CLC   =X'2B5B5B',6(8)                                 @SC88203 04312000
         BE    RTRN0         Yes, all set                      @SC88203 04312500
STCGRP   MVI   TRMTP,C'A'    Assume AEA device                 @SC90173 04313000
         MVI   WRRD,5        Will want a reply in the test     @SC91311 04313500
         TM    STCFLGS,STCQBIT Query allowed?                  @SC91311 04314000
         BZ    STCGRG        No, assume GRAPHICS               @SC91311 04314500
         L     8,RIOPTRS                                       @SC90173 04315000
         XC    0(9,8),0(8)   Zero out buffer                   @SC90173 04315500
         LA    0,1                                             @SC90173 04316000
         KCALL SCRNIO        Clear screen and set up           @SC90173 04316500
         LA    0,4                                             @SC90173 04317000
         KCALL SCRNIO,STCAEAST,E=(STCAC,M) Issue Read Part'n   @SC91311 04317500
         LA    0,5                                             @SC90173 04318000
         KCALL SCRNIO,RIOPTRS Read back status                 @SC90173 04318500
STCAC    DS    0H                                              @SC91311 04319000
         LA    0,2                                             @SC90173 04319500
         KCALL SCRNIO        Release screen                    @SC90173 04320000
         CLI   0(8),X'88'    Check for WSF query reply         @SC90173 04320500
         BNE   STCGRG        No, must be something else        @SC90173 04321000
         CLC   3(2,8),=X'8180' Summary of replies 1st?         @SC90173 04321500
         BNE   STCGRG        No, must be something else        @SC90173 04322000
         SR    1,1                                             @SC90173 04322500
         ICM   1,3,1(8)      Get length of reply               @SC90173 04323000
         C     1,F64                                           @SC90173 04323500
         BNL   STCGRN        Too big, give up                  @SC90173 04324000
         LA    2,0(8,1)      Point to end                      @SC90173 04324500
STC5AL   CLI   0(2),X'8F'    OEM Aux device?                   @SC90173 04325000
         BE    RTRN0         Yes, all set                      @SC90173 04325500
         BCTR  2,0           No, keep looking                  @SC90173 04326000
         BCT   1,STC5AL                                        @SC90173 04326500
STCGRN   MVI   TRMTP,C'N'    Probably unsupported device       @SC90173 04327000
         B     RTRN0         That's all                        @SC90173 04327500
STCGRG   MVI   TRMTP,C'G'    Assume graphics device            @SC90173 04328000
         B     RTRN0                                           @SC90173 04328500
*                                                                       04329000
STCS1ST  DC    A(STCS1ORD,STCS1OL)                             @SC91311 04329500
STCS1ORD DC    &S1CMD1,AL1(SBA),X'4040'  Top of screen         @SC93147 04330000
         DC    X'2B5BBC'           Yale ASCII status request   @SC93147 04330500
STCS1OL  EQU   *-STCS1ORD                                      @SC91311 04331000
STCS1STI DC    A(STCS1ORI,STCS1OIL)                            @SC91311 04331500
STCS1ORI DC    &S1CMD1,X'2B5BBE'   Yale ASCII status w/ intrpt @SC91311 04332000
STCS1OIL EQU   *-STCS1ORI                                      @SC91311 04332500
STCAEAST DC    A(STCAEAQP,STCAEAL)                             @SC90173 04333000
STCAEAQP DC    &AEACMD,X'000501FF02' Read Partition Query      @SC90173 04333500
STCAEAL  EQU   *-STCAEAQP                                      @SC90173 04334000
*                                                                       04334500
         LOCALS ,                                              @SC86295 04335000
STCFLGS  DS    X             Flags for operation               @SC91311 04335500
         EXIT  ,                                               @SC86295 04336000
         TITLE 'HINTS Routine - give tips on setup etc'        @SC91295 04336500
HINTS    ENTER ,                                               @SC91295 04337000
         SR    0,0           Clear screen (if fullscreen)      @SC91295 04337500
         KCALL SCRNIO                                          @SC91295 04338000
** BEGIN LANGUAGE-SPECIFIC DATA **                             @SC92300 04338500
         WTEXT 'Enter ? for a list of valid commands.'         @SC91295 04339000
         WTEXT 'Enter ? at any point (and press ENTER) for a list of op.04339500
               tions.  The minimum'                            @SC91295 04340000
         WTEXT '  abbreviations will be in uppercase.'         @SC91295 04340500
         WTEXT 'Generally, RECEIVE PACKET-SIZE should be set as large a.04341000
               s possible (to maximize'                        @SC91295 04341500
         WTEXT '  efficiency), but there may be buffer size limits due .04342000
               to comm hard/software.'                         @SC91295 04342500
         WTEXT '  For safety, set BLOCK-CHECK to 2 or 3 for packets >10.04343000
               0.'                                             @SC91295 04343500
         WTEXT 'For safety in sending binary files, set the FILE TYPE t.04344000
               o BINARY at both ends,'                         @SC91295 04344500
         WTEXT '  but maybe use V-BINARY at this end to preserve record.04345000
                boundaries of the'                             @SC91295 04345500
         WTEXT '  original file.  Many Kermits convey the FILE TYPE aut.04346000
               omatically.'                                    @SC92300 04346500
         WTEXT '  Note: V-BINARY with RECEIVE is only for files origina.04347000
               lly sent that way.'                             @SC91295 04347500
         WTEXT 'Set the TRANSFER CHARACTER-SET to something appropriate.04348000
                (the default of ASCII'                         @SC91295 04348500
         WTEXT '  limits text files to 128 code points, but it maps som.04349000
               e common EBCDIC'                                @SC91295 04349500
         WTEXT '  variants to the "expected" ASCII characters).  Reset .04350000
               the tables as needed.'                          @SC91295 04350500
         WTEXT 'Hint: gather your habitual setups into an INIT file.'   04351000
** END LANGUAGE-SPECIFIC DATA **                               @SC92300 04351500
         WTEXT ' '                                             @SC91295 04352000
         STRTMSGS ,          Any system-specific messages...   @SC91295 04352500
         CLC   =C'ASCII',TRNALF Is it still default?           @SC91295 04353000
         BNE   HINTS1                                          @SC91295 04353500
         WTEXT '&TRANSFR &CHARSET&AAAAAIS.ASCII (7-bit)'       @SC91295 04354000
HINTS1   CLC   RPSIZ,=A(KMAX)  Default packet size (short)?    @SC91295 04354500
         BE    HINTS2          Yes, issue message              @SC91295 04355000
         BL    HINTS3          Actually smaller -- assume need @SC91295 04355500
         CLI   BCTC,C'1'       Greater, desire thorough check  @SC92085 04356000
         BNE   HINTS3          Ok, we're happy                 @SC92085 04356500
         WTEXT '&BLKCHCK&AAAAAIS.1 (&ZZSHORT)'                 @SC91295 04357000
         B     HINTS3                                          @SC91295 04357500
HINTS2   WTEXT '&RECEIVE &PACKSIZ&AAAAAIS.94 (&ZZSHORT)'       @SC91295 04358000
HINTS3   CLI   CLSNFL,C'O'     Overwrite?                      @SC91295 04358500
         BNE   HINTS4          No, don't quibble               @SC91295 04359000
         WTEXT '&AAAFILE &COLLISN&AAAAAIS.&OVERWRI (&ZZBEWAR)' @SC92300 04359500
HINTS4   DS    0H                                              @SC91295 04360000
         RET   ,                                               @SC91295 04360500
*                                                                       04361000
         LOCALS ,                                              @SC91295 04361500
         EXIT  ,                                               @SC91295 04362000
