home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / deleteme.zip / ik0cmd.asm < prev    next >
Assembly Source File  |  1993-10-21  |  223KB  |  2,726 lines

  1. *COPY                                                 IK0CMD            03000000
  2.          CHECKVER IK0CMD,4.3                                   @SC90072 03000500
  3.          TITLE 'USNTRF Routine - execute main loop'                     03001000
  4. * Execute Kermit commands (beginning with default TAKE files)           03001500
  5. * Entry: environment already set up                                     03002000
  6. * Exit: R15=0                                                           03002500
  7. *       ERRNUM set appropriately                                        03003000
  8. USNTRF   ENTER                                                          03003500
  9.          LA    0,KRMPROT                                       @SC86295 03004000
  10.          LA    1,USNCMD      Full list of commands             @SC87117 03004500
  11.          BAL   14,LOOPS      Set up loop return                @SC86295 03005000
  12.          LA    2,USRTAKE                                                03005500
  13.          LA    1,LUSRT       Length of name                    @SC86295 03006000
  14.          BAL   9,LUPTIN      Test user KERMINI                 @SC86295 03006500
  15.            NOP 0             Not found, skip it                @SC86295 03007000
  16.          LA    2,SYSTAKE                                       @SC86135 03007500
  17.          LA    1,LSYST       Length of name                    @SC86295 03008000
  18.          BAL   9,LUPTIN      Test system KERMINI               @SC86295 03008500
  19.            NOP 0             Not found, skip it                @SC86295 03009000
  20.          MVI   ERRNUM,ERRNFT No transfers yet                  @SC86295 03009500
  21.          KCALL SUPFNC,6,E=LOOP                                 @SC86295 03010000
  22.          OI    KFLG,CMDL+SIGN Got command line, suppress banner@SC86295 03010500
  23.          B     LOOP                                            @SC86295 03011000
  24. *                                                                       03011500
  25. KRMININC WTEXT 'Kermit-&KSYS Version &KVRSN..&KEDIT &KTAG (&KDATE.)'    03012000
  26.          WTEXT '&ENTHINT'                                      @SC91295 03012500
  27.          OI    KFLG,SIGN     Banner done                       @SC86295 03013000
  28. KRMPROB  PTEXT BLANK,1               And leave a blank line             03013500
  29.          B     LUPWRT        Not an error                      @SC86295 03014000
  30. *                                                                       03014500
  31. KRMPROT  TM    KFLG,CMDL                                       @SC86295 03015000
  32.          BZ    KRMPROCL              Go if Not cmd line                 03015500
  33.          NI    KFLG,255-CMDL Turn off command line             @SC86295 03016000
  34.          OI    KFLG,CMDC     Command from cmd line             @SC86295 03016500
  35.          L     1,CBUF                address of cmd                     03017000
  36.          L     0,CLEN        Length                            @SC86171 03017500
  37.          B     LUPPRS        Go process it                     @SC86295 03018000
  38. *                                                                       03018500
  39. KRMPROCL TM    KFLG,CMDC                                       @SC86295 03019000
  40.          BZ    KRMPROR               Go if not cmd line                 03019500
  41.          KCALL SUPFNC,7,E=(KRMXITQ,Z) Go if nothing stacked    @SC86295 03020000
  42. KRMPROR  TM    KFLG,SIGN     Already printed banner?           @SC86295 03020500
  43.          BO    KRMPROX       Yes, or suppressed                @SC86295 03021000
  44.          KCALL SUPFNC,7,E=(KRMININC,Z) Go if nothing stacked   @SC86295 03021500
  45. KRMPROX  LA    3,CMD                                           @SC86295 03022000
  46.          LA    4,KPRPT       Current prompt                    @SC87268 03022500
  47.          SR    0,0                                             @SC87268 03023000
  48.          IC    0,KPRPL       Prompt length                     @SC87268 03023500
  49.          RTEXT (3),PROMPT=((4),(0))                            @SC87268 03024000
  50.          LA    1,CMD         Ptr to command                    @SC86171 03024500
  51.          B     LUPPRS        Go process it                     @SC86295 03025000
  52. *                                                                       03025500
  53. USNCMD   KW    '&AAAEXIT',KRMXIT,MIN=2                         @SC92300 03026000
  54.          KW    '&AAAQUIT',KRMXIT                               @SC92300 03026500
  55.          AIF   ('&KSYS' NE 'TSO').TS0Z                         @SC88035 03027000
  56.          KW    '&AAAAEND',KRMXIT,MIN=2  Synonym for QUIT       @SC88035 03027500
  57. .TS0Z    ANOP                                                           03028000
  58. USNCMDX  KW    '&AAAABYE',KRMBYE,MIN=3                         @SC86155 03028500
  59.          KW    '&AAAADIR',KRMDIR,MIN=3                         @SC86295 03029000
  60.          KW    '&AAAECHO',KRMECO,MIN=2                         @SC92300 03029500
  61.          KW    '&AAAAFIN',KRMFIN,MIN=3                         @SC86155 03030000
  62.          KW    '&AAAAGET',KRMGET                               @SC86155 03030500
  63.          KW    '&AAAHELP',KRMHLP                               @SC92300 03031000
  64.          KW    '&AALOCAL',LUPTOK,MIN=3                         @SC86295 03031500
  65.          KW    '&RECEIVE',KRMREC,MIN=3                         @SC92300 03032000
  66.          KW    '&REMOTE',KRMREM,MIN=3                          @SC86155 03032500
  67.          KW    '&AAASEND',KRMSND,MIN=3                         @SC92300 03033000
  68.          KW    '&AAASERV',KRMSRV,MIN=3                         @SC92300 03033500
  69.          KW    '&AAXECHO',KRMXPE,MIN=2                         @SC86204 03034000
  70.          KW    '&AAXTYPE',KRMNPS,MIN=2                         @SC86204 03034500
  71. SRVKCMD  KW    '&KSYS.',LUPHST,MIN=2  Valid in Server mode ... @SC86295 03035000
  72.          AIF   ('&KSYS' NE 'CMS').CM0Z                         @SC86355 03035500
  73.          KW    'CP',LUPCP,MIN=2                                @SC86295 03036000
  74. .CM0Z    KW    'CWD',LUPCWD,MIN=2                              @SC86295 03036500
  75.          KW    '&AAAGIVE',LUPGIV,MIN=2                         @SC87117 03037000
  76.          KW    '&AAAHINT',LUPHNTS                              @SC91295 03037500
  77.          KW    '&AAAHOST',LUPHST,MIN=2                         @SC87253 03038000
  78.          KW    'KERMIT',LUPKRM                                 @SC90059 03038500
  79.          KW    '&SIMULAT',LUPSIM,MIN=2                         @SC91312 03039000
  80. USNCSET  KW    '&AAAASET',LUPSET,MIN=3                         @SC91320 03039500
  81.          KW    '&AAASHOW',LUPSHO,MIN=2                         @SC86295 03040000
  82.          KW    '&AASPACE',LUPSPA,MIN=2                         @SC86295 03040500
  83.          KW    '&ASTATUS',LUPSTA,MIN=2                         @SC86295 03041000
  84.          KW    '&AAATAKE',LUPTAK,MIN=2                         @SC86295 03041500
  85.          KW    '&AATDUMP',LUPDMP,MIN=2                         @SC86295 03042000
  86.          KW    '&AAATYPE',LUPHSTI,MIN=TYPMIN                   @SC88018 03042500
  87.          KW    '&VERSION',LUPVERS,MIN=2                        @SC90339 03043000
  88.          KW                                                             03043500
  89. *                                                                       03044000
  90. KRMECO   L     3,ADR                 Pick rest of line                  03044500
  91.          ICM   4,B'1111',LEN         Remaining data length              03045000
  92.          BNP   KRMPROB               Go if nothing left in cmd          03045500
  93.          B     LUPWRT        Else, print the rest              @SC86295 03046000
  94. *                                                              @SC86155 03046500
  95. KRMREM   KCALL GENCMD,0,E=LUPERK Send remote command           @SC86295 03047000
  96.          B     KRMXFZ                                          @SC87300 03047500
  97. *                                                              @SC86155 03048000
  98. KRMBYE   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03048500
  99.          KCALL GENCMD,AL     Send Logout command               @SC86155 03049000
  100.          B     KRMXFZ                                          @SC87300 03049500
  101. *                                                                       03050000
  102. KRMFIN   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03050500
  103.          KCALL GENCMD,AF     Send Finish command               @SC86155 03051000
  104.          B     KRMXFZ                                          @SC87300 03051500
  105. *                                                                       03052000
  106. KRMGET   PTEXT '&FORFSPC - ',AREG=1,LREG=0                     @SC88035 03052500
  107.          BAL   2,USNASKA     Prompt if user omitted args       @SC88035 03053000
  108.          LA    0,FFGET                                         @SC88049 03053500
  109.          KCALL FSPEC,JFSPEC  Get foreign filespec              @SC86295 03054000
  110.          BAL   14,LUPCKFN                                      @SC86295 03054500
  111.          PTEXT '&SYSFSPC - ',AREG=1,LREG=0                     @SC88035 03055000
  112.          BAL   2,USNASKT     Prompt if necessary               @SC88035 03055500
  113.          LA    0,FFGET+FFRCF                                   @SC88049 03056000
  114.          KCALL FSPEC,FILNAM  Get native filespec, if any       @SC86295 03056500
  115.          BAL   14,LUPCKFN                                      @SC86295 03057000
  116.          BAL   14,LUPCNF     Check for illegal extras          @SC86295 03057500
  117.          TM    FL3,APPN      Going to append anyway?           @SC90033 03058000
  118.          BO    USNGCK        Yes, ignore collisions            @SC90033 03058500
  119.          TM    FL1,REN+ROVR  Warning ON and name given?        @SC88089 03059000
  120.          BNO   USNGCK        No, don't check for collision yet @SC88089 03059500
  121.          LA    0,FFNEW+FFGET                                   @SC87012 03060000
  122.          KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions         @SC87012 03060500
  123. USNGCK   DS    0H                                              @SC88089 03061000
  124.          BAL   8,IPKSET      Set state table, exchange parms   @SC86295 03061500
  125. * Init packet  Rpack interpret input tables                    @SC86155 03062000
  126.          DC    AL1(AY),AL3(0)        ACK'ed                    @SC86155 03062500
  127.          DC    XL1'FF',AL3(KRMGETAB) Stop                      @SC88074 03063000
  128.          DC    AL1(00),AL3(KRMGETAB) Error                     @SC86155 03063500
  129.          BAL   9,PAKFIL      Copy file specification to buffer @HF86223 03064000
  130.          BAL   9,ENCODEN     Encode file-spec                  @SC86295 03064500
  131.          MVI   STYPE,AR      Packet type = receive initiate    @SC86155 03065000
  132.          KCALL SPACK,E=KRMGETAB Send name                      @SC86155 03065500
  133.          KCALL RECEIV                                          @SC86155 03066000
  134.          B     KRMXFZ                                          @SC86239 03066500
  135. *                                                                       03067000
  136. KRMGETAB KCALL INTINI,0                                        @SC86155 03067500
  137.          B     KRMXFZ                                          @SC87300 03068000
  138. *                                                                       03068500
  139. KRMREC   LA    0,FFRCF                                         @SC86295 03069000
  140.          KCALL FSPEC,FILNAM  Get filespec                      @SC86295 03069500
  141.          BAL   14,LUPCKFN                                      @SC86295 03070000
  142.          BAL   14,LUPCNF     Check for illegal extras          @SC86295 03070500
  143.          TM    FL3,APPN      Going to append anyway?           @SC90033 03071000
  144.          BO    USNRCK        Yes, ignore collisions            @SC90033 03071500
  145.          TM    FL1,REN+ROVR  Warning ON and name given?        @SC88089 03072000
  146.          BNO   USNRCK        No, don't check for collision yet @SC88089 03072500
  147.          LA    0,FFNEW+FFGET                                   @SC87012 03073000
  148.          KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions         @SC87012 03073500
  149.          TM    FL4,NMCHNG                                      @SC90061 03074000
  150.          BZ    USNRCK                                          @SC90061 03074500
  151.          PTEXT '&COLDISC'                                      @SC90061 03075000
  152.          CLI   CLSNFL,C'D'                                     @SC90061 03075500
  153.          BE    LUPWRTE                                         @SC90061 03076000
  154. USNRCK   DS    0H                                              @SC88089 03076500
  155.          KCALL INTINI,3,E=KRMXFZ  Initialize for receive       @SC87300 03077000
  156.          MVI   RTYPE,0       No packet read yet                @SC88074 03077500
  157.          KCALL RECEIV                                                   03078000
  158.          B     KRMXFZ                                          @SC86239 03078500
  159. *                                                                       03079000
  160. KRMNPS   OI    FL4,NPS                                         @SC86165 03079500
  161.          MVI   TCTLQ,0       Turn off control quoting          @SC86165 03080000
  162. *                                                                       03080500
  163. KRMSND   PTEXT '&SYSFSPC - ',AREG=1,LREG=0                     @SC88035 03081000
  164.          BAL   2,USNASKA     Prompt if necessary               @SC88035 03081500
  165.          SR    6,6           No extra files yet                @SC88306 03082000
  166.          L     7,MSNDBUF     Start of buffer                   @SC88306 03082500
  167. USNSND1  DS    0H                                              @SC88306 03083000
  168.          LA    0,FFSND                                         @SC88035 03083500
  169.          KCALL FSPEC,IFILE   Get filespec                      @SC86295 03084000
  170.          BAL   14,LUPCKFN                                      @SC86295 03084500
  171.          PTEXT '&FORFSPC - ',AREG=1,LREG=0                     @SC88035 03085000
  172.          BAL   2,USNASKT     Prompt if user omitted args       @SC88035 03085500
  173.          LA    0,FFSND+FFRCF                                   @SC86295 03086000
  174.          KCALL FSPEC,JFSPEC  Get filespec                      @SC86295 03086500
  175.          BAL   14,LUPCKFN                                      @SC86295 03087000
  176.          CLI   BRK,C','      Multi-file option?                @SC88306 03087500
  177.          BNE   USNSND2                                         @SC88306 03088000
  178.          A     6,F1          Count files to send               @SC88306 03088500
  179.          PTEXT '&MANYFIL'                                      @SC88306 03089000
  180.          CH    6,=Y(MSNDMAX) Too many?                         @SC88306 03089500
  181.          BH    LUPINV        Too bad                           @SC88306 03090000
  182.          MVC   0(LFSTF,7),IFILE Save filespecs + options       @SC89218 03090500
  183.          LA    7,LFSTF(,7)   Advance ptr into buffer           @SC89218 03091000
  184.          PTEXT '&SYSFSPC - ',AREG=1,LREG=0                     @SC88306 03091500
  185.          BAL   2,USNASKT     Prompt if necessary               @SC88306 03092000
  186.          B     USNSND1       Go for another name               @SC88306 03092500
  187. USNSND2  ST    7,MSNDPTR     Save buffer scan ptr              @SC88306 03093000
  188.          BAL   14,LUPCNF     Check for illegal extras          @SC86295 03093500
  189. KRMSNDBG KCALL SEND,0                                          @SC90239 03094000
  190. KRMXFZ   SR    3,3                                             @SC86355 03094500
  191.          ICM   3,1,ERRNUM    Ok?                               @SC86355 03095000
  192.          BZ    LOOP          Yes, get next command             @SC86355 03095500
  193.          KCALL PEMSG         No, convert error number          @SC91064 03096000
  194.          OI    FL5,CMERR     Note error                        @SC91064 03096500
  195.          B     LOOP                                            @SC91064 03097000
  196. *                                                                       03097500
  197. USNASKA  NI    KFLG,255-PRMP Assume no prompting               @SC88035 03098000
  198.          FTOKN N=USNASK      Check for some text waiting       @SC88035 03098500
  199.          BR    2             Ok, use it                        @SC88035 03099000
  200. USNASKT  TM    KFLG,PRMP     Is prompting required?            @SC88035 03099500
  201.          BZR   2             No, ok                            @SC88035 03100000
  202. USNASK   OI    KFLG,PRMP     Must prompt for both filespecs    @SC88035 03100500
  203.          LA    3,CMD         Use input buffer                  @SC88035 03101000
  204.          ST    3,ADR                                           @SC88035 03101500
  205.          RTEXT (3),PROMPT=((1),(0)) Ask for filespec           @SC88035 03102000
  206.          ST    0,LEN         Save string length                @SC88035 03102500
  207.          BR    2                                               @SC88035 03103000
  208. *                                                                       03103500
  209. KRMXPE   L     5,ADR         Pointer to rest of line           @HF86150 03104000
  210.          ICM   4,15,LEN      Remaining data length             @HF86150 03104500
  211.          BNP   KRMXPEH       Go if nothing specified           @HF86150 03105000
  212.          L     3,RBUF                                          @HF86150 03105500
  213.          MVC   0(256,3),0(5) Copy to disk read buffer          @HF86150 03106000
  214.          AR    4,3           Get end                           @HF86150 03106500
  215.          STM   3,4,TXTPTR    Point to text to copy             @HF86150 03107000
  216.          OI    FL4,SFM+NPS   Data source: text string          @SC86165 03107500
  217.          XC    FLNOPTS(LFOPTS),FLNOPTS                         @SC91116 03108000
  218.          MVI   TCTLQ,AUP     Turn on control quoting           @SC86165 03108500
  219.          MVC   MSNDPTR,MSNDBUF No extra files                  @SC88306 03109000
  220.          B     KRMSNDBG                                        @SC86165 03109500
  221. *                                                                       03110000
  222. KRMXPEH  PTEXT '&XTYPMSG'                                      @SC86165 03110500
  223.          B     LUPWRT                                          @SC86295 03111000
  224. *                                                                       03111500
  225. KRMSRV   BAL   14,LUPCNF     Check for illegal extras          @SC86295 03112000
  226.          KCALL SERVER        Call SERVER routine               @SC86295 03112500
  227.          B     KRMXFZ        Return to normal mode             @SC86355 03113000
  228. *                                                                       03113500
  229. KRMDIR   LA    0,FFUTL+FFWLD                                   @SC86295 03114000
  230.          KCALL FSPEC,FILNAM  Get pattern filespec              @SC86295 03114500
  231.          BAL   14,LUPCKFN    Make sure ok                      @SC86295 03115000
  232.          PTEXT '&NOTFOUN'    File not found if error here      @SC90264 03115500
  233.          LA    0,13                                            @SC86295 03116000
  234.          KCALL DISKIO,FILNAM,E=LUPFNF Do a DIR on it           @SC90264 03116500
  235.          MVI   ERRNUM,ERRNOE No problem                        @SC90264 03117000
  236.          B     LOOP                                            @SC86295 03117500
  237. *                                                                       03118000
  238. KRMHLP   KCALL KHELP         Issue help request                @SC86355 03118500
  239.          B     LOOP                                            @SC86355 03119000
  240. *                                                                       03119500
  241. KRMXIT   FTOKN N=KRMXITQ,H=LUPCRH Check for illegal extras     @SC86295 03120000
  242.          B     LUPBAD        Not just QUIT, maybe system Q     @SC86295 03120500
  243. *                                                                       03121000
  244. KRMXITQ  NXTFSET ,END        Flush pending file list           @SC86355 03121500
  245.          L     2,TAKLEVK                                       @SC86295 03122000
  246. KRMXITL  BCTR  2,0                                             @SC86295 03122500
  247.          LTR   3,2           Any pending TAKE files?           @SC86295 03123000
  248.          BM    RTRN0         No                                @SC86295 03123500
  249.          SLA   3,2                                             @SC86295 03124000
  250.          CLOSF TAKTABK(3)    Close the open file               @SC86295 03124500
  251.          B     KRMXITL       Keep checking                     @SC86295 03125000
  252.          LOCALS ,                                              @SC86295 03125500
  253. * See SERVER for mapping                                       @SC86295 03126000
  254.          DS    A             Return adr if no more TAKE stuff  @SC86295 03126500
  255.          DS    A             Adr of command table              @SC86295 03127000
  256. TAKLEVK  DS    F             Take file level                   @SC86295 03127500
  257. TAKTABK  DS    (TAKMAX)F     Tickets for I/O                   @SC86295 03128000
  258. KFLG     DS    X             Local flags in main program       @SC86295 03128500
  259. PRMP     EQU   X'10'         Prompting for filespecs           @SC88035 03129000
  260. SIGN     EQU   X'04'         Already printed Kermit banner     @SC86295 03129500
  261. CMDC     EQU   X'02'         Command gotten from cmd                    03130000
  262. CMDL     EQU   X'01'         Data on cmd line                           03130500
  263. USNTRF   EXIT                                                           03131000
  264.          TITLE 'SIMLAT Routine - set up to replay a file'      @SC91312 03131500
  265. * Begin to read a file for supplying incoming packets in lieu  @SC91312 03132000
  266. *   of reading them from the communication line                @SC91312 03132500
  267. * Entry: ADR,LEN point to file name                            @SC91312 03133000
  268. * Exit: R15=0 if ok, 1 if bad (message already printed)        @SC91312 03133500
  269. *     ERRNUM set appropriately                                 @SC91312 03134000
  270. SIMLAT   ENTER ,                                               @SC91312 03134500
  271.          BAL   9,SIMCLS      Close old input file, if any      @SC91312 03135000
  272.          SR    0,0                                             @SC91312 03135500
  273.          KCALL FSPEC,FILNAM,E=SIMERR  Get filespec             @SC91312 03136000
  274.          MVI   ERRNUM,ERRNOE Reset error                       @SC91312 03136500
  275.          FTOKN N=SIMOK,H=SIMCRH                                @SC91312 03137000
  276.          PTEXT '&EXTRAOP'                                      @SC91312 03137500
  277.          B     SIMERR                                          @SC91312 03138000
  278. SIMOK    OPENF I,FILNAM,FILFDB,SIMPTR,E=SIMFNF                 @SC91312 03138500
  279.          B     RTRN0                                           @SC91312 03139000
  280. SIMFNF   BAL   9,SIMCLS      Close input file                  @SC91312 03139500
  281.          MVI   ERRNUM,ERRFNF File not found                    @SC91312 03140000
  282. SIMERF   PTEXT '&SIMSHRT'                                      @SC91312 03140500
  283.          B     SIMERR                                          @SC91312 03141000
  284. *                                                                       03141500
  285. SIMCLS   CLOSF SIMPTR        Close it                          @SC91312 03142000
  286.          BR    9                                               @SC91312 03142500
  287. *                                                                       03143000
  288. SIMCRH   PTEXT '&NOOPERS'                                      @SC91312 03143500
  289. SIMERR   WTEXT (3),(4)       Return error message              @SC91312 03144000
  290.          B     RTRN1                                           @SC91312 03144500
  291. *                                                                       03145000
  292.          LOCALS ,                                              @SC91312 03145500
  293.          EXIT                                                  @SC91312 03146000
  294.          TITLE 'SET Routine - perform SET command options'              03146500
  295. * Set/change values in STORAG.                                          03147000
  296. * Entry: SCANPTR string has option                                      03147500
  297. * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name          03148000
  298. *       ERRNUM unchanged                                                03148500
  299. SET      ENTER                                                          03149000
  300.          MVI   SETXI,X'97'   XI instruction                    @SC86273 03149500
  301.          NTOKN N=RTRN2                                         @SC86171 03150000
  302.          NI    FL3,255-PXCH  Make sure server renegotiates     @SC86295 03150500
  303.          L     3,=A(SETCMDS)                                   @SC90040 03151000
  304.          USING SETCMDS,3     Address CSECT throughout          @SC90040 03151500
  305.          SCAN  SETCMDKW,RTRN1                                  @SC86295 03152000
  306.          B     RTRN2                                           @SC86295 03152500
  307. *                                                                       03153000
  308. SETCMDS  CSECT                                                 @SC90040 03153500
  309. SETTTKW  KW    'KP',SETTTKP  Special TTABLE option             @SC90278 03154000
  310.          KW    '&AAAAOFF',SETTTF,MIN=2                         @SC92352 03154500
  311.          KW    '&AAAAAON',SETTTN,MIN=2                         @SC92352 03155000
  312.          KW    ,                                               @SC92352 03155500
  313. *                                                                       03156000
  314. SETOOKW  KW    '&AAAAOFF',SETOFF,MIN=2                         @SC87166 03156500
  315.          KW    '&AAAAAON',SETON,MIN=2                          @SC87166 03157000
  316.          KW    ,                                               @SC87166 03157500
  317. *                                                                       03158000
  318. SETOOFRC KW    '&AAAAOFF',SETOFFL,MIN=2                        @SC91275 03158500
  319. SETOFRC  KW    '&AAAAAON',SETONL,MIN=2                         @SC91275 03159000
  320.          KW    '&AFORCED',SETFRC                               @SC91275 03159500
  321.          KW    ,                                               @SC91275 03160000
  322. *                                                                       03160500
  323. SETCMDOO KW    '&AAAAOFF',SETOFFS,MIN=2                        @SC87166 03161000
  324. SETONKW  KW    '&AAAAAON',SETONS,MIN=2                         @SC87166 03161500
  325.          KW    ,                                               @SC86171 03162000
  326. SET      CSECT                                                 @SC90040 03162500
  327. *                                                                       03163000
  328. SETFRC   MVI   LCKFRC,X'21'  Enable FORCE mode                 @SC91275 03163500
  329.          B     SETON                                           @SC91275 03164000
  330. *                                                                       03164500
  331. SETTTF   LA    1,ATOE        Use normal tables                 @SC92352 03165000
  332.          LA    2,ETOA                                          @SC92352 03165500
  333.          STM   1,2,AEPTRS                                      @SC92352 03166000
  334.          B     SETOFF                                          @SC92352 03166500
  335. SETOFFL  MVI   LCKFRC,0      Disable FORCE mode                @SC91275 03167000
  336. SETOFF   EX    0,0(9)        Yes, first turn flag on...        @SC87166 03167500
  337.          EX    0,SETXI       Then off                          @SC86273 03168000
  338.          B     RTRN0                                           @SC87166 03168500
  339. *                                                                       03169000
  340. SETONL   MVI   LCKFRC,0      Disable FORCE mode                @SC91275 03169500
  341. SETON    EX    0,0(9)        Turn flag on                      @SC87166 03170000
  342.          B     RTRN0                                           @SC87166 03170500
  343. *                                                                       03171000
  344. SETOFFS  B     4(9)                                            @SC87166 03171500
  345. *                                                                       03172000
  346. SETONS   BR    9             Go to ON handler                  @SC87166 03172500
  347. *                                                                       03173000
  348. SETCMDS  CSECT                                                 @SC90040 03173500
  349. SETTRKW  KW    '&AAAATTY',SETT,T                               @SC91320 03174000
  350.          KW    '&SERIES1',SETT,S                               @SC91320 03174500
  351.          KW    '&GRAPHIC',SETT,G                               @SC91320 03175000
  352.          KW    '&AAAAAEA',SETT,A                               @SC91320 03175500
  353.          KW    '&VTAMTTY',SETT,V                               @SC91320 03176000
  354.          KW    '&FULLSCR',SETT,F                               @SC92030 03176500
  355.          KW    '&AAANONE',SETT,N                               @SC91320 03177000
  356.          KW    ,                                               @SC87166 03177500
  357. *                                                                       03178000
  358. SETBLKKW KW    '1-BYTE',SETT,1                                 @SC92085 03178500
  359.          KW    '2-BYTE',SETT,2                                 @SC92085 03179000
  360.          KW    '3-BYTE',SETT,3                                 @SC92085 03179500
  361.          KW    '&BLNKFRE',SETT,B                               @SC92085 03180000
  362.          KW    ,                                               @SC92085 03180500
  363. SET      CSECT                                                 @SC90040 03181000
  364. *                                                                       03181500
  365. SETT     MVC   0(1,8),KWCODE(1) Save value in specified field  @SC91320 03182000
  366.          B     RTRN0                                           @SC87166 03182500
  367. *                                                                       03183000
  368. SETCMDS  CSECT                                                 @SC90040 03183500
  369. PFXUNPFX KW    '&PREFIXD',SETCTL1,0                            @SC93173 03184000
  370.          KW    '&UNPREFD',SETCTL1,1                            @SC93173 03184500
  371.          KW    ,                                               @SC93173 03185000
  372. *                                                                       03185500
  373. SETSWT   KW    '&CONTINU',SETOFF                               @SC86171 03186000
  374.          KW    '&AAAHALT',SETON                                @SC86171 03186500
  375.          KW    ,                                               @SC86171 03187000
  376. *                                                                       03187500
  377. SETDSC   KW    '&DISCARD',SETOFF                               @SC86225 03188000
  378.          KW    '&AAAKEEP',SETON                                @SC86225 03188500
  379.          KW    ,                                               @SC86225 03189000
  380. *                                                                       03189500
  381. SETCLSKW KW    '&AAPPEND',SETCLSA,A                            @SC91320 03190000
  382.          KW    '&ABACKUP',SETCLSR,B                            @SC91320 03190500
  383.          KW    '&DISCARD',SETCLSR,D                            @SC91320 03191000
  384.          KW    '&OVERWRI',SETCLSN,O                            @SC91320 03191500
  385.          KW    '&ARENAME',SETCLSR,R                            @SC91320 03192000
  386.          KW    ,                                               @SC90033 03192500
  387. *                                                                       03193000
  388. SETOVWKW KW    '&DEFAULT',SETOFF                               @SC90033 03193500
  389.          KW    '&PRESERV',SETON                                @SC90033 03194000
  390.          KW    ,                                               @SC90033 03194500
  391. *                                                                       03195000
  392. SETPAR   KW    '&AAAMARK',SETOFF                               @SC86316 03195500
  393.          KW    '&AAANONE',SETON                                @SC86316 03196000
  394.          KW    ,                                               @SC86316 03196500
  395. SET      CSECT                                                 @SC90040 03197000
  396. *                                                                       03197500
  397. SETTABS  LA    4,SETCMDOO                                      @SC87166 03198000
  398.          BAL   14,SETSCN                                       @SC87166 03198500
  399.           B    SETTBON       Turn on                           @SC86355 03199000
  400.          NI    FL2,255-TABS  Turn off                          @SC86355 03199500
  401.          MVC   TABCNT,F0     Clear count                       @SC86355 03200000
  402.          B     RTRN0                                           @SC86295 03200500
  403. SETTBON  OI    FL2,TABS      Turn on                           @SC86355 03201000
  404.          MVC   TABCNT,F0     Clear count                       @SC86355 03201500
  405.          SR    0,0           Init previous tab                 @SC86355 03202000
  406.          LA    3,TABTBL      Point to start of tab table       @TS86100 03202500
  407.          LA    8,255         Limit on tab stops                @SC86355 03203000
  408.          LA    5,TABCNT      End of table                      @SC86355 03203500
  409. SETTBLP  ICM   2,15,LEN      Any more tokens?                  @SC86355 03204000
  410.          BNP   SETTBN        No, done                          @SC86355 03204500
  411.          STC   0,0(3)        Save previous tab                 @SC86355 03205000
  412.          BAL   2,SETNUM      Read number                       @SC86355 03205500
  413.          CLM   0,1,0(3)      Is this tab higher than previous? @SC86355 03206000
  414.          BNH   SETTBSEQ      No, tab out of sequence           @TS86100 03206500
  415.          CR    3,5           Exceeded capacity?                @SC86355 03207000
  416.          BNL   SETTBHI       Yes                               @TS86100 03207500
  417.          STC   0,0(3)        Save tab setting                  @TS86100 03208000
  418.          LA    3,1(3)        Bump counter                      @SC86355 03208500
  419.          B     SETTBLP                                         @SC86355 03209000
  420. SETTBN   LA    0,TABTBL      Point to start of tab table       @SC86355 03209500
  421.          SR    3,0           Get length of table               @SC86355 03210000
  422.          STH   3,TABCNT      Save the tab count                @TS86100 03210500
  423.          B     RTRN0                                           @SC86355 03211000
  424. SETTBHI  PTEXT '&MANYTAB'                                      @SC86355 03211500
  425.          B     SETTBER       Return error                      @SC86355 03212000
  426. SETTBSEQ PTEXT '&BADTABS'                                      @TS86100 03212500
  427. SETTBER  NI    FL2,255-TABS  Turn off                          @SC86355 03213000
  428.          B     SUBERR        Return error                      @TS86100 03213500
  429. *                                                                       03214000
  430. SETLIN   BAL   2,SETFSTR     Get fixed-format string           @SC86166 03214500
  431.          PTEXT '&BADCOMM'                                      @SC87351 03215000
  432.          KCALL SETMSG,5,E=SUBERR Make sure it's ok             @SC87351 03215500
  433.          B     RTRN0                                           @SC86166 03216000
  434. *                                                                       03216500
  435. SETPRP   LA    0,KPRPT       Ptr to new prompt string          @SC87351 03217000
  436.          KCALL SUPFNC,11     Ok it with system                 @SC87351 03217500
  437.          B     RTRN0                                           @SC87351 03218000
  438. *                                                                       03218500
  439. SETCLSA  OI    FL3,APPN      Set APPEND ON                     @SC90033 03219000
  440.          NI    FL1,255-REN   ... and "WARN" OFF                @SC90033 03219500
  441.          B     SETCLSZ                                         @SC90033 03220000
  442. SETCLSR  OI    FL1,REN       Set "WARN" ON                     @SC90033 03220500
  443.          B     SETCLSY       ... and APPEND OFF                @SC90033 03221000
  444. SETCLSN  NI    FL1,255-REN                                     @SC90033 03221500
  445. SETCLSY  NI    FL3,255-APPN                                    @SC90033 03222000
  446. SETCLSZ  B     SETT          Save collision code               @SC91320 03222500
  447. *                                                                       03223000
  448.          KSETPRC ,           System-specific options           @SC86355 03223500
  449. *                                                                       03224000
  450. SETCMDS  CSECT                                                 @SC90040 03224500
  451. *  An alternate name must follow immediately the primary.      @SC92113 03225000
  452. *  All primary names must be the same length (with blanks).    @SC92113 03225500
  453. *  (but names not associated in pairs can be any length).      @SC92233 03226000
  454. SETALFKW KW    'LATIN1  ',SETALF1,MIN=6                        @SC91325 03226500
  455. SETALFL1 KW    'L1',SETALFX,MIN=2  Alternate name              @SC90152 03227000
  456.          KW    'ARABIC',SETALF1,MIN=2                          @SC93027 03227500
  457.          KW    'ASCII   ',SETALF1,MIN=2                        @SC90152 03228000
  458.          KW    '&CYRILLC',SETALF1,MIN=2                        @SC90152 03228500
  459.          KW    '&AAGREEK',SETALF1,MIN=2                        @SC90152 03229000
  460.          KW    '&HEBREW',SETALF1,MIN=2                         @SC90152 03229500
  461.          KW    '&JAPNEUC',SETALF1,MIN=3                        @SC91325 03230000
  462.          KW    'KATAKANA',SETALF1,MIN=2                        @SC90152 03230500
  463.          KW    'LATIN2  ',SETALF1,MIN=6                        @SC90152 03231000
  464.          KW    'L2',SETALFX,MIN=2  Alternate name              @SC90152 03231500
  465.          KW    'LATIN3  ',SETALF1,MIN=6                        @SC90152 03232000
  466.          KW    'L3',SETALFX,MIN=2  Alternate name              @SC90152 03232500
  467.          KW    'THAI',SETALF1,MIN=2                            @SC92233 03233000
  468.          KW    '&TRANSPA',SETALF1,MIN=2                        @SC90250 03233500
  469.          KW    ,                                               @SC90040 03234000
  470. SETFALFK KW    'EBCDIC  ',SETALF1,MIN=6                        @SC90040 03234500
  471.          KW    'CP1047',SETALFX,MIN=6  Alternate name          @SC92113 03235000
  472.          KW    'CP037   ',SETALF1,MIN=5                        @SC90040 03235500
  473.          KW    'CP273   ',SETALF1,MIN=5                        @SC90040 03236000
  474.          KW    'CP275   ',SETALF1,MIN=5                        @SC90040 03236500
  475.          KW    'CP277   ',SETALF1,MIN=5                        @SC90040 03237000
  476.          KW    'CP278   ',SETALF1,MIN=5                        @SC90040 03237500
  477.          KW    'CP280   ',SETALF1,MIN=5                        @SC90040 03238000
  478.          KW    'CP281',SETALF1,MIN=5                           @SC91325 03238500
  479.          KW    'CP282   ',SETALF1,MIN=5                        @SC90040 03239000
  480.          KW    'CP284   ',SETALF1,MIN=5                        @SC90040 03239500
  481.          KW    'CP285   ',SETALF1,MIN=5                        @SC90040 03240000
  482.          KW    'CP297   ',SETALF1,MIN=5                        @SC90040 03240500
  483.          KW    'CP290   ',SETALF1,MIN=5                        @SC90040 03241000
  484.          KW    'CP420',SETALF1,MIN=5                           @SC93027 03241500
  485.          KW    'CP424   ',SETALF1,MIN=5                        @SC90040 03242000
  486.          KW    'CP500   ',SETALF1,MIN=5                        @SC90040 03242500
  487.          KW    'CP838',SETALF1,MIN=5                           @SC92233 03243000
  488.          KW    'CP870   ',SETALF1,MIN=5                        @SC90152 03243500
  489.          KW    'CP871   ',SETALF1,MIN=5                        @SC90040 03244000
  490.          KW    'CP875   ',SETALF1,MIN=5                        @SC90040 03244500
  491.          KW    'CP880   ',SETALF1,MIN=5                        @SC90152 03245000
  492.          KW    'CP905   ',SETALF1,MIN=5                        @SC90152 03245500
  493.          KW    '&CZECH',SETALF1,MIN=2                          @SC90152 03246000
  494.          KW    'DKOI    ',SETALF1,MIN=4                        @SC90040 03246500
  495.          KW    'H-EBCDIK-DASH',SETALF1,MIN=3                   @SC91325 03247000
  496.          KW    'KANJI',SETKANJ,MIN=3                           @SC91325 03247500
  497. KANJIF   KW    'FUJITSU-KANJI',SETALF1,MIN=3                   @SC91325 03248000
  498. KANJIH   KW    'HITACHI-KANJI',SETALF1,MIN=3                   @SC91325 03248500
  499. KANJII   KW    'IBM-KANJI',SETALF1,MIN=3                       @SC91325 03249000
  500.          KW    ,                                               @SC90040 03249500
  501. *                                                                       03250000
  502. SETFKW   KW    '&AALRECL',SHOLR           **COMPAT**           @SC87166 03250500
  503.          KW    '&LONGLIN',SHOLNG,MIN=2    **COMPAT**           @SC88120 03251000
  504.          KW    '&COLLISN',SHOCLSN,MIN=2   **COMPAT**           @SC90033 03251500
  505.          KW    '&OVERWRI',SHOOVWR         **COMPAT**           @SC90033 03252000
  506.          AIF   ('&ATTTYPE'(1,1) NE '&AAATEXT'(1,1)).CMPAT01    @SC92300 03252500
  507.          KW    'T',SETFT,T                 **COMPAT**          @SC91320 03253000
  508. .CMPAT01 ANOP                                                  @SC92300 03253500
  509.          KW    '&ATTTYPE',SHOFILT         **COMPAT**           @SC87166 03254000
  510.         KFILKW ,                           **COMPAT**          @SC87166 03254500
  511.          KW    '&CHARSET',SHOFALF,MIN=2                        @SC90040 03255000
  512. SETFIL   KW    '&AAATEXT',SETFILET,T                           @SC91320 03255500
  513.          KW    '&AAAABIN',SETFILEB,B                           @SC91320 03256000
  514. SETDBIN  KW    '&AAADBIN',SETFILEB,D                           @SC91320 03256500
  515.          KW    '&AAAVBIN',SETFILEB,V                           @SC91320 03257000
  516.          KW                                                             03257500
  517. SET      CSECT                                                 @SC90040 03258000
  518. *                                                                       03258500
  519. SETKANJ  L     1,=A(KANJI&KNJLAB) Use default                  @SC91325 03259000
  520.          B     SETALF1                                         @SC91325 03259500
  521. SETALFX  SH    1,=Y(SETALFL1-SETALFKW) Convert to proper entry @SC90152 03260000
  522. SETALF1  MVC   0(LALF,8),=CL(LALF)' '  Fill with blanks        @SC91325 03260500
  523.          IC    14,KWLEN(,1)  Get length-1 of keyword           @SC91325 03261000
  524.          CLM   14,1,SETALF1+1 See if too long for field        @SC91325 03261500
  525.          BNH   *+8           Ok                                @SC91325 03262000
  526.           IC   14,SETALF1+1  Too long, use field length        @SC91325 03262500
  527.          EX    14,SETALFMV   Copy keyword to field             @SC91325 03263000
  528.          LR    0,8           Pass ptr to the changed code      @SC90040 03263500
  529.          KCALL TBLSET,ATOE   Set up translations               @SC90040 03264000
  530.          B     RTRN                                            @SC90040 03264500
  531. SETALFMV MVC   0(,8),KWNAME(1)                                 @SC91325 03265000
  532. *                                                                       03265500
  533. SETFILEB OI    FL1,BINF              Set binary on                      03266000
  534.          B     SETT                                            @SC91320 03266500
  535. *                                                                       03267000
  536. SETFILET NI    FL1,255-BINF          Set it OFF                         03267500
  537.          B     SETT                                            @SC91320 03268000
  538. *                                                                       03268500
  539. SETCMDS  CSECT                                                 @SC90040 03269000
  540. SETLNGKW KW    '&AAAFOLD',SETT,F                               @SC91320 03269500
  541.          KW    '&AAAHALT',SETT,H                               @SC91320 03270000
  542.          KW    '&TRUNCAT',SETT,T                               @SC91320 03270500
  543.          KW    ,                                               @SC88120 03271000
  544. SET      CSECT                                                 @SC90040 03271500
  545. *                                                                       03272000
  546.          KFILSET ,                                             @SC87012 03272500
  547. *                                                                       03273000
  548. SETDEB   BAL   4,SETSCN      Select among possibilities        @SC88168 03273500
  549.          KW    '&AAAAAON',SETDON                               @SC88168 03274000
  550.          KW    '&AAAAOFF',SETDEND,MIN=2                        @SC88168 03274500
  551. SETRAW   KW    '&AAAARAW',SETDRAW                              @SC88168 03275000
  552.          KW    '&AAAAAIO',SETDIO                               @SC88168 03275500
  553.          KW    '&AAALONG',SETDLO                               @SC90222 03276000
  554.          KW    '&AAASAVE',SETDSV                               @SC88168 03276500
  555.          KW    '&AAATIME',SETDTM                               @SC91172 03277000
  556.          KW    ,                                               @SC88168 03277500
  557. SETDEBOF NI    FL1,255-DEBUG         Set it OFF                         03278000
  558.          CLOSF LOGPTR        Done logging                      @SC86135 03278500
  559.          B     RTRN0                                           @SC86295 03279000
  560. *                                                                       03279500
  561. SETDRAW  OI    SHODBG,DBGON+DBGRW   RAW -> ON                  @SC88168 03280000
  562.          B     SETDB1                                          @SC88168 03280500
  563. SETDIO   OI    SHODBG,DBGON+DBGIO   I/O -> ON                  @SC88168 03281000
  564.          B     SETDB1                                          @SC88168 03281500
  565. SETDLO   OI    SHODBG,DBGON+DBGLO+DBGIO LONG-> ON + I/O        @SC90332 03282000
  566.          B     SETDB1                                          @SC90222 03282500
  567. SETDSV   OI    SHODBG,DBGON+DBGSV   SAVE-> ON                  @SC88168 03283000
  568.          B     SETDB1                                          @SC88168 03283500
  569. SETDTM   OI    SHODBG,DBGON+DBGTI   TIME-> ON                  @SC91172 03284000
  570.          B     SETDB1                                          @SC91172 03284500
  571. SETDON   OI    SHODBG,DBGON                                    @SC88168 03285000
  572. SETDB1   ICM   2,15,LEN      Any more options?                 @SC88168 03285500
  573.          BP    SETDEB        Yes, interpret them               @SC88168 03286000
  574. SETDEND  XC    SHODBG,DBGFLG Get changed flags in SHODBG       @SC88168 03286500
  575.          XC    DBGFLG,SHODBG Install new flags                 @SC88168 03287000
  576.          TM    SHODBG,DBGON  ON/OFF changed?                   @SC88168 03287500
  577.          BZ    RTRN0         No, done                          @SC88168 03288000
  578.          TM    DBGFLG,DBGON  Turned ON?                        @SC88168 03288500
  579.          BZ    SETDEBOF      No, turn it off                   @SC88168 03289000
  580.          NI    LOGFLGS,255-APPN                                @SC86295 03289500
  581.          LA    0,L'LOGNAM    Name string length                @SC86295 03290000
  582.          LA    1,LOGNAM      and address                       @SC86295 03290500
  583.          STM   0,1,SCANPTR                                     @SC86295 03291000
  584.          LA    0,FFRCF                                         @SC86295 03291500
  585.          KCALL FSPEC,IFILE   Convert to filespec               @SC86295 03292000
  586.          PTEXT '&DEBGERR'                                      @SC87012 03292500
  587.          OPENF O,IFILE,LOGFDB,LOGPTR,E=SUBERR                  @SC87012 03293000
  588.          OI    FL1,DEBUG     Enable logging                    @SC87012 03293500
  589.          MVI   ERRNUM,ERRNOE Insist no errors                  @SC88168 03294000
  590.          B     RTRN0                                           @SC86295 03294500
  591. *                                                                       03295000
  592. SET8B    NTOKN N=SET8BH,H=SET8BH                               @SC87008 03295500
  593.          LA    4,AAMP        Default value                     @SC87008 03296000
  594.          LA    9,SET8BS                                        @SC87008 03296500
  595.          SCAN  SETONKW,RTRN2                                            03297000
  596.          SR    4,4           Zero value means OFF              @SC87008 03297500
  597.          LTR   7,7           Length=1?                         @SC87008 03298000
  598.          BNZ   SET8BS        No, can't be ON                   @SC87008 03298500
  599.          BAL   2,SETQCH2     Make sure it's valid              @SC87008 03299000
  600. SET8BS   STC   4,EBQC        New value                         @SC87008 03299500
  601.          B     RTRN0                                           @SC87008 03300000
  602. SET8BH   PTEXT '&ONOFFCH'                                      @SC87008 03300500
  603.          B     SUBERR                                          @SC87008 03301000
  604. *                                                                       03301500
  605. SETSTR   LR    2,14                                            @SC87268 03302000
  606.          MVI   0(8),0        Default to blank                  @SC87166 03302500
  607.          BAL   9,WSP         Remaining data length             @SC86224 03303000
  608.           B    RTRN0         Null string                       @SC86295 03303500
  609.          LR    1,4           Max length allowed                @SC87268 03304000
  610.          CR    6,1                                             @SC86345 03304500
  611.          BH    SETSTRH       Too long                          @SC86345 03305000
  612.          STC   6,0(8)        Save length                       @SC87166 03305500
  613.          LA    8,1(8)        Skip over length byte             @SC87268 03306000
  614.          XR    6,7           Exchange ptr and length           @SC87268 03306500
  615.          XR    7,6                                             @SC87268 03307000
  616.          XR    6,7                                             @SC87268 03307500
  617.          B     SETFST1       Go copy string                    @SC87268 03308000
  618. *                                                                       03308500
  619. SETRCTLQ BAL   2,SETQCHR             Get a char for Receive-Ctl-quote   03309000
  620.          STC   4,RCTLQ(5)    Set receive ctl quote             @SC86164 03309500
  621.          LTR   5,5           Done if SEND                      @SC86223 03310000
  622.          BNZ   RTRN0                                           @SC86295 03310500
  623.          STC   4,DEFPARM+5   Set default for SPAR              @SC86120 03311000
  624.          B     RTRN0                                           @SC86295 03311500
  625. *                                                                       03312000
  626. SETQCHR  NTOKN H=SETQCHRH,N=SETQCHRH                                    03312500
  627.          LTR   7,7                   Token length - 1                   03313000
  628.          BP    SETQCHRH              Pos: token is too long             03313500
  629. SETQCH2  SR    4,4                                             @SC87008 03314000
  630.          IC    4,0(6)        Get the quote char                @SC86120 03314500
  631.          IC    4,ETOAD(4)    Get ASCII form                    @SC89301 03315000
  632.          NOTQR SETQCHRH      Go if not 33-62 or 96-126         @SC86120 03315500
  633.          BR    2                                                        03316000
  634. *                                                                       03316500
  635. SETQCHRH PTEXT '&ASCQUOT'                                      @SC86224 03317000
  636.          B     SUBERR                                          @SC86295 03317500
  637. *                                                                       03318000
  638. SETLR    ST    0,MAXOUT      Max output buffer size            @SC87166 03318500
  639.          B     RTRN0                                           @SC86295 03319000
  640. *                                                                       03319500
  641. SETTIMO  BCT   5,RTRN0       Done if rec                       @SC87166 03320000
  642.          TOCHR 0,,DEFPARM+1  Set default for SPAR              @SC86164 03320500
  643.          B     RTRN0                                           @SC86295 03321000
  644. *                                                                       03321500
  645. SETPADN  BCT   5,RTRN0       Done if rec                       @SC87166 03322000
  646.          TOCHR 0,,DEFPARM+2  Set default for SPAR              @SC86164 03322500
  647.          B     RTRN0                                           @SC86295 03323000
  648. *                                                                       03323500
  649. SETPADC  BCT   5,RTRN0       Done if rec                       @SC87166 03324000
  650.          CTL   0,,DEFPARM+3  Set default for SPAR              @SC86164 03324500
  651.          B     RTRN0                                           @SC86295 03325000
  652. *                                                                       03325500
  653. SETEOL   BCT   5,RTRN0       Done if rec                       @SC87166 03326000
  654.          STC   0,S1EOL       Extra copy for prompting          @SC87274 03326500
  655.          TOCHR 0,,DEFPARM+4          Set default for SPAR               03327000
  656.          B     RTRN0                                           @SC86295 03327500
  657. *                                                                       03328000
  658. SETSIZ   C     0,AKMIN       Less than min Kermit size?        @SC87166 03328500
  659.          BL    SETKSIZH      Yes, error                        @SC86164 03329000
  660.          C     0,AKMAX       More than max Kermit size?        @SC86164 03329500
  661.          BNH   SETRPS1       No, skip message call             @TB86196 03330000
  662.          LTR   5,5           SEND?                             @SC86224 03330500
  663.          BNZ   SETKSIZH      Yes, can't set it long            @SC86224 03331000
  664.          L     0,AKMAX       Use max Kermit size for default   @SC90122 03331500
  665. SETRPS1  DS    0H                                              @TB86196 03332000
  666.          BCT   5,RTRN0       Done if recv                      @SC86295 03332500
  667.          TOCHR 0,,DEFPARM+0          Set default for SPAR               03333000
  668.          B     RTRN0                                           @SC86295 03333500
  669. *                                                                       03334000
  670. SETKSIZH PTEXT '&SENDPAK'                                      @SC90122 03334500
  671.          B     SUBERR                                          @SC86295 03335000
  672. *                                                                       03335500
  673. SETCTL   LA    4,PFXUNPFX    Select among possibilities        @SC93173 03336000
  674.          B     SETSCN                                          @SC93173 03336500
  675. SETCTL1  IC    3,KWCODE(1)   Get code (0=>must prefix, 1=>not) @SC93173 03337000
  676.          N     3,F1                                            @SC93173 03337500
  677.          ICM   0,15,LEN      Any more tokens?                  @SC93173 03338000
  678.          BP    SETCTL2       Yes, must be numeric              @SC93173 03338500
  679.          STC   3,CTLTAB      No, just do whole table           @SC93173 03339000
  680.          MVC   CTLTAB+1(159),CTLTAB                            @SC93173 03339500
  681.          B     RTRN0                                           @SC93173 03340000
  682. SETCTL2  LA    8,159         Limit for control list            @SC93173 03340500
  683.          BAL   2,SETNUM      Get a number for table offset     @SC93173 03341000
  684.          LA    7,CTLTAB                                        @SC93173 03341500
  685.          AR    7,0           Ptr to proper table entry         @SC93173 03342000
  686.          STC   3,0(,7)                                         @SC93173 03342500
  687.          B     RTRN0         All done                          @SC93173 03343000
  688. *                                                                       03343500
  689. SETETOA  LA    3,ETOA        Address of table to change        @SC86265 03344000
  690.          NI    ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03344500
  691.          B     SETTET2                                         @SC87117 03345000
  692. SETTET   LA    3,TETOA       Address of table to change        @SC87117 03345500
  693. SETTET2  LA    2,ETOAD       Address of original               @SC87117 03346000
  694. SETTR0   ICM   0,15,LEN      Any more tokens?                  @SC87117 03346500
  695.          BP    SETTR1        Yes, must be numeric              @SC87117 03347000
  696.          MVC   0(256,3),0(2) No, just reset table              @SC87117 03347500
  697.          B     RTRN0                                           @SC87117 03348000
  698. SETTR1   LA    8,255         Limit for each                    @SC87117 03348500
  699.          BAL   2,SETNUM      Get a number for table offset     @SC86295 03349000
  700.          AR    3,0           Save table offset here            @SC86295 03349500
  701.          BAL   2,SETNUM      Get a number for value            @SC86295 03350000
  702.          STC   0,0(3)        Change value                      @SC86295 03350500
  703.          B     RTRN0         All done                          @SC86295 03351000
  704. *                                                                       03351500
  705. SETATOE  LA    3,ATOE        Adr of table to edit              @SC86265 03352000
  706.          NI    ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03352500
  707.          B     SETTAT2                                         @SC87117 03353000
  708. SETTAT   LA    3,TATOE       Address of table to change        @SC87117 03353500
  709. SETTAT2  LA    2,ATOED       Address of original               @SC87117 03354000
  710.          B     SETTR0                Use common routine                 03354500
  711. *                                                                       03355000
  712. SETTTB   LA    4,SETTTKW     List of choices: ON, OFF, KP      @SC90278 03355500
  713.          BAL   14,SHOXY      ON or OFF just handles flag       @SC90278 03356000
  714. SETTTKP   OI   FL4,TTAB      KP comes here and changes table   @SC90278 03356500
  715.          L     1,=A(ATOEKP)  Replacement table (invertible)    @SC90278 03357000
  716.          MVC   TATOE,0(1)                                      @SC90278 03357500
  717.          SR    2,2                                             @SC90278 03358000
  718.          LA    1,255         Now invert into other table       @SC90278 03358500
  719.          IC    2,TATOE(1)                                      @SC90278 03359000
  720.          STC   1,TETOA(2)                                      @SC90278 03359500
  721.          BCT   1,*-8                                           @SC90278 03360000
  722.          MVI   TETOA,0       Null is always null!              @SC90278 03360500
  723. SETTTN   LA    1,TATOE       Use "T" tables                    @SC92352 03361000
  724.          LA    2,TETOA                                         @SC92352 03361500
  725.          STM   1,2,AEPTRS                                      @SC92352 03362000
  726.          B     SETON                                           @SC92352 03362500
  727. *                                                                       03363000
  728. *                                                                       03363500
  729. * R6 points to token, R7 has length-1.  Convert to binary in R0.        03364000
  730. * Return via R2                                                         03364500
  731. SETNUM2  LR    2,14          Save return                       @SC87166 03365000
  732. SETNUM   NTOKN H=SETNUMH,N=SETNUMH                             @SC86295 03365500
  733.          LA    7,1(7)        Length                            @SC86316 03366000
  734.          BAL   14,GETNUM                                       @SC86316 03366500
  735.           B    SETNUMH                                         @SC86316 03367000
  736.          CLR   0,8           Within limit?                     @SC86295 03367500
  737.          BH    SETNUMH       Too big                           @SC87166 03368000
  738.          CLI   0(2),X'47'    Entered at SETNUM2?               @SC87166 03368500
  739.          BNER  2             No, return immediately            @SC87166 03369000
  740.          LR    14,2          Ptr to caller                     @SC87166 03369500
  741.          S     14,F8         Back up to the LOAD instr         @SC87166 03370000
  742.          MVC   SETXI,0(14)   Copy and modify op instr          @SC87166 03370500
  743.          NC    SETXI(2),=X'F60F'                               @SC87166 03371000
  744.          CLI   SETXI,X'B6'   Was is ICM?                       @SC87166 03371500
  745.          BNE   *+8           No, ok                            @SC87166 03372000
  746.          MVI   SETXI,X'BE'   Yes, make into STCM               @SC87166 03372500
  747.          EX    0,SETXI       Store value                       @SC87166 03373000
  748.          BR    2             Return                            @SC87166 03373500
  749. *                                                                       03374000
  750. SETNUMH  LA    15,CMD+&LOPRNUM                                 @SC86295 03374500
  751. SETMAXH  MVC   CMD(&LOPRMUS),=C'&OPRMUB&OPRMUL'                @SC86295 03375000
  752.          MVI   0(15),C'<'                                      @SC86295 03375500
  753.          LA    15,1(15)                                        @SC86295 03376000
  754.          LR    4,8                                             @SC86345 03376500
  755.          A     4,F1                                            @SC86345 03377000
  756.          BAL   2,EDDEC       Put limit into message            @SC86295 03377500
  757.          LR    4,15          End                               @SC86295 03378000
  758.          LA    3,CMD                                           @SC86295 03378500
  759.          SR    4,3                                             @SC86295 03379000
  760.          B     SUBERR                                          @SC86295 03379500
  761. *                                                                       03380000
  762. SETFSTR  LR    1,9           Save length                       @SC87166 03380500
  763.          NTOKN N=SETFST0,H=SETSTRH                             @SC87166 03381000
  764.          LA    7,1(7)                                          @SC86295 03381500
  765.          CR    7,1           Name too long?                    @SC86295 03382000
  766.          BNH   SETFST1       No, do it                         @SC86295 03382500
  767. SETSTRH  LR    8,1           Copy max length                   @SC86295 03383000
  768.          LA    15,CMD+&LOPRMUS Base message size               @SC86295 03383500
  769.          B     SETMAXH                                         @SC86295 03384000
  770. SETFST0  SR    7,7           Empty string                      @SC86295 03384500
  771. SETFST1  ICM   7,8,BLANK     Set for blank fill                @SC86295 03385000
  772.          LR    9,1                                             @SC87166 03385500
  773.          MVCL  8,6           Copy name                         @SC87166 03386000
  774.          BR    2                                               @SC86295 03386500
  775.          TITLE 'SHOW Routine - performs SHOW command options'           03387000
  776. * Display current values in STORAG.                                     03387500
  777. * Entry: SCANPTR string has option                                      03388000
  778. * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name          03388500
  779. *       ERRNUM unchanged                                                03389000
  780. SHOW     ENTER ALT                                             @SC86133 03389500
  781.          LA    0,CMD                                           @SC86227 03390000
  782.          ST    0,SHOPTR      Initialize output ptr             @SC86227 03390500
  783.          MVI   SETXI,X'91'   TM instruction                    @SC87166 03391000
  784.          L     3,=A(SETCMDS) Addressibility                    @SC90040 03391500
  785.          NTOKN N=SHOALL                                        @SC86133 03392000
  786.          SCAN  SHOCMDAL,RTRN1                                  @SC88293 03392500
  787. SHOBAD   B     RTRN2         Invalid operand                   @SC86295 03393000
  788. *                                                                       03393500
  789. SETCMDS  CSECT                                                 @SC90040 03394000
  790. SETCMDKW DS    0H                                              @SC87166 03394500
  791.          KW    '&AAAATOE',SETATOE,MIN=4                        @SC87166 03395000
  792.          KW    '&CTRLCHR',SETCTL,MIN=8                         @SC93173 03395500
  793.          KW    '&AAAETOA',SETETOA,MIN=4                        @SC87166 03396000
  794.          KW    '&FILTYPE',SHOFILT,MIN=5                        @SC87166 03396500
  795.          KW    '&AATATOE',SETTAT,MIN=5                         @SC87166 03397000
  796.          KW    '&AATETOA',SETTET,MIN=5                         @SC87166 03397500
  797.          KW    GOTO,SHOCMDS  Skip over 'ALL'                   @SC88293 03398000
  798. *                                                                       03398500
  799. SHOATKW  KW    '&ATTLENG',SHOATLN                              @SC90037 03399000
  800.          KW    '&ATTTYPE',SHOATTP                              @SC90037 03399500
  801.          KW    '&ATTDATE',SHOATDT,MIN=2                        @SC90037 03400000
  802.          KW    '&ATTCRET',SHOATCR,MIN=2                        @SC90037 03400500
  803.          KW    '&ATTACCT',SHOATACT,MIN=4                       @SC90037 03401000
  804.          KW    '&ATTAREA',SHOATAR,MIN=2                        @SC90037 03401500
  805.          KW    '&ATTPASS',SHOATPW,MIN=2                        @SC90037 03402000
  806.          KW    '&ATTBLKS',SHOATBLK                             @SC90037 03402500
  807.          KW    '&ATTACSS',SHOATACC,MIN=3                       @SC90037 03403000
  808.          KW    '&ATTENCD',SHOATENC                             @SC90037 03403500
  809.          KW    '&ATTDISP',SHOATDSP,MIN=2                       @SC90037 03404000
  810.          KW    '&ATTPROT',SHOATPRO,MIN=2                       @SC90037 03404500
  811.          KW    '&ATTORIG',SHOATORG                             @SC90037 03405000
  812.          KW    '&ATTFRMT',SHOATFMT                             @SC90037 03405500
  813.          KW    '&ATTSINF',SHOATSFO,MIN=2                       @SC90037 03406000
  814.          KW    '&ATTBLEN',SHOATXLN,MIN=2                       @SC90037 03406500
  815.          KW    '&AAAAEND',SHOATEND,MIN=3                       @SC91109 03407000
  816.          KW    ,                                               @SC90037 03407500
  817. *                                                                       03408000
  818. SHOCMDAL KW    '&AAAAALL',SHOALL,MIN=3                         @SC88293 03408500
  819. SHOCMDS  EQU   *                                               @SC90037 03409000
  820. SHOATCM  KW    '&ATTRIBU',SHOATT,MIN=3                         @SC90037 03409500
  821. *                                                                       03410000
  822.          KW    '&AARECFM',SHORFM,MIN=4                         @SC87012 03410500
  823.          KW    '&AALRECL',SHOLR                                @SC86133 03411000
  824.          KW    '&WARNING',SHOWARN       ***COMPAT***           @SC90033 03411500
  825.          KW    '&AAPPEND',SHOAPP,MIN=3  ***COMPAT***           @SC90033 03412000
  826.          KW    '&AAABAUD',SHOBAUD,MIN=2 ***COMPAT***           @SC90099 03412500
  827. SHOCMDKW EQU   *             Must match order of code                   03413000
  828.          KW    '&TABSEXP',SHOTABS                              @SC86133 03413500
  829.          KW    '&AAAAEOF',SHOEOF,MIN=3                         @SC86133 03414000
  830.          KW    '&AADEBUG',SHODEB                               @SC86133 03414500
  831.          KW    '&BLKCHCK',SHOBLK                               @SC86133 03415000
  832.          KW    '&A8THBQU',SHO8B                                @SC87008 03415500
  833.          KW    '&APROMPT',SHOPRP,MIN=2                         @SC87268 03416000
  834.          KW    '&AAALINE',SHOLIN,MIN=3                         @SC87166 03416500
  835.          KW    '&CONTRLR',SHOTRM,MIN=3                         @SC87268 03417000
  836.          KW    '&HANDSHK',SHOHND                               @SC87274 03417500
  837.          KW    '&AASPEED',SHOBAUD,MIN=2                        @SC90099 03418000
  838.          KW    '&ASYSCMD',SHOSYS,MIN=2                         @SC86295 03418500
  839.          KW    '&TTTABLE',SHOTTB,MIN=2                         @SC87117 03419000
  840.          KW    '&AADELAY',SHODLY,MIN=3                         @SC86164 03419500
  841.          KW    '&INCOMPL',SHOINC,MIN=3                         @SC86225 03420000
  842.          KW    '&AAATEST',SHOTST,MIN=4                         @SC87166 03420500
  843.          KW    '&SRVTIME',SHOSERV,MIN=3                        @SC90045 03421000
  844.         KSETKW ,             Specific parameters               @SC87166 03421500
  845.          KW    '&TRANSFR',SHOTRN,MIN=2                         @SC90040 03422000
  846.          KW    '&AAAFILE',SHOFIL                               @SC86295 03422500
  847.          KW    '&AMARGIN',SHOMRG                               @SC87253 03423000
  848.          KW    '&FOREIGN',SHOFOR,MIN=3                         @HF86223 03423500
  849.          KW    '&AARETRY',SHORETR,MIN=3                        @SC86345 03424000
  850.          KW    '&AAATAKE',SHOTAK,MIN=3                         @SC86171 03424500
  851.          KW    '&RECEIVE',SHORECV,MIN=3                        @SC86133 03425000
  852.          KW    '&AAASEND',SHOSEND,MIN=3                        @SC86224 03425500
  853.          KW    ,                                               @SC86133 03426000
  854. SET      CSECT                                                 @SC90040 03426500
  855. *                                                                       03427000
  856. SHOATT   MVC   SHOTMP(8),SCANPTR   Save string ptrs            @SC90037 03427500
  857.          LA    0,3           Max interesting count             @SC90037 03428000
  858. SHOATL1  NTOKN N=SHOATL2     Count tokens after ATTRIB         @SC90037 03428500
  859.          BCT   0,SHOATL1                            R0=3 => 0  @SC90037 03429000
  860. SHOATL2  MVC   SCANPTR(8),SHOTMP  Restore              2 => 1  @SC90037 03429500
  861.          CLI   SETXI,X'97'   SET?                      1 => 2  @SC90037 03430000
  862.          BE    *+6           Yes, 2 more means "item"  0 => >2 @SC90037 03430500
  863.           BCTR 0,0           No, 1 more means "item"           @SC90037 03431000
  864.          BCT   0,SHOATS      Go if not "item"                  @SC90037 03431500
  865.          LA    4,SHOATKW     List of possible items            @SC90037 03432000
  866.          B     SHOGRP        Do the right one                  @SC90037 03432500
  867. SHOATS   OI    SFLG,ALLF+ASRF  Set to display both levels..    @SC90037 03433000
  868.          BAL   14,SHOOO      Just SET ATT or SHO ATT           @SC90037 03433500
  869.           OI   SCAPA,8                                         @SC90037 03434000
  870.          LA    1,SHOATCM     Point at keywork again (SHO ATT)  @SC90037 03434500
  871.          LA    4,SHOATKW     Do whole list                     @SC90037 03435000
  872.          B     SHOGRP                                          @SC90037 03435500
  873. SHOATLN  BAL   14,SHOOO      Length                            @SC90037 03436000
  874.           OI   ATFLG,ATFLNG                                    @SC90037 03436500
  875. SHOATTP  BAL   14,SHOOO      Type                              @SC90037 03437000
  876.           OI   ATFLG,ATFTYP                                    @SC90037 03437500
  877. SHOATDT  BAL   14,SHOOO      Date                              @SC90037 03438000
  878.           OI   ATFLG,ATFDAT                                    @SC90037 03438500
  879. SHOATCR  BAL   14,SHOOO      Creator                           @SC90037 03439000
  880.           OI   ATFLG,ATFCRE                                    @SC90037 03439500
  881. SHOATACT BAL   14,SHOOO      Account                           @SC90037 03440000
  882.           OI   ATFLG,ATFACT                                    @SC90037 03440500
  883. SHOATAR  BAL   14,SHOOO      Area                              @SC90037 03441000
  884.           OI   ATFLG,ATFARE                                    @SC90037 03441500
  885. SHOATPW  BAL   14,SHOOO      Password                          @SC90037 03442000
  886.           OI   ATFLG,ATFPWD                                    @SC90037 03442500
  887. SHOATBLK BAL   14,SHOOO      Blocksize                         @SC90037 03443000
  888.           OI   ATFLG,ATFBLK                                    @SC90037 03443500
  889. SHOATACC BAL   14,SHOOO      Access                            @SC90037 03444000
  890.           OI   ATFL2,ATFACC                                    @SC90037 03444500
  891. SHOATENC BAL   14,SHOOO      Encoding                          @SC90037 03445000
  892.           OI   ATFL2,ATFENC                                    @SC90037 03445500
  893. SHOATDSP BAL   14,SHOOO      Disposition                       @SC90037 03446000
  894.           OI   ATFL2,ATFDSP                                    @SC90037 03446500
  895. SHOATPRO BAL   14,SHOOO      Protection                        @SC90037 03447000
  896.           OI   ATFL2,ATFPRO                                    @SC90037 03447500
  897. SHOATORG BAL   14,SHOOO      Origin                            @SC90037 03448000
  898.           OI   ATFL2,ATFORG                                    @SC90037 03448500
  899. SHOATFMT BAL   14,SHOOO      Format                            @SC90037 03449000
  900.           OI   ATFL2,ATFFMT                                    @SC90037 03449500
  901. SHOATSFO BAL   14,SHOOO      System info                       @SC90037 03450000
  902.           OI   ATFL2,ATFSFO                                    @SC90037 03450500
  903. SHOATXLN BAL   14,SHOOO      Byte count                        @SC90037 03451000
  904.           OI   ATFL3,ATFXLN                                    @SC90037 03451500
  905. SHOATEND BAL   14,SHOOO      End                               @SC91109 03452000
  906.           OI   ATFL4,ATFEND                                    @SC91109 03452500
  907.          B     SHOGRPZ                                         @SC90037 03453000
  908. *                                                                       03453500
  909. SHOALL   OI    SFLG,ALLF     Do all                            @SC86295 03454000
  910.          SR    0,0           Clear screen (if fullscreen)      @SC90045 03454500
  911.          KCALL SCRNIO                                          @SC90045 03455000
  912.          LA    1,SHOCMDKW    Start at beginning                @SC86133 03455500
  913. *                                                                       03456000
  914. *          Each routine begins with R1-> keyword item          @SC86133 03456500
  915. SHOTABS  CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03457000
  916.          BE    SETTABS                                         @SC87166 03457500
  917.          BAL   14,SHOOO      On or off                         @SC86133 03458000
  918.           OI   FL2,TABS                                        @SC87166 03458500
  919. SHOTABSZ LH    5,TABCNT      Count of tabs                     @SC86355 03459000
  920.          LA    3,TABTBL      Ptr to table of tabs              @SC86355 03459500
  921.          BAL   14,SHOLIST    Display list of tab stops, if any @SC86355 03460000
  922.           NOP  0                                               @SC87166 03460500
  923. SHOEOF   BAL   14,SHOOO      On or off                         @SC86133 03461000
  924.           OI   FL2,EOFZ                                        @SC87166 03461500
  925. SHODEB   CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03462000
  926.          BE    SETDEB                                          @SC87166 03462500
  927.          BAL   14,SHOOO      1st get ON vs. OFF                @SC88168 03463000
  928.           OI   FL1,DEBUG                                       @SC88168 03463500
  929. SHODEBZ  MVC   SHODBG,DBGFLG Copy flags for decoding           @SC88168 03464000
  930.          LA    6,SETRAW      List of options                   @SC88168 03464500
  931.          BAL   4,SHOMULT     See if any extra flags on         @SC88168 03465000
  932.           NOP  0                                               @SC88168 03465500
  933. SHOBLK   LA    4,SETBLKKW                                      @SC92085 03466000
  934.          LA    6,BCTC        Get block check type              @SC92085 03466500
  935.          BAL   14,SHOBRV     Print it                          @SC92085 03467000
  936.           NOP  0             OK                                @SC92085 03467500
  937. SHO8B    LA    8,EBQC                                          @SC87008 03468000
  938.          BAL   14,SHOCHRA    Display ASCII char                @SC87008 03468500
  939.           B    SET8B                                           @SC87166 03469000
  940. SHOPRP   LA    8,KPRPL       Ptr to prompt                     @SC87268 03469500
  941.          LA    4,20          Max length                        @SC87268 03470000
  942.          BAL   14,SHOSTR                                       @SC87268 03470500
  943.           B    SETPRP        Do any system-dependent setup     @SC87351 03471000
  944. SHOLIN   LA    8,TRMLIN                                        @SC87166 03471500
  945.          LA    9,L'TRMLIN                                      @SC87166 03472000
  946.          BAL   14,SHOCHRN                                      @SC87166 03472500
  947.           B    SETLIN                                          @SC87166 03473000
  948. SHOTRM   LA    4,SETTRKW                                       @SC87166 03473500
  949.          LA    6,TRMTP                                         @SC87166 03474000
  950.          BAL   14,SHOBRV     Get full name from abbrev.        @SC87166 03474500
  951.           NOP  0                                               @SC87166 03475000
  952. SHOHND   SR    4,4                                             @SC87274 03475500
  953.          IC    4,S1HND                                         @SC87274 03476000
  954.          BAL   14,SHOCTL     Print it                          @SC87274 03476500
  955.           B    RTRN0                                           @SC87274 03477000
  956. SHOBAUD  L     4,BAUD                                          @SC86164 03477500
  957.          BAL   14,SHONBIG    Print it                          @SC86164 03478000
  958.           B    RTRN0                                           @SC87166 03478500
  959. SHOSYS   BAL   14,SHOOO      On or off                         @SC86295 03479000
  960.           OI   FL2,PASS                                        @SC87166 03479500
  961. SHOTTB   CLI   SETXI,X'97'                                     @SC90278 03480000
  962.          BE    SETTTB        Do SET subcommand separately      @SC90278 03480500
  963.          BAL   14,SHOOO      On or off                         @SC90278 03481000
  964.           OI   FL4,TTAB                                        @SC87166 03481500
  965. SHODLY   L     4,LCLDLY                                        @SC86164 03482000
  966.          BAL   14,SHONBIG    Print it                          @SC86164 03482500
  967.           B    RTRN0                                           @SC87166 03483000
  968. SHOINC   LA    4,SETDSC      List of possibles                 @SC87166 03483500
  969.          BAL   14,SHOXY                                        @SC86225 03484000
  970.           OI   FL1,KEEP                                        @SC90037 03484500
  971. SHOTST   BAL   14,SHOOO                                        @SC87166 03485000
  972.           OI   FL1,TSTF      Turn on                           @SC87166 03485500
  973. SHOSERV  SR    4,4                                             @SC90045 03486000
  974.          IC    4,TIMOSRV     Server timeout (also switch)      @SC90045 03486500
  975.          BAL   14,SHONBIG                                      @SC90045 03487000
  976.           B    RTRN0         Index for server                  @SC90045 03487500
  977. *                                                                       03488000
  978.          KSHOPRC ,           System-specific options           @SC86355 03488500
  979. *                                                                       03489000
  980. SHOTRN   LA    4,SHOTRNKW    Ptr to sublist                    @SC90040 03489500
  981.          BAL   14,SHOGRP                                       @SC90040 03490000
  982. SHOFIL   LA    4,SHOFILKW    Ptr to sublist                    @SC87166 03490500
  983.          CLI   SETXI,X'97'   SET or SHOW   **COMPAT**          @SC87166 03491000
  984.          BNE   *+8           SHOW          **COMPAT**          @SC87166 03491500
  985.          LA    4,SETFKW      SET           **COMPAT**          @SC87166 03492000
  986.          LA    8,TYPFIL      In case just 'SET F T'            @SC91320 03492500
  987.          BAL   14,SHOGRP                                       @SC86295 03493000
  988. SHOMRG   LA    4,SHOMRGKW    Ptr to sublist                    @SC87253 03493500
  989.          BAL   14,SHOGRP                                       @SC87253 03494000
  990. SHOFOR   LA    4,SHOFORKW    Ptr to sublist                    @SC87166 03494500
  991.          BAL   14,SHOGRP                                       @SC86224 03495000
  992. SHORETR  LA    4,SHORETKW    Ptr to sublist                    @SC87166 03495500
  993.          BAL   14,SHOGRP                                       @SC86345 03496000
  994. SHOTAK   LA    4,SHOTAKKW    Ptr to sublist                    @SC87166 03496500
  995.          BAL   14,SHOGRP                                       @SC86224 03497000
  996. SHORECV  SR    5,5           Index for recv                    @SC86224 03497500
  997.          BAL   14,SHOGRPR                                      @SC86224 03498000
  998. SHOSEND  LA    5,1           Index for send                    @SC86224 03498500
  999.          LA    14,SHOZZW                                       @SC87166 03499000
  1000. SHOGRPR  LA    4,SHORECKW    Ptr to common sublist             @SC87166 03499500
  1001. SHOGRP   LR    2,14          Save return adr                   @SC87166 03500000
  1002.          STM   1,4,SHOTMP    Save top level ptr, return adr    @SC87166 03500500
  1003.          TM    SFLG,ALLF     Doing all?                        @SC86295 03501000
  1004.          BO    SHORAL2       Yes                               @SC86133 03501500
  1005. SETSCN   LR    2,14          Copy return adr (again)           @SC87166 03502000
  1006.          NTOKN N=SHORALL                                       @SC86133 03502500
  1007.          LR    9,2           ???                               @SC87166 03503000
  1008.          SCAN  (4),RTRN1                                       @SC87166 03503500
  1009. SHOHLP   HELP  (4),RTRN1                                       @SC87166 03504000
  1010. *                                                                       03504500
  1011. SETCMDS  CSECT                                                 @SC90040 03505000
  1012. SHOTRNKW KW    '&LOCKSHF',SHOLCK                               @SC91275 03505500
  1013.          KW    '&CHARSET',SHOALF                               @SC91275 03506000
  1014.          KW    ,                                               @SC90040 03506500
  1015. *                                                                       03507000
  1016. SHOFILKW KW    '&ATTTYPE',SHOFILT                              @SC86295 03507500
  1017.          KW    '&LONGLIN',SHOLNG,MIN=2                         @SC88120 03508000
  1018.          KW    '&COLLISN',SHOCLSN,MIN=2                        @SC90033 03508500
  1019.          KW    '&OVERWRI',SHOOVWR                              @SC90033 03509000
  1020.          KW    '&AALRECL',SHOLR                                @SC86133 03509500
  1021.         KFILKW                                                 @SC87166 03510000
  1022.          KW    '&CHARSET',SHOFALF                              @SC90040 03510500
  1023.          KW    ,                                               @SC87012 03511000
  1024. *                                                                       03511500
  1025. SHOMRGKW KW    '&AAALEFT',SHOLFT                               @SC87253 03512000
  1026.          KW    '&AARIGHT',SHORGT                               @SC87253 03512500
  1027.          KW    ,                                               @SC87253 03513000
  1028. *                                                                       03513500
  1029. SHORECKW KW    '&ENDOFLI',SHOEOL                               @SC86133 03514000
  1030.          KW    '&ENDOFPA',SHOEOL                               @SC86133 03514500
  1031.          KW    '&AAAAEOL',SHOEOL,MIN=3                         @SC86133 03515000
  1032.          KW    '&PACKLEN',SHOSIZ                               @SC90150 03515500
  1033. SHOPSKW  KW    '&PACKSIZ',SHOSIZ                               @SC86133 03516000
  1034.          KW    '&PADCHAR',SHOPADC,MIN=5                        @SC86164 03516500
  1035.          KW    '&PADDING',SHOPADN,MIN=3                        @SC86164 03517000
  1036.          KW    '&AAQUOTE',SHOQUO                               @SC86133 03517500
  1037.          KW    '&STARTOP',SHOMARK                              @SC86133 03518000
  1038.          KW    '&TIMEOUT',SHOTIMO                              @SC86164 03518500
  1039.          KW    '&APARITY',SHOPRTY                              @SC88288 03519000
  1040.          KW    ,                                               @SC86133 03519500
  1041. *                                                                       03520000
  1042. SHOTAKKW KW    '&AAAECHO',SHOECO,MIN=3                         @SC86171 03520500
  1043.          KW    '&ERRACTI',SHOHLT,MIN=3                         @SC86171 03521000
  1044.          KW    ,                                               @SC86171 03521500
  1045. *                                                                       03522000
  1046. SHOFORKW KW    '&APREFIX',SHOPFX                               @HF86223 03522500
  1047.          KW    '&ASUFFIX',SHOSFX                               @HF86223 03523000
  1048.          KW    ,                                               @HF86223 03523500
  1049. *                                                                       03524000
  1050. SHORETKW KW    '&INITIAL',SHORETI                              @SC86345 03524500
  1051.          KW    '&PACKETS',SHORETN                              @SC86345 03525000
  1052.          KW    ,                                               @SC86345 03525500
  1053. SET      CSECT                                                 @SC90040 03526000
  1054. *                                                                       03526500
  1055. SHORALL  OI    SFLG,ALLF+ASRF Do just all send/recv items      @SC86295 03527000
  1056.          LA    14,SHOHLP     Just help if SET                  @SC87166 03527500
  1057. SHORAL2  BAL   2,SHOKW       Get ptr to kw send or receive     @SC86133 03528000
  1058.          BER   14            Help for SET                      @SC87166 03528500
  1059.          L     15,SHOPTR     Output line buffer ptr            @SC86227 03529000
  1060.          LA    1,CMD                                           @SC86227 03529500
  1061.          SR    15,1          Anything there?                   @SC86227 03530000
  1062.          BNP   SHORAL3       No                                @SC86227 03530500
  1063.          ST    1,SHOPTR      Yes, reset ptr                    @SC86227 03531000
  1064.          WTEXT (1),(15)      And write it out                  @SC86227 03531500
  1065. SHORAL3  DS    0H                                              @SC86227 03532000
  1066.          MVC   CMD(2),=C'  '                                   @SC86133 03532500
  1067.          MVC   CMD+2(15),0(6) Copy send or receive or ...      @SC89226 03533000
  1068.          LA    0,CMD+2(7)    Point past category               @SC86316 03533500
  1069.          ST    0,SHOPTR      Save output ptr                   @SC86316 03534000
  1070.          L     1,SHOTMP+12   Start at beginning                @SC87166 03534500
  1071.          ICM   14,7,KWADR(1) Ptr to 1st routine                @SC90239 03535000
  1072.          BR    14                                              @SC86171 03535500
  1073. *                                                                       03536000
  1074. SHOLCK   LA    4,SETOOFRC    On, Off, Forced                   @SC91275 03536500
  1075.          CLI   SETXI,X'97'   SET or SHOW?                      @SC91275 03537000
  1076.          BE    SHOLCK1       SET - do it directly              @SC91275 03537500
  1077.          TM    LCKFRC,1                                        @SC91275 03538000
  1078.          BZ    SHOLCK1                                         @SC91275 03538500
  1079.          LA    4,SETOFRC     Just Forced                       @SC91275 03539000
  1080. SHOLCK1  BAL   14,SHOXY      Get ON vs. OFF or FORCED          @SC91275 03539500
  1081.           OI   SCAPA,X'20'                                     @SC91275 03540000
  1082. *                                                                       03540500
  1083. SHOALF   LA    4,SETALFKW    NOTE: this must be last parm      @SC90040 03541000
  1084.          LA    8,TRNALF      Ptr to transfer character name    @SC90040 03541500
  1085.          B     SHOALFC       Processing same as file char set  @SC90040 03542000
  1086. *                                                                       03542500
  1087.          AIF   ('&ATTTYPE'(1,1) NE '&AAATEXT'(1,1)).CMPAT02    @SC92300 03543000
  1088. SETFT    ICM   15,15,LEN     SET F T ...   **COMPAT**          @SC87166 03543500
  1089.          LA    8,TYPFIL      In case just 'SET F T'            @SC91320 03544000
  1090.          BNP   SETFILET      Nothing after: 'SET FILE-TYPE T'  @SC87166 03544500
  1091. .CMPAT02 ANOP                                                  @SC92300 03545000
  1092. *                                                                       03545500
  1093. SHOFILT  LA    4,SETFIL      List of possibles                 @SC86151 03546000
  1094.          LA    6,TYPFIL                                        @SC87166 03546500
  1095.          BAL   14,SHOBRV     Get full name from abbrev.        @SC87166 03547000
  1096.           NOP  0                                               @SC87166 03547500
  1097. SHOLNG   LA    4,SETLNGKW    List of possibles                 @SC88120 03548000
  1098.          LA    6,TRNCFL                                        @SC88120 03548500
  1099.          BAL   14,SHOBRV     Get full name from abbrev.        @SC88120 03549000
  1100.           NOP  0                                               @SC88120 03549500
  1101. SHOCLSN  LA    4,SETCLSKW    List of COLLISION options         @SC90033 03550000
  1102.          LA    6,CLSNFL                                        @SC90033 03550500
  1103.          BAL   14,SHOBRV                                       @SC90033 03551000
  1104.           NOP  0                                               @SC90033 03551500
  1105. SHOOVWR  LA    4,SETOVWKW    List of possibles                 @SC90033 03552000
  1106.          BAL   14,SHOXY                                        @SC90033 03552500
  1107.           OI   FL3,SVATT                                       @SC90033 03553000
  1108. SHOLR    SR    4,4                                             @SC86133 03553500
  1109.          L     8,MAXLRC      Upper limit                       @SC87166 03554000
  1110.          ICM   4,3,FILLRC                                      @SC88120 03554500
  1111.          BAL   14,SHONUM     Print it                          @SC86133 03555000
  1112.           B    SETLR                                           @SC87166 03555500
  1113.          KFILSHO ,                                             @SC87012 03556000
  1114. SHOFALF  LA    4,SETFALFK    NOTE: this must be last parm      @SC90040 03556500
  1115.          LA    8,FILALF      Ptr to file character name        @SC90040 03557000
  1116.          LA    9,2*LALF                                        @SC91325 03557500
  1117.          CLC   FILALF,FILALF2                                  @SC91325 03558000
  1118.          BNE   SHOALF2                                         @SC91325 03558500
  1119. SHOALFC  LA    9,LALF                                          @SC91325 03559000
  1120. SHOALF2  DS    0H                                              @SC91325 03559500
  1121.          BAL   14,SHOCHRN    Get name                          @SC90040 03560000
  1122.           B    SETSCN                                          @SC90040 03560500
  1123.          B     SHOGRPZ                                         @SC86295 03561000
  1124. *                                                                       03561500
  1125. SHOLFT   L     4,LMARG                                         @SC87253 03562000
  1126.          BAL   14,SHONBIG    Print it                          @SC87253 03562500
  1127.           B    RTRN0                                           @SC87253 03563000
  1128. SHORGT   L     4,RMARG                                         @SC87253 03563500
  1129.          BAL   14,SHONBIG    Print it                          @SC87253 03564000
  1130.           B    RTRN0                                           @SC87253 03564500
  1131.          B     SHOGRPZ                                         @SC87253 03565000
  1132. *                                                                       03565500
  1133. SHOWARN  BAL   14,SHOOO      On or off   ***COMPAT***          @SC90033 03566000
  1134.           OI   FL1,REN                                         @SC90033 03566500
  1135. SHOAPP   BAL   14,SHOOO      On or off   ***COMPAT***          @SC90033 03567000
  1136.           OI   FL3,APPN                                        @SC90033 03567500
  1137. *                                                                       03568000
  1138. SHOECO   BAL   14,SHOOO      On or off                         @SC86171 03568500
  1139.           OI   FL2,ECHO                                        @SC87166 03569000
  1140. SHOHLT   LA    4,SETSWT      List of possibles                 @SC87166 03569500
  1141.          BAL   14,SHOXY                                        @SC86171 03570000
  1142.           OI   FL5,TKHLT                                       @SC87166 03570500
  1143.          B     SHOGRPZ                                         @SC86171 03571000
  1144. *                                                                       03571500
  1145. SHOPFX   LA    8,PREFIX      Point to prefix                   @HF86223 03572000
  1146.          LA    4,FORMAXL     Max length                        @SC87268 03572500
  1147.          BAL   14,SHOSTR     Print message                     @SC86224 03573000
  1148.           B    RTRN0                                           @SC87268 03573500
  1149. SHOSFX   LA    8,SUFFIX      Point to suffix                   @HF86223 03574000
  1150.          LA    4,FORMAXL     Max length                        @SC87268 03574500
  1151.          BAL   14,SHOSTR     Print message                     @SC86224 03575000
  1152.           B    RTRN0                                           @SC87268 03575500
  1153.          B     SHOGRPZ                                         @HF86223 03576000
  1154. *                                                                       03576500
  1155. SHORETI  L     4,MAXTNT      Initial retry limit               @SC86345 03577000
  1156.          BAL   14,SHONBIG    Print it                          @SC87166 03577500
  1157.           B    RTRN0                                           @SC87166 03578000
  1158. SHORETN  L     4,MAXTRY      Normal retry limit                @SC86345 03578500
  1159.          BAL   14,SHONBIG    Print it                          @SC87166 03579000
  1160.           B    RTRN0                                           @SC87166 03579500
  1161.          B     SHOGRPZ                                         @SC86345 03580000
  1162. *                                                                       03580500
  1163. SHOEOL   SR    4,4                                             @SC86133 03581000
  1164.          IC    4,REOL(5)                                       @SC86133 03581500
  1165.          BAL   14,SHOCTL     Print it                          @SC87166 03582000
  1166.           B    SETEOL                                          @SC87166 03582500
  1167.          LA    1,SHOPSKW     Skip aliases                      @SC86133 03583000
  1168. SHOSIZ   L     8,=A(KMAXE)   Limit                             @SC87166 03583500
  1169.          LR    3,5                                             @SC87166 03584000
  1170.          SLA   3,2           Get fullword index                @SC87166 03584500
  1171.          L     4,RPSIZ(3)                                      @SC87166 03585000
  1172.          BAL   14,SHONUM     Print number                      @SC86133 03585500
  1173.           B    SETSIZ                                          @SC87166 03586000
  1174. SHOPADC  SR    4,4                                             @SC86164 03586500
  1175.          IC    4,RPADC(5)    Pad character                     @SC86164 03587000
  1176.          BAL   14,SHOCTL                                       @SC87166 03587500
  1177.           B    SETPADC                                         @SC87166 03588000
  1178. SHOPADN  SR    4,4                                             @SC86164 03588500
  1179.          LA    8,KMAX        Same upper limit as packets       @SC87166 03589000
  1180.          IC    4,RPADN(5)    Pad count                         @SC86164 03589500
  1181.          BAL   14,SHONUM                                       @SC86164 03590000
  1182.           B    SETPADN                                         @SC87166 03590500
  1183. SHOQUO   LA    8,RCTLQ(5)                                      @SC86133 03591000
  1184.          BAL   14,SHOCHRA    Print as ascii                    @SC86133 03591500
  1185.           B    SETRCTLQ                                        @SC87166 03592000
  1186. SHOMARK  SR    4,4                                             @SC86133 03592500
  1187.          IC    4,RMARK(5)                                      @SC86133 03593000
  1188.          BAL   14,SHOCTL                                       @SC87166 03593500
  1189.           B    RTRN0                                           @SC87166 03594000
  1190. SHOTIMO  SR    4,4                                             @SC86164 03594500
  1191.          IC    4,RTIMO(5)    Timeout limit                     @SC86164 03595000
  1192.          BAL   14,SHONBIG                                      @SC87166 03595500
  1193.           B    SETTIMO                                         @SC87166 03596000
  1194. SHOPRTY  LA    4,SETPAR                                        @SC88288 03596500
  1195.          LA    3,RPRTY(5)    Ptr to proper flag                @SC88288 03597000
  1196.          BAL   14,SHOXY                                        @SC88288 03597500
  1197.           OI   0(3),DAT8                                       @SC88288 03598000
  1198. *                                                                       03598500
  1199. SHOGRPZ  TM    SFLG,ASRF     Doing just receive/send?          @SC86295 03599000
  1200.          BO    SHOZZW        Yes, write last line              @SC86227 03599500
  1201.          LM    1,2,SHOTMP    Get top level ptr, return adr     @SC87166 03600000
  1202.          LR    14,2                                            @SC86224 03600500
  1203.          BAL   2,SHOKW       Get ptr to name                   @SC86133 03601000
  1204.          LA    1,0(7,6)      Advance to next                   @SC86133 03601500
  1205.          BR    14                                              @SC86224 03602000
  1206. *                                                                       03602500
  1207. SHOMULT  LR    5,1           Save ptr to current option        @SC88168 03603000
  1208.          LR    1,6           Use ptr to list of suboptions     @SC88168 03603500
  1209. SHOMULQ  ICM   14,7,KWADR(1) Get ptr to handler (assume OI x,y)@SC90239 03604000
  1210.          BAL   2,SHOKW       Get ptrs to KW string, fix SETXI  @SC88168 03604500
  1211.          EX    0,SETXI       TM x,y                            @SC88168 03605000
  1212.          BNO   SHOMULP       Not this one                      @SC88168 03605500
  1213.          MVI   0(15),C','    Yes, punctuate display            @SC88168 03606000
  1214.          LA    15,1(15)                                        @SC88168 03606500
  1215.          LR    8,6                                             @SC88168 03607000
  1216.          LR    9,7                                             @SC88168 03607500
  1217.          BAL   2,EDCHAR      Copy this KW to display           @SC88168 03608000
  1218. SHOMULP  LA    1,0(7,6)      On to next in list                @SC88168 03608500
  1219.          CLI   KWLEN(1),254  End of list?                      @SC90239 03609000
  1220.          BL    SHOMULQ       No, keep checking                 @SC88168 03609500
  1221.          LR    14,4          Proper place for return adr       @SC88168 03610000
  1222.          LR    1,5           Restore ptr to current option     @SC88168 03610500
  1223.          B     SHOZZZ        End of item                       @SC88168 03611000
  1224. *                                                                       03611500
  1225. SHOLIST  LTR   5,5           Length of list                    @SC86355 03612000
  1226.          BZ    SHOZZ         Empty, we're done                 @SC86355 03612500
  1227.          LA    0,CMD+75      Set right margin                  @SC86355 03613000
  1228.          MVI   0(15),C' '    Start with blank                  @SC86355 03613500
  1229.          B     *+8                                             @SC86355 03614000
  1230. SHOLSLP  MVI   0(15),C','    Insert delimiter                  @SC86355 03614500
  1231.          LA    15,1(15)                                        @SC86355 03615000
  1232.          CR    15,0          Any room?                         @SC86355 03615500
  1233.          BL    SHOLSED       Yes, ok                           @SC86355 03616000
  1234.          LA    1,CMD         No, dump line                     @SC86355 03616500
  1235.          SR    15,1                                            @SC86355 03617000
  1236.          WTEXT (1),(15)                                        @SC86355 03617500
  1237.          MVI   CMD,C' '                                        @SC86355 03618000
  1238.          LA    15,CMD+1      Start indented                    @SC86355 03618500
  1239.          LA    0,CMD+75                                        @SC86355 03619000
  1240. SHOLSED  SR    4,4                                             @SC86355 03619500
  1241.          IC    4,0(3)        Get 1-byte item                   @SC86355 03620000
  1242.          BAL   2,EDDEC       Format it                         @SC86355 03620500
  1243.          LA    3,1(3)        Point to next item in list        @SC86355 03621000
  1244.          BCT   5,SHOLSLP                                       @SC86355 03621500
  1245.          B     SHOZZ         Finished list                     @SC86355 03622000
  1246. *                                                                       03622500
  1247. SHOKW    MVC   SETXI+1(3),1(14) Copy instr operands            @SC87166 03623000
  1248.          CLI   SETXI,X'97'   'OI' if SET, but 'TM' if SHOW     @SC87166 03623500
  1249.          LA    6,KWNAME(1)   Ptr to name                       @SC90239 03624000
  1250.          LA    7,0           Preserve CC                       @SC86133 03624500
  1251.          IC    7,KWLEN(1)    Length (assumes high bytes clear) @SC90239 03625000
  1252.          LA    7,1(7)                                          @SC86133 03625500
  1253.          BR    2                                               @SC86133 03626000
  1254. *                                                                       03626500
  1255. SHOCTL   LA    8,ABL-1       Max control character (ASCII)     @SC87166 03627000
  1256.          CLI   TRMTP,C'F'    Full-screen non-transparent?      @SC92030 03627500
  1257.          BE    SHONBIG       Yes, allow any packet char, etc.  @SC92030 03628000
  1258.          TM    FL1,TSTF                                        @SC86295 03628500
  1259.          BZ    SHONUM                                          @SC87166 03629000
  1260. SHONBIG  L     8,=F'999999998' Almost anything                 @SC87166 03629500
  1261. SHONUM   BAL   2,SHOKW                                         @SC86133 03630000
  1262.          BE    SETNUM2       Get value for SET                 @SC87166 03630500
  1263.          BAL   2,SHONAM      Copy option name                  @SC86209 03631000
  1264.          BAL   2,EDDEC       Edit (R4) as decimal              @SC86295 03631500
  1265.          B     SHOZZ                                           @SC86133 03632000
  1266. *                                                                       03632500
  1267. SHOCHRA  MVC   TMP,0(8)      Copy ascii char                   @SC86133 03633000
  1268.          PTEXT SETOOKW+KWNAME,3,AREG=8,LREG=9                  @SC91320 03633500
  1269.          TM    TMP,X'60'     Is it printable?                  @SC87008 03634000
  1270.          BZ    SHOCHRN       No, say it's OFF                  @SC87008 03634500
  1271.          TR    TMP,ATOED     Convert to EBCDIC                 @SC89301 03635000
  1272.          LA    8,TMP                                           @SC86133 03635500
  1273.          B     SHOCHR                                          @SC86224 03636000
  1274. SHOSTR   BAL   2,SHOKW       Get ptrs to name                  @SC87268 03636500
  1275.          BE    SETSTR        Branch to dispatch for SET        @SC87268 03637000
  1276.          SR    9,9           Variable-length string            @SC86224 03637500
  1277.          IC    9,0(8)        Get length                        @SC86224 03638000
  1278.          LA    8,1(8)        Ptr to text                       @SC86224 03638500
  1279.          B     SHOCHRD                                         @SC87268 03639000
  1280. SHOCHR   LA    9,1           Length is 1                       @SC86224 03639500
  1281. SHOCHRN  BAL   2,SHOKW       Get ptrs to name                  @SC86224 03640000
  1282.          BER   14            Branch to dispatch for SET        @SC87166 03640500
  1283. SHOCHRD  BAL   2,SHONAM      Copy option name                  @SC87268 03641000
  1284.          BAL   2,EDCHAR      Append string at (R8)             @SC87034 03641500
  1285.          B     SHOZZ         Print message                     @SC87034 03642000
  1286. *                                                                       03642500
  1287. SHOBRV   CLI   SETXI,X'97'   SET or SHOW?                      @SC87166 03643000
  1288.          LR    8,6           Save ptr to code field            @SC91320 03643500
  1289.          BE    SETSCN                                          @SC87166 03644000
  1290.          LR    9,14          Save return adr                   @SC87166 03644500
  1291.          LR    8,1           Save list ptr                     @SC87166 03645000
  1292.          LR    1,4           Use list of suboptions            @SC87166 03645500
  1293.          ICM   7,4,0(6)      Use code to look up               @SC91320 03646000
  1294.          ICM   7,8,*         Indicate just search              @SC87166 03646500
  1295.          BAL   14,SCAN                                         @SC87166 03647000
  1296.           CR   0,0           These two skipped                 @SC87166 03647500
  1297.           LR   4,1            if bad value                     @SC87166 03648000
  1298.          LR    1,8           Retrieve ptrs                     @SC87166 03648500
  1299.          LR    14,9                                            @SC87166 03649000
  1300.          B     SHOXY         Display it                        @SC87166 03649500
  1301. *                                                                       03650000
  1302. SHOOO    LA    4,SETOOKW     Ptr to on/off                     @SC87166 03650500
  1303. SHOXY    BAL   2,SHOKW       Set up name                       @SC86133 03651000
  1304.          BE    SETSCN        Parse value for SET               @SC87166 03651500
  1305.          LA    8,KWNAME(4)   Value if off                      @SC90239 03652000
  1306.          SR    9,9                                             @SC87166 03652500
  1307.          IC    9,KWLEN(4)    Length of name - 1                @SC90239 03653000
  1308.          EX    0,SETXI       Test bit                          @SC87166 03653500
  1309.          BZ    *+12                                            @SC86133 03654000
  1310.           LA   8,KWNAME+1(9,8) Flag is on, advance to other    @SC90239 03654500
  1311.           IC   9,KWNAME+1(9,4) Length-1 of other item          @SC90239 03655000
  1312.          LA    9,1(9)                                          @SC86133 03655500
  1313. SHOXL    BAL   2,SHONAM      Copy option name                  @SC86209 03656000
  1314.          BAL   2,EDCHAR      Append string at (R8)             @SC86295 03656500
  1315.          SR    15,9          Back up to string                 @SC87034 03657000
  1316.          TR    0(30,15),LOCASE And make it lower case          @SC87034 03657500
  1317.          AR    15,9          Resume                            @SC87034 03658000
  1318. SHOZZ    LA    1,0(7,6)      Advance to next option            @SC88168 03658500
  1319. SHOZZZ   ST    15,SHOPTR     Save end of display buffer        @SC88168 03659000
  1320.          L     3,=A(SETCMDS) Recover base reg.                 @SC90040 03659500
  1321.          LA    14,4(14)      Skip over SET branch              @SC87166 03660000
  1322.          CLM   14,7,=AL3(SHOTABSZ)                             @SC86355 03660500
  1323.          BER   14            Special treatment for tabs        @SC86355 03661000
  1324.          CLM   14,7,=AL3(SHODEBZ)                              @SC88168 03661500
  1325.          BER   14            Special treatment for DEBUG, too  @SC88168 03662000
  1326.          TM    SFLG,ALLF     Doing all?                        @SC86295 03662500
  1327.          BOR   14            And resume if yes                 @SC86227 03663000
  1328. SHOZZW   LA    1,CMD         No, get address of buffer         @SC86227 03663500
  1329.          SR    15,1          Get length                        @SC86227 03664000
  1330.          WTEXT (1),(15)      Write it out                      @SC86227 03664500
  1331.          B     RTRN0         That's all                        @SC86295 03665000
  1332. *                                                                       03665500
  1333. SHONAM   LA    15,CMD        Output message buffer             @SC86209 03666000
  1334.          L     0,SHOPTR      End of prev. msg                  @SC86227 03666500
  1335.          CR    0,15          Empty?                            @SC86227 03667000
  1336.          BE    SHON1         Yes, start here                   @SC86227 03667500
  1337.          LA    1,CMD+23      2nd column                        @SC86227 03668000
  1338.          SR    1,0           Far enough?                       @SC86227 03668500
  1339.          BP    SHONF         Yes, blank fill                   @SC86227 03669000
  1340.          AH    1,=H'23'      Try 3rd column                    @SC86227 03669500
  1341.          BP    SHONF         OK                                @SC86227 03670000
  1342.          SR    0,15          No room, dump line                @SC86227 03670500
  1343.          WTEXT (15),(0)                                        @SC86227 03671000
  1344.          LA    15,CMD        And start over                    @SC86227 03671500
  1345.          B     SHON1                                           @SC86227 03672000
  1346. SHONF    SR    15,15                                           @SC86295 03672500
  1347.          ICM   15,8,BLANK                                      @SC86295 03673000
  1348.          MVCL  0,14          Fill with blanks to next column   @SC86227 03673500
  1349.          LR    15,0          New output ptr                    @SC86227 03674000
  1350. SHON1    MVC   0(40,15),0(6) Copy option name                  @SC87034 03674500
  1351.          TR    1(39,15),LOCASE And beautify it                 @SC87034 03675000
  1352.          AR    15,7          Space over it                     @SC86209 03675500
  1353.          INITSTR '&AAAAAIS'                                    @SC92300 03676000
  1354.          BR    2                                               @SC86209 03676500
  1355.          DROP  3                                               @SC90040 03677000
  1356. *                                                                       03677500
  1357.          LOCALS ,                                              @SC86295 03678000
  1358. SHOTMP   DS    4F                                              @SC87166 03678500
  1359. SHOPTR   DS    A             More temporaries                  @SC86227 03679000
  1360. SETXI    DS    F             XI executable instr               @SC86273 03679500
  1361. SFLG     DS    X             Local flags                       @SC86295 03680000
  1362. ALLF     EQU   X'80'         Doing SHOW ALL                    @SC86295 03680500
  1363. ASRF     EQU   X'40'         Doing SHOW REC or SHOW SEND       @SC86295 03681000
  1364. SHODBG   DS    X             Temp for DEBUG flags              @SC88168 03681500
  1365. SHOW     EXIT                                                           03682000
  1366.          TITLE 'STATUS Routine - display latest error, etc.'   @SC86295 03682500
  1367. * Exit: R15=0.  ERRNUM unchanged.                                       03683000
  1368. STATUS   ENTER                                                 @SC86156 03683500
  1369.          CLI   ERRNUM,ERRNFT Actual error?                     @BS86090 03684000
  1370.          BNH   STAMSG        No                                @BS86090 03684500
  1371.          CLI   ERRNUM,ERRKCE Last command invalid?             @SC86295 03685000
  1372.          BE    STAMSG        Yes, do not show last file        @HF86232 03685500
  1373.          CLI   FILNAM,0      File name defined?                @BS86090 03686000
  1374.          BE    STAMSG        No                                @BS86090 03686500
  1375.          INITSTR '&LASTFIL',CMD,REG=7                          @SC92300 03687000
  1376.          LA    1,FILNAM                                        @SC86295 03687500
  1377.          BAL   2,STAFSP      Copy name and print               @SC86295 03688000
  1378. STAMSG   ICM   4,15,NSENT    Number of files sent              @SC86295 03688500
  1379.          BZ    STASNTZ                                         @SC86295 03689000
  1380.          LA    15,CMD        Start of message buffer           @SC86295 03689500
  1381.          BAL   2,EDDEC       Format number as decimal          @SC86295 03690000
  1382.          INITSTR '&FSENLST'                                    @SC92300 03690500
  1383.          BAL   2,STAPM15     Show message                      @SC86295 03691000
  1384. STASNTZ  ICM   0,15,PAKCNT   Any transfer statistics?          @SC86295 03691500
  1385.          BZ    STADATR       No, skip it                       @SC86316 03692000
  1386.          ICM   6,7,=C'&PKTABBR'                                @SC86295 03692500
  1387.          BAL   3,STADPR      Format msg                        @SC86295 03693000
  1388.          ICM   0,15,SECTOT   Any duration?                     @SC86295 03693500
  1389.          BZ    STADATR       No, must have been very short     @SC86316 03694000
  1390.          ICM   6,7,=C'&SECABBR'                                @SC86295 03694500
  1391.          BAL   3,STADPR      Format msg                        @SC86295 03695000
  1392.          INITSTR '&BYTPSEC',CMD                                @SC92300 03695500
  1393.          L     0,SECTOT                                        @SC86295 03696000
  1394.          LM    4,5,DSKTOT                                      @SC86295 03696500
  1395.          BAL   2,STAVB       Format ratio                      @SC86295 03697000
  1396.          ICM   1,15,BAUD     Efficiency only if speed defined  @SC93014 03697500
  1397.          BNP   STADEFCZ                                        @SC93014 03698000
  1398.          MVC   0(3,15),=C' = '                                 @SC93014 03698500
  1399.          LA    15,3(,15)                                       @SC93014 03699000
  1400.          M     4,=F'1000'    *10*100 for bits/byte and percent @SC93014 03699500
  1401.          L     0,BAUD        Compute percentage of line speed  @SC93014 03700000
  1402.          BAL   2,STAVB       Format ratio                      @SC93014 03700500
  1403.          INITSTR '% (&AASPEED.&AAAAAIS'  Remind of rating      @SC93014 03701000
  1404.          L     4,BAUD                                          @SC93014 03701500
  1405.          BAL   2,EDDEC                                         @SC93014 03702000
  1406.          MVI   0(15),C')'                                      @SC93014 03702500
  1407.          LA    15,1(,15)                                       @SC93014 03703000
  1408. STADEFCZ DS    0H                                              @SC93014 03703500
  1409.          BAL   2,STAPM15     Print line                        @SC86295 03704000
  1410. STADATR  ICM   4,15,RTRCNT   Any retries?                      @SC86316 03704500
  1411.          BZ    STADATZ       No                                @SC86316 03705000
  1412.          LA    15,CMD        Yes, issue message                @SC86316 03705500
  1413.          BAL   2,EDDEC                                         @SC86316 03706000
  1414.          INITSTR '&REPTCNT'                                    @SC92300 03706500
  1415.          BAL   2,STAPM15     Print line                        @SC86316 03707000
  1416.          XC    TINSV(48),TINSV Completely clear data           @SC88325 03707500
  1417.          KCALL OPTPKT        Get best packet size              @SC88325 03708000
  1418.          LTR   4,15          Valid?                            @SC86345 03708500
  1419.          BNP   STADATZ       No, skip it                       @SC86345 03709000
  1420.          INITSTR '&OPTSIZE',CMD                                @SC92300 03709500
  1421.          BAL   2,EDDEC       Format it                         @SC86345 03710000
  1422.          BAL   2,STAPM15                                       @SC86345 03710500
  1423. STADATZ  ICM   4,15,RECTRC   Any truncated records?            @SC87268 03711000
  1424.          BZ    STATRCZ       No, ok                            @SC87268 03711500
  1425.          LA    15,CMD        Yes, issue message                @SC87268 03712000
  1426.          BAL   2,EDDEC                                         @SC87268 03712500
  1427.          INITSTR '&MRCTRNC'                                    @SC92300 03713000
  1428.          BAL   2,STAPM15                                       @SC87268 03713500
  1429. STATRCZ  DS    0H                                              @SC87268 03714000
  1430.          ICM   4,15,RECFLD   Any folded records?               @SC88120 03714500
  1431.          BZ    STATFDZ       No, ok                            @SC88120 03715000
  1432.          LA    15,CMD        Yes, issue message                @SC88120 03715500
  1433.          BAL   2,EDDEC                                         @SC88120 03716000
  1434.          INITSTR '&RECFOLD'                                    @SC92300 03716500
  1435.          BAL   2,STAPM15                                       @SC88120 03717000
  1436. STATFDZ  DS    0H                                              @SC88120 03717500
  1437. STAPEMSG DS    0H                                              @SC91064 03718000
  1438.          SR    5,5                                             @SC86156 03718500
  1439.          IC    5,ERRNUM      Get offset into error table       @SC86156 03719000
  1440.          SLL   5,2           Get fullword index                @SC86156 03719500
  1441.          A     5,=A(ERRTAB)  Pointer address                   @SC89215 03720000
  1442.          L     1,0(5)        Msg ptr                           @SC86156 03720500
  1443.          SR    0,0                                             @SC86268 03721000
  1444.          SLDL  0,8           Msg length                        @SC86316 03721500
  1445.          SRL   1,8           Realign adr                       @SC86316 03722000
  1446.          WTEXT (1),(0)       Print message                     @SC86268 03722500
  1447.          CLI   ERRNUM,ERRTRC Cancelled?                        @SC86316 03723000
  1448.          BNE   STACKAB       No                                @SC86316 03723500
  1449.          SR    1,1                                             @SC86316 03724000
  1450.          CLI   REASON,STACNN Within table?                     @SC90033 03724500
  1451.          BH    *+8           No, must be new                   @SC86316 03725000
  1452.          IC    1,REASON      Ok, get the complaint code        @SC86316 03725500
  1453.          SLL   1,3           Index into table                  @SC86316 03726000
  1454.          LA    1,STACNTB(1)                                    @SC86316 03726500
  1455.          LA    0,8           Length of items                   @SC86316 03727000
  1456.          WTEXT (1),(0)                                         @SC86316 03727500
  1457. STACKAB  CLI   ERRNUM,ERRABO Micro aborted?                    @BS86090 03728000
  1458.          BE    *+12          Yes                               @SC87338 03728500
  1459.          CLI   ERRNUM,ERRDIE No, disk I/O error?               @SC87338 03729000
  1460.          BNE   STARET        No                                @BS86090 03729500
  1461.          ICM   0,15,EMSGL    Yes, any message?                 @SC86268 03730000
  1462.          BZ    STARET        No                                @BS86090 03730500
  1463.          L     1,EMSGP                                         @BS86090 03731000
  1464.          WTEXT (1),(0)       Yes, show it                      @SC86268 03731500
  1465. STARET   TM    FL1,TSTF                                        @SC89089 03732000
  1466.          BZ    RTRN0         Skip this message unless testing  @SC89089 03732500
  1467.          LM    3,4,STKLO     Get start and end of stack use    @SC89089 03733000
  1468.          SR    4,3           Get length (is mult. of 8)        @SC89089 03733500
  1469.          SRL   4,3           Convert to doublewords            @SC89089 03734000
  1470.          LA    15,CMD        Sart of msg buffer                @SC89089 03734500
  1471.          BAL   2,EDDEC       Format number                     @SC89089 03735000
  1472.          INITSTR '&DWRDSTK'                                    @SC92300 03735500
  1473.          BAL   2,STAPM15                                       @SC89089 03736000
  1474.          B     RTRN0                                           @SC89089 03736500
  1475. *                                                                       03737000
  1476. STADPR   INITSTR '&ZZBYTES',CMD                                @SC92300 03737500
  1477.          MVC   0(8,15),=C'/___: S='                            @SC92300 03738000
  1478.          STCM  6,7,1(15)     Fill in unit name (pkt or sec)    @SC92300 03738500
  1479.          LA    15,8(,15)                                       @SC92300 03739000
  1480.          LM    4,5,TOUTOT                                      @SC86295 03739500
  1481.          BAL   2,STAVB       Format ratio                      @SC86295 03740000
  1482.          MVC   0(3,15),=C' R='                                 @SC86295 03740500
  1483.          LA    15,3(15)                                        @SC86295 03741000
  1484.          LM    4,5,TINTOT                                      @SC86295 03741500
  1485.          BAL   2,STAVB       Format ratio                      @SC86295 03742000
  1486.          INITSTR '&REQUIRG'                                    @SC92300 03742500
  1487.          LR    4,0                                             @SC86295 03743000
  1488.          BAL   2,EDDEC       Format number of units            @SC86295 03743500
  1489.          MVI   0(15),C' '                                      @SC86295 03744000
  1490.          STCM  6,7,1(15)                                       @SC86295 03744500
  1491.          LA    0,4(15)       End of msg                        @SC86295 03745000
  1492.          BAL   2,STAPMSG     Print it                          @SC86295 03745500
  1493.          BR    3                                               @SC86295 03746000
  1494. *                                                                       03746500
  1495. STAVB    DR    4,0           Get ratio                         @SC86295 03747000
  1496.          AR    4,4                                             @SC86295 03747500
  1497.          CR    4,0                                             @SC86295 03748000
  1498.          BL    *+8                                             @SC86295 03748500
  1499.          A     5,F1          Round up                          @SC86295 03749000
  1500.          LR    4,5                                             @SC86295 03749500
  1501.          B     EDDEC         Format it                         @SC86295 03750000
  1502. *                                                                       03750500
  1503. * Display just error message and its backup explanations.      @SC91064 03751000
  1504. *  (same as STATUS)                                            @SC91064 03751500
  1505. PEMSG    ENTER ALT                                             @SC91064 03752000
  1506.          B     STAPEMSG      Do it                             @SC91064 03752500
  1507. *                                                                       03753000
  1508. * Table of reasons for rejecting Attribute packet              @SC86316 03753500
  1509. STACNTB  DC    C'-&ATTUNK.-&ATTLEN.-&ATTTYP.-&ATTDAT.'         @SC92300 03754000
  1510.          DC    C'-&ATTCRE.-&ATTACC.-&ATTARE.-&ATTPAS.'         @SC92300 03754500
  1511.          DC    C'-&ATTBLK.-&ATTACS.-&ATTENC.-&ATTDIS.'         @SC92300 03755000
  1512.          DC    C'-&ATTPRO.-&ATTPRO.-&ATTORI.-&ATTFRM.'         @SC92300 03755500
  1513.          DC    C'-&ATTSIN.-&ATTBLE.'                           @SC92300 03756000
  1514.          DC    (32-(*-STACNTB)/8)CL8'-??'                      @SC91109 03756500
  1515.          DC    C'-&AAAAEN.'                          32-       @SC92300 03757000
  1516. STACNCLS EQU   (*-STACNTB)/8 One extra reason stuck on the end @SC90033 03757500
  1517.          DC    C'-&COLLIS.'                                    @SC92300 03758000
  1518. STACNN   EQU   (*-STACNTB)/8-1                                 @SC90033 03758500
  1519.          LOCALS ,                                              @SC91109 03759000
  1520.          EXIT                                                  @SC91109 03759500
  1521.          TITLE 'DUMP Routine - print translation table'                 03760000
  1522. * Display current values in STORAG.                                     03760500
  1523. * Entry: SCANPTR string has option                                      03761000
  1524. * Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM unchanged.   03761500
  1525. DUMP     ENTER ,                                               @SC91109 03762000
  1526.          NTOKN N=DUMPH       A or E?                           @SC86156 03762500
  1527.          SCAN  DUMPKW,RTRN1                                    @SC86295 03763000
  1528. DUMPH    HELP  DUMPKW,RTRN1                                    @SC86295 03763500
  1529. *                                                                       03764000
  1530. DUMPKW   KW    '&AAAATOE',DUMPA                                @SC86156 03764500
  1531.          KW    '&CTRLCHR',DUMPCT                               @SC93173 03765000
  1532.          KW    '&AAAETOA',DUMPE                                @SC86156 03765500
  1533.          KW    '&AANAMES',DMPN                                 @SC86295 03766000
  1534.          KW    '&AATATOE',DUMPTA,MIN=2                         @SC87117 03766500
  1535.          KW    '&AATETOA',DUMPTE,MIN=2                         @SC87117 03767000
  1536.          AIF   ('&KTRACE' NE 'YES').NODUMTR                    @SC92169 03767500
  1537.          KW    '&AATRACE',DUMPTR,MIN=2                         @SC92169 03768000
  1538. .NODUMTR ANOP                                                  @SC92169 03768500
  1539.          KW    ,                                               @SC86156 03769000
  1540. *                                                                       03769500
  1541. DUMPTR   KTRACE DUMP         Dump trace table (only if enabled)@SC92169 03770000
  1542. *                                                                       03770500
  1543. DMPN     L     5,TSENT       Table ptr                         @SC86295 03771000
  1544.          ICM   6,15,NSENT    Number of files sent              @SC86295 03771500
  1545.          BNZ   DMPNL                                           @SC86295 03772000
  1546.          WTEXT '&NOFSENT'                                      @SC86295 03772500
  1547.          B     RTRN0                                           @SC86295 03773000
  1548.          USING ACTBUF,5                                        @SC91172 03773500
  1549. DMPNL    LA    7,CMD         Start of message buffer           @SC86295 03774000
  1550.          SR    15,15                                           @SC91172 03774500
  1551.          ICM   15,7,ACTBEG   Starting time                     @SC91172 03775000
  1552.          BAL   2,DMPTIM                                        @SC91172 03775500
  1553.          LA    0,FFDSP                                         @SC88092 03776000
  1554.          KCALL FSPEC,ACTFID  Copy name for display             @SC91172 03776500
  1555.          MVC   0(2,15),=C' ('                                  @SC88092 03777000
  1556.          LA    15,2(15)                                        @SC88092 03777500
  1557.          ICM   4,15,ACTSIZ   Get file size                     @SC91172 03778000
  1558.          BAL   2,EDDEC       Format into message               @SC88092 03778500
  1559.          MVC   0(2,15),=C'k)'                                  @SC88092 03779000
  1560.          LA    15,2(15)                                        @SC88092 03779500
  1561.          SR    2,2                                             @SC88092 03780000
  1562.          ICM   2,1,ACTERR    Get corresponding error code      @SC91172 03780500
  1563.          BZ    DMPNN         No error, that's fine             @SC88092 03781000
  1564.          SLL   2,2                                             @SC88092 03781500
  1565.          A     2,=A(ERRTAB)  Get ptr into error table          @SC89215 03782000
  1566.          SR    3,3                                             @SC88092 03782500
  1567.          IC    3,0(2)        Length of message                 @SC88092 03783000
  1568.          L     2,0(2)        And message ptr                   @SC88092 03783500
  1569.          MVC   0(4,15),=C' -- '                                @SC88092 03784000
  1570.          MVC   4(50,15),0(2) Copy message                      @SC88092 03784500
  1571.          LA    15,4(3,15)                                      @SC88092 03785000
  1572.          CLI   ACTERR,ERRTRC Cancelled?                        @SC91172 03785500
  1573.          BNE   DMPNN         No                                @SC91172 03786000
  1574.          SR    1,1                                             @SC91172 03786500
  1575.          CLI   ACTREA,STACNN Within table?                     @SC91172 03787000
  1576.          BH    *+8           No, must be new                   @SC91172 03787500
  1577.           IC   1,ACTREA      Ok, get the complaint code        @SC91172 03788000
  1578.          SLL   1,3           Index into table                  @SC91172 03788500
  1579.          A     1,=A(STACNTB)                                   @SC91172 03789000
  1580.          MVI   0(15),C' '    Leave a space                     @SC91172 03789500
  1581.          MVC   1(8,15),0(1)  Copy to message                   @SC91172 03790000
  1582.          LA    15,9(,15)     Length of items                   @SC91172 03790500
  1583. DMPNN    BAL   2,STAPM15     Display name (+ error)            @SC88092 03791000
  1584.          A     5,FLFID1      Next filespec                     @SC88092 03791500
  1585.          BCT   6,DMPNL                                         @SC86295 03792000
  1586.          LA    7,CMD         Start of message buffer           @SC91172 03792500
  1587.          ICM   15,15,TRANEND Quitting time                     @SC92210 03793000
  1588.          BAL   2,DMPTIM                                        @SC91172 03793500
  1589.          LR    15,7                                            @SC92300 03794000
  1590.          INITSTR '&FINISHD'                                    @SC92300 03794500
  1591.          BAL   2,STAPM15                                       @SC91172 03795000
  1592.          B     RTRN0                                           @SC86295 03795500
  1593.          DROP  5                                               @SC91172 03796000
  1594. * Display TOD from R15 as hh:mm:ss in buffer at R7;            @SC91172 03796500
  1595. *   return via R2; clobber R1,R4,R14,R15; update R7.           @SC91172 03797000
  1596. DMPTIM   LA    1,8           Length of output string           @SC91172 03797500
  1597.          BCTR  7,0           Allow for index to start at 1     @SC91172 03798000
  1598.          SR    4,4           Clear divisor                     @SC91172 03798500
  1599. DMTLP    IC    4,DVSR-1(1)   Get next divisor                  @SC91172 03799000
  1600.          LTR   4,4           See if time for a colon           @SC91172 03799500
  1601.          BNZ   DMTDIG        Not yet...                        @SC91172 03800000
  1602.          LA    14,C':'       Yes, put in colon                 @SC91172 03800500
  1603.          B     DMTSTOR                                         @SC91172 03801000
  1604. DMTDIG   SR    14,14         Set up next division              @SC91172 03801500
  1605.          DR    14,4          Get remainder for next digit      @SC91172 03802000
  1606.          LA    14,C'0'(,14)  Convert to printable              @SC91172 03802500
  1607. DMTSTOR  STC   14,0(1,7)     Store character in buffer         @SC91172 03803000
  1608.          BCT   1,DMTLP                                         @SC91172 03803500
  1609.          MVI   9(7),C' '     Leave a blank                     @SC91172 03804000
  1610.          LA    7,10(,7)      Space over string                 @SC91172 03804500
  1611.          BR    2                                               @SC91172 03805000
  1612. DVSR     DC    AL1(6,10,0,6,10,0,6,10)                         @SC91172 03805500
  1613. *                                                                       03806000
  1614. DUMPCT   LA    3,CTLTAB                                        @SC93173 03806500
  1615.          LA    7,160(,3)     End of table                      @SC93173 03807000
  1616.          B     DUMPAEX                                         @SC93173 03807500
  1617. DUMPA    LA    3,ATOE                                          @SC86156 03808000
  1618.          B     DUMPAE                                          @SC86156 03808500
  1619. DUMPE    LA    3,ETOA                                          @SC86156 03809000
  1620.          B     DUMPAE                                          @SC87117 03809500
  1621. DUMPTA   LA    3,TATOE                                         @SC87117 03810000
  1622.          B     DUMPAE                                          @SC87117 03810500
  1623. DUMPTE   LA    3,TETOA                                         @SC87117 03811000
  1624. DUMPAE   LA    7,256(,3)     End of table                      @SC93173 03811500
  1625. DUMPAEX  LA    4,4           Bytes per word                    @SC93173 03812000
  1626.          LA    5,15(3)       End of 1st line                   @SC86156 03812500
  1627.          LA    6,16          Bytes per line                    @SC86156 03813000
  1628. DUMPLL   LA    2,CMD         Output buffer                     @SC86156 03813500
  1629. DUMPLW   UNPK  0(9,2),0(5,3) Convert a word                    @SC86156 03814000
  1630.          TR    0(8,2),TRHEX  Hex notation                      @SC86156 03814500
  1631.          MVI   8(2),C' '     Leave a space between words       @SC86156 03815000
  1632.          LA    2,9(2)                                          @SC86156 03815500
  1633.          BXLE  3,4,DUMPLW    Do next word                      @SC86156 03816000
  1634.          LA    1,CMD         Done line of 4                    @SC86156 03816500
  1635.          LA    0,35                                            @SC86268 03817000
  1636.          WTEXT (1),(0)       Print it                          @SC86268 03817500
  1637.          BXLE  5,6,DUMPLL    Done line, go to next             @SC86156 03818000
  1638.          B     RTRN0                                                    03818500
  1639.          SPACE 3                                               @SC91172 03819000
  1640. * Extra entry point for dumping TOD (in sec) from R0 into buf  @SC91172 03819500
  1641. * at R1 and return updated buffer ptr in R15                   @SC91172 03820000
  1642. DUMPTOD  ENTER ALT                                             @SC91172 03820500
  1643.          LR    15,0          Time in sec                       @SC91172 03821000
  1644.          LR    7,1           Buffer ptr                        @SC91172 03821500
  1645.          BAL   2,DMPTIM      Dump it                           @SC91172 03822000
  1646.          LR    15,7                                            @SC91172 03822500
  1647.          B     RTRN                                            @SC91172 03823000
  1648.          TITLE 'GIVTAB Routine - save translation table'                03823500
  1649. * Save current values in STORAG into a TAKE file on disk                03824000
  1650. * Entry: SCANPTR string has option                                      03824500
  1651. * Exit: R15=0 if ok, R15=1 if error or help needed.  ERRNUM set         03825000
  1652. *       appropriately as long as command syntax is ok, else unchanged.  03825500
  1653. GIVTAB   ENTER ALT                                             @SC87117 03826000
  1654.          NTOKN N=GIVH       A or E?                            @SC87117 03826500
  1655.          SCAN  GIVKW,RTRN1                                     @SC87117 03827000
  1656. GIVH     HELP  GIVKW,RTRN1                                     @SC87117 03827500
  1657. *                                                                       03828000
  1658. GIVKW    KW    '&AAAATOE',GIVA                                 @SC87117 03828500
  1659.          KW    '&CTRLCHR',GIVCTL                               @SC93173 03829000
  1660.          KW    '&AAAETOA',GIVE                                 @SC87117 03829500
  1661.          KW    '&AATATOE',GIVTA,MIN=2                          @SC87117 03830000
  1662.          KW    '&AATETOA',GIVTE,MIN=2                          @SC87117 03830500
  1663.          KW    ,                                               @SC87117 03831000
  1664. *                                                                       03831500
  1665. GIVCTL   LA    6,CTLTAB-1    Permission to transmit "as is"    @SC93173 03832000
  1666.          LA    0,=160X'01'   Assume most are permitted         @SC93173 03832500
  1667. LA161    LA    5,161         Length of table (+ 1)             @SC93173 03833000
  1668.          B     GIVANY                                          @SC93173 03833500
  1669. GIVA     LA    6,ATOE-ATOE   ATOE table is first in storage    @SC90040 03834000
  1670.          B     GIVSET                                          @SC90040 03834500
  1671. GIVE     LA    6,ETOA-ATOE   i.e., 256                         @SC90040 03835000
  1672. GIVSET   LR    7,1           Save ptr to cmd option            @SC90040 03835500
  1673.          XR    0,0           Quit if invalid pair              @SC90040 03836000
  1674.          L     1,CBUF                                          @SC90040 03836500
  1675.          KCALL TBLSET,E=RTRN1 Load base tables into CBUF       @SC90040 03837000
  1676.          LA    0,0(6,1)      R0->base table                    @SC90040 03837500
  1677.          LA    6,ATOE-1(6)   R6->working table - 1             @SC90040 03838000
  1678.          LR    1,7           R1->item in keywords list         @SC90040 03838500
  1679.          B     GIVAE                                           @SC90040 03839000
  1680. GIVTA    LA    6,TATOE-1                                       @SC87117 03839500
  1681. GIVA1    LA    0,ATOED                                         @SC87117 03840000
  1682.          B     GIVAE                                           @SC87117 03840500
  1683. GIVTE    LA    6,TETOA-1                                       @SC87117 03841000
  1684. GIVE1    LA    0,ETOAD                                         @SC87117 03841500
  1685. GIVAE    LA    5,257         Length of table (+ 1)             @SC93173 03842000
  1686. GIVANY   SR    15,15                                           @SC93173 03842500
  1687.          IC    15,0(1)       Get length of name                @SC88298 03843000
  1688.          INITSTR '&AAAASET',GIVBUF,REG=7                       @SC92300 03843500
  1689.          MVI   0(7),C' '                                       @SC92300 03844000
  1690.          MVC   1(20,7),KWNAME(1) Copy name to command          @SC93173 03844500
  1691.          LA    15,2(15,7)                                      @SC92300 03845000
  1692.          MVI   0(15),C' '                                      @SC87117 03845500
  1693.          LA    15,1(15)      Get ptr for 1st argument          @SC87117 03846000
  1694.          LR    1,0                                             @SC87117 03846500
  1695.          BCTR  0,0           Back up to start at "difference"  @SC87117 03847000
  1696.          STM   15,1,GIVSV    Save ptrs: cmd, table, table start@SC87117 03847500
  1697.          LR    7,5           Table length + 1                  @SC93173 03848000
  1698.          LA    0,FFGIV                                         @SC87117 03848500
  1699.          KCALL FSPEC,FILNAM,E=GIVFNE  Error                    @SC87117 03849000
  1700.          MVI   ERRNUM,ERRNOE Ok now                            @SC87117 03849500
  1701.          OPENF O,FILNAM,LOGFDB,GIVPTR,E=GIVOPERR               @SC87117 03850000
  1702.          CH    5,LA161+2     See if doing controls             @SC93173 03850500
  1703.          BNE   GIVLP         No, just start loop               @SC93173 03851000
  1704.          L     4,GIVSV                                         @SC93173 03851500
  1705.          MVC   0(,4),=CL1'&UNPREFD' First, set all unprefixed  @SC93173 03852000
  1706.          LA    15,1(,4)                                        @SC93173 03852500
  1707.          LA    2,GIVBUF                                        @SC93173 03853000
  1708.          SR    15,2          Length of line                    @SC93173 03853500
  1709.          WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR         @SC93173 03854000
  1710.          MVC   0(,4),=CL1'&PREFIXD' Then reset infividuals     @SC93173 03854500
  1711.          MVI   1(4),C' '                                       @SC93173 03855000
  1712.          LA    4,2(,4)                                         @SC93173 03855500
  1713.          ST    4,GIVSV                                         @SC93173 03856000
  1714. GIVLP    LM    15,0,GIVSV    Get output ptr, table scan ptr    @SC87117 03856500
  1715.          A     6,F1          Skip last difference              @SC93173 03857000
  1716.          A     0,F1                                            @SC93173 03857500
  1717.          BCTR  7,0           New length left                   @SC87117 03858000
  1718.          LR    1,7           Copy length                       @SC87117 03858500
  1719.          CLCL  0,6           Find next difference              @SC87117 03859000
  1720.          BE    GIVFIN        All done                          @SC87117 03859500
  1721.          ST    0,GIVSV+4     Save new ptr                      @SC87117 03860000
  1722.          LR    4,0           Get offset                        @SC87117 03860500
  1723.          S     4,GIVSV+8                                       @SC87117 03861000
  1724.          BAL   2,EDDEC       Write as decimal                  @SC87117 03861500
  1725.          CH    5,LA161+2     Doing controls?                   @SC93173 03862000
  1726.          BE    GIVWRT        Yes, skip value                   @SC93173 03862500
  1727.          MVI   0(15),C' '    Leave space                       @SC87117 03863000
  1728.          LA    15,1(15)                                        @SC87117 03863500
  1729.          IC    4,0(6)        Get tailored character            @SC87117 03864000
  1730.          BAL   2,EDDEC       Write as decimal                  @SC87117 03864500
  1731. GIVWRT   DS    0H                                              @SC93173 03865000
  1732.          LA    2,GIVBUF                                        @SC87117 03865500
  1733.          SR    15,2          Length of line                    @SC87117 03866000
  1734.          WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR         @SC87117 03866500
  1735.          B     GIVLP                                           @SC87117 03867000
  1736. GIVWRERR CLOSF GIVPTR        Close output file                 @SC87117 03867500
  1737. GIVOPERR PTEXT '&NOWRITE'                                      @SC87117 03868000
  1738. GIVFNE   WTEXT (3),(4)       Show message                      @SC87117 03868500
  1739.          B     RTRN1                                           @SC87117 03869000
  1740. GIVFIN   CLOSF GIVPTR,E=GIVOPERR Close output file             @SC87117 03869500
  1741.          B     RTRN0                                           @SC86295 03870000
  1742.          LOCALS ,                                              @SC86295 03870500
  1743. GIVSV    DS    3F            Saved ptrs for saving table       @SC87117 03871000
  1744. GIVPTR   DS    A             Ticket for disk I/O               @SC87117 03871500
  1745.          DS    (MAXDOF)X     Leave room for data offset        @SC90264 03872000
  1746. GIVBUF   DS    CL25          Buffer for new file               @SC87117 03872500
  1747.          AIF   ('&KTRACE' NE 'YES').NODUMTB                    @SC92169 03873000
  1748.          ORG   GIVSV                                           @SC92169 03873500
  1749. DUMTBL   DS    (45*16)X                                        @SC92169 03874000
  1750. .NODUMTB ANOP                                                  @SC92169 03874500
  1751.          EXIT                                                  @SC86164 03875000
  1752.          TITLE 'OPTPKT Routine - compute optimum packet size'  @SC88325 03875500
  1753. * Entry: TINSV contains stack of data                                   03876000
  1754. * Exit: R15=0 if no limit, else optimum packet size                     03876500
  1755. OPTPKT   ENTER ,                                               @SC88325 03877000
  1756.          LM    1,2,TINTOT    Get byte count                    @SC88325 03877500
  1757.          AL    2,TOUTOT+4                                      @SC88325 03878000
  1758.          BC    12,*+8                                          @SC88092 03878500
  1759.          AL    1,F1                                            @SC88325 03879000
  1760.          AL    1,TOUTOT                                        @SC88325 03879500
  1761.          LM    3,4,PAKCNT    Get packets, errors               @SC88325 03880000
  1762.          L     5,CSECTOT     Get time (elapsed, if done)       @SC88325 03880500
  1763.          LM    6,9,TINSV     3rd-last snapshot                 @SC88325 03881000
  1764.          MVC   TINSV(32),TINSV+16 Shift snapshots back         @SC88325 03881500
  1765.          STM   2,5,TINSV+32  And insert latest                 @SC88325 03882000
  1766.          LTR   4,4           Any errors ever?                  @SC88325 03882500
  1767.          BZ    RTRN0         No, use max buffer                @SC88325 03883000
  1768.          SLR   2,6           Get incremental counts: bytes,    @SC88325 03883500
  1769.          SR    3,7           ... packets,                      @SC88325 03884000
  1770.          BP    *+8                                             @SC89275 03884500
  1771.           LA   3,1           Mustn't divide by 0!              @SC89275 03885000
  1772.          SR    4,8           ... errors,                       @SC88325 03885500
  1773.          BP    *+8                                             @SC88325 03886000
  1774.           LA   4,1           Mustn't divide by 0!              @SC88325 03886500
  1775.          SR    5,9           ... and csec.                     @SC88325 03887000
  1776.          BNM   *+8                                             @SC88325 03887500
  1777.           A    5,=F'1759218604' Wraps by 2**44/10000           @SC88325 03888000
  1778.          LR    7,4           Save error count                  @SC88325 03888500
  1779.          M     4,BAUD        Total possible transmission       @SC88325 03889000
  1780.          C     4,=F'500'                                       @SC88325 03889500
  1781.          BNL   RTRN0                                           @SC88325 03890000
  1782.          D     4,=F'1000'    Correct for 10 baud, 100 csec     @SC88325 03890500
  1783.          SR    5,2           Possible - actual                 @SC88325 03891000
  1784.          BNP   RTRN0         ??                                @SC88325 03891500
  1785.          MR    6,3           Errors * packets                  @SC88325 03892000
  1786.          SLA   3,4           Packets * 16 (16 apprx 19)        @SC88325 03892500
  1787.          SR    2,3           Useful bytes                      @SC88325 03893000
  1788.          LR    3,2                                             @SC88325 03893500
  1789.          SLR   2,2           Prepare divide                    @SC88325 03894000
  1790.          DR    2,7                                             @SC88325 03894500
  1791.          MR    2,5                                             @SC88325 03895000
  1792. *  Compute sq rt of value in (2,3), return in 15.  Uses 2,3,4,5,14.     03895500
  1793. SQRT     LR    14,2          Copy for sqrt                     @SC86345 03896000
  1794.          LR    15,3                                            @SC86345 03896500
  1795.          LA    4,31          Count bits                        @SC86345 03897000
  1796. SQRL1    CL    2,=XL4'10000000'                                @SC86345 03897500
  1797.          BNL   SQRL2         Justified now                     @SC86345 03898000
  1798.          SLDL  2,2           Keep shifting                     @SC86345 03898500
  1799.          BCT   4,SQRL1                                         @SC86345 03899000
  1800. SQRL2    LCR   4,4                                             @SC86345 03899500
  1801.          AL    2,=XL4'10000000'  1st guess at sqrt             @SC86345 03900000
  1802.          SRDL  2,62(4)       Shift back                        @SC86345 03900500
  1803.          LTR   3,3                                             @SC86345 03901000
  1804.          BNP   SQRX          Too small anyway                  @SC86345 03901500
  1805.          LA    2,3                                             @SC86345 03902000
  1806. SQRL3    LR    4,14                                            @SC86345 03902500
  1807.          LR    5,15                                            @SC86345 03903000
  1808.          DR    4,3           Get next guess                    @SC86345 03903500
  1809.          AR    3,5                                             @SC86345 03904000
  1810.          SRA   3,1                                             @SC86345 03904500
  1811.          BCT   2,SQRL3                                         @SC86345 03905000
  1812. SQRX     LR    15,3                                            @SC86345 03905500
  1813.          B     RTRN                                            @SC88325 03906000
  1814.          LOCALS ,                                              @SC88325 03906500
  1815.          EXIT  ,                                               @SC88325 03907000
  1816.          TITLE 'GENCMD Routine - send a Generic command'       @SC86155 03907500
  1817. * Entry: SCANPTR has string                                             03908000
  1818. * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter               03908500
  1819. *       ERRNUM set appropriately                                        03909000
  1820. GENCMD   ENTER                                                 @SC86155 03909500
  1821.          LA    8,1           One operand                       @SC86295 03910000
  1822.          LTR   1,1                                             @SC86295 03910500
  1823.          BZ    REMCMD        Parse REMOTE command              @SC86295 03911000
  1824.          LA    0,AG          Packet type = generic command     @SC86155 03911500
  1825. GENNUL   SR    5,5           NO ARGUMENTS                      @SC86316 03912000
  1826. GENFILL  STC   0,STYPE       Set packet type                   @SC86155 03912500
  1827.          L     3,RBUF        Put string here                   @SC86155 03913000
  1828.          CLI   STYPE,AG      Generic?                          @SC86155 03913500
  1829.          BNE   GENOTH1       No subcommand                     @SC86155 03914000
  1830.          STC   1,0(3)        Save subcommand byte              @SC86155 03914500
  1831.          LA    3,1(3)        Move to next character position   @SC86155 03915000
  1832.          B     GENOTH1                                         @SC86295 03915500
  1833. GENNXT   NTOKN N=RTRN1       Get next argument                 @SC86295 03916000
  1834.          LA    5,1(7)        Length                            @SC86295 03916500
  1835.          LR    4,6           Address                           @SC86295 03917000
  1836. GENOTH1  LTR   1,5           Any argument?                     @SC86155 03917500
  1837.          BZ    GENFILZ       No, done                          @SC86155 03918000
  1838.          CLI   STYPE,AG      Generic?                          @SC86155 03918500
  1839.          BNE   GENOTH2       No, skip length indicator         @SC86155 03919000
  1840.          TOCHR 1,,0(3)       Yes, do it                        @SC86155 03919500
  1841.          LA    3,1(3)                                          @SC86155 03920000
  1842. GENOTH2  MVC   0(96,3),0(4)  Copy argument                     @SC86155 03920500
  1843.          LA    1,ETOA        Current E-to-A                    @SC91284 03921000
  1844.          CLC   =C'&TRANSPA',TRNALF                             @SC91284 03921500
  1845.          BNE   *+8                                             @SC91284 03922000
  1846.           LA   1,ETOAD       Use default if "transparent"      @SC91284 03922500
  1847.          TR    0(96,3),0(1)  in ASCII                          @SC91284 03923000
  1848.          AR    3,5           Advance ptr                       @SC86155 03923500
  1849.          BCT   8,GENNXT                                        @SC86295 03924000
  1850. GENFILZ  S     3,RBUF        Length of buffer                  @SC86155 03924500
  1851.          ST    3,RBUFL       Set buffer size                   @SC86155 03925000
  1852.          BAL   8,IPKSET      Set state table, exchange parms   @SC86155 03925500
  1853.          DC    AL1(AY),AL3(0)        ACK'ed     Must be just   @SC86155 03926000
  1854.          DC    XL1'FF',AL3(GENRET)   Stop       these 3        @SC88074 03926500
  1855.          DC    AL1(00),AL3(GENAB3)   Error      items.         @SC88074 03927000
  1856.          BAL   8,GENSET      Set state table                   @SC86155 03927500
  1857. * Server cmd Rpack interpret input table                       @SC86155 03928000
  1858.          DC    AL1(AY),AL3(0)        ACK'ed                    @SC86155 03928500
  1859.          DC    AL1(AS),AL3(GENRPL)   Long reply                @SC86155 03929000
  1860.          DC    AL1(AX),AL3(GENRPX)   Long reply already INIT   @SC88074 03929500
  1861.          DC    AL1(AF),AL3(GENRPX)   Long reply already INIT   @SC88074 03930000
  1862.          DC    XL1'FF',AL3(GENRET)   Stop                      @SC88074 03930500
  1863.          DC    AL1(00),AL3(GENAB3)   Error                     @SC88074 03931000
  1864. GENSET   BAL   9,ENCODEN     Encode command                    @SC86295 03931500
  1865.          BAL   9,INPUTSPK    Send, get response                @SC86295 03932000
  1866.          MVI   ERRNUM,ERRNOE No errors                         @SC86155 03932500
  1867.          ICM   0,15,DATL     Any short reply?                  @SC86155 03933000
  1868.          BZ    GENRET        No, done                          @SC86155 03933500
  1869.          NI    FL1,255-EOF   Yes, set flags                    @SC86155 03934000
  1870.          XC    WBUFL,WBUFL   Clear old data                    @SC86155 03934500
  1871.          OI    LOGFLGS,APPN  DISP=MOD                          @SC86295 03935000
  1872.          BAL   2,GENRPS      Set up file name                  @SC86295 03935500
  1873.          OPENF O,FILNAM,LOGFDB,FILPTR,E=GENABR                 @SC89013 03936000
  1874.          USING FDBD,1                                          @SC86295 03936500
  1875.          L     0,FABLRTR     Get effective record length       @SC88120 03937000
  1876.          ST    0,MAXOUT      Save for folding (if need be)     @SC88120 03937500
  1877.          ST    0,FSIZE       Copy LRECL                        @SC86295 03938000
  1878.          MVC   FRECF,FDBRCF  Copy RECFM                        @SC86295 03938500
  1879.          DROP  1                                               @SC86155 03939000
  1880. GENOPN   KCALL DECODE,E=GENAB2 Copy message to output          @SC86155 03939500
  1881.          ICM   1,15,WBUFL    Check length in buffer            @SC88120 03940000
  1882.          BE    GENRPZ                                          @SC86155 03940500
  1883.          KCALL OUTBUF,E=GENAB2  Yes, copy that as well         @SC86155 03941000
  1884. GENRPZ   CLOSF FILPTR                                          @SC86295 03941500
  1885.          MVI   ERRNUM,ERRNOE No errors                         @SC86155 03942000
  1886.          B     GENFIN                                          @SC86295 03942500
  1887. *                                                                       03943000
  1888. GENRPX   CLI   BCTR,A1       This works only with 1-byte check @SC92085 03943500
  1889.          BNE   GENAB3                                          @SC88074 03944000
  1890. GENRPL   DS    0H            Long reply                        @SC88074 03944500
  1891.          BAL   2,GENRPS      Set up file name                  @SC86295 03945000
  1892.          KCALL RECEIV                                          @SC86155 03945500
  1893.          B     GENFIN                                          @SC86155 03946000
  1894. *                                                                       03946500
  1895. GENRPS   LA    0,L'REPNAM    Name string length                @SC86295 03947000
  1896.          LA    1,REPNAM      and address                       @SC86295 03947500
  1897.          STM   0,1,SCANPTR                                     @SC86295 03948000
  1898.          LA    0,FFRCF                                         @SC86295 03948500
  1899.          KCALL FSPEC,FILNAM  Convert to filespec               @SC86295 03949000
  1900.          IC    9,FL3         Save flags                        @SC86295 03949500
  1901.          OI    FL3,APPN      Don't erase it                    @SC86295 03950000
  1902.          BR    2                                               @SC86295 03950500
  1903. *                                                                       03951000
  1904. GENAB2   CLOSF FILPTR                                          @SC86295 03951500
  1905.          B     GENABR                                          @SC88074 03952000
  1906. GENAB3   IC    9,FL3         Save flags                        @SC88074 03952500
  1907. GENABR   KCALL ERPACK                                          @SC86155 03953000
  1908. GENFIN   STC   9,FL3         Restore flags                     @SC86295 03953500
  1909. GENRET   KCALL INTINI,0                                        @SC86155 03954000
  1910.          B     RTRN0                                           @SC86295 03954500
  1911. *                                                                       03955000
  1912. * Make foreign Kermit execute command                                   03955500
  1913. REMCMD   NTOKN N=RTRN2                                         @SC86295 03956000
  1914.          SCAN  REMCMDKW,RTRN1                                  @SC86295 03956500
  1915.          B     RTRN2                                           @SC86295 03957000
  1916. *                                                                       03957500
  1917. REMCMDKW KW    '&AAACOPY',REMREN,K,MIN=2                       @SC91320 03958000
  1918.          KW    'CWD',REMARG,C,MIN=3                            @SC91320 03958500
  1919.          KW    '&AAAADIR',REMARG,D,MIN=3                       @SC91320 03959000
  1920.          KW    '&AAERASE',REMARG,E                             @SC91320 03959500
  1921.          KW    '&AAAHELP',REMARG,H                             @SC91320 03960000
  1922.          KW    '&AAAHOST',REMKRM,C,MIN=2                       @SC91320 03960500
  1923.          KW    'KERMIT',REMKRM,K                               @SC91320 03961000
  1924.          KW    '&AAAMAIL',REMPRT,M                             @SC91320 03961500
  1925.          KW    '&AAPRINT',REMPRT,P                             @SC91320 03962000
  1926.          KW    '&ARENAME',REMREN,R                             @SC91320 03962500
  1927.          KW    '&AASPACE',REMARG,U,MIN=2                       @SC91320 03963000
  1928.          KW    '&ASUBMIT',REMPRT,S,MIN=2                       @SC91320 03963500
  1929.          KW    '&AAATYPE',REMARG,T,MIN=2                       @SC91320 03964000
  1930.          KW    ,                                               @SC86155 03964500
  1931. *                                                                       03965000
  1932. REMKRM   SR    15,15                                           @SC91320 03965500
  1933.          IC    15,KWCODE(1)  Get one-letter code               @SC91320 03966000
  1934.          IC    15,ETOAD(15)  ASCIIify it                       @SC91320 03966500
  1935.          LR    0,15          Use it in generic command         @SC91320 03967000
  1936. REMPRS   FTOKN N=RTRN1       See if anything given             @SC86295 03967500
  1937.          LR    4,7                                             @SC86295 03968000
  1938.          LR    5,6           Use whole string                  @SC86295 03968500
  1939.          B     GENFILL                                         @SC86295 03969000
  1940. *                                                                       03969500
  1941. REMREN   LA    8,2           Copy or rename: two files         @SC91320 03970000
  1942. *                                                                       03970500
  1943. REMARG   SR    15,15                                           @SC91320 03971000
  1944.          IC    15,KWCODE(1)  Get one-letter code               @SC91320 03971500
  1945.          IC    15,ETOAD(15)  ASCIIify it                       @SC91320 03972000
  1946.          LR    1,15          Use it in generic command         @SC91320 03972500
  1947. REMPRSG  LA    0,AG          (generic)                         @SC86155 03973000
  1948.          NTOKN N=GENNUL      Skip any blanks                   @SC86295 03973500
  1949.          LA    5,1(7)        Save length                       @SC86295 03974000
  1950.          LR    4,6           Save ptr                          @SC86295 03974500
  1951.          B     GENFILL       Copy to output                    @SC86155 03975000
  1952. *                                                                       03975500
  1953. REMPRT   MVC   REMPNM,KWNAME(1) Copy command name from table   @SC90239 03976000
  1954.          MVC   REMPCD,KWCODE(1) Copy command code from table   @SC91320 03976500
  1955.          MVC   REMLEN,KWLEN(1) And length-1                    @SC90239 03977000
  1956.          LA    0,FFSND                                         @SC90239 03977500
  1957.          KCALL FSPEC,IFILE,E=REMPFIL Get filespec              @SC90239 03978000
  1958.          BAL   9,WSP         Skip to options, if any           @SC90239 03978500
  1959.           NOP  0                                               @SC90239 03979000
  1960.          XC    LEN,LEN       Now hide the options              @SC90239 03979500
  1961.          CH    6,=H'70'      Can we fit options into A-packet? @SC90239 03980000
  1962.          BH    REMPER        Doesn't look good                 @SC90239 03980500
  1963.          LTR   6,6                                             @SC90239 03981000
  1964.          BNM   *+6                                             @SC90239 03981500
  1965.           SR   6,6           Don't allow negative count        @SC90239 03982000
  1966.          TM    SCAPA,8       Attributes enabled                @SC90239 03982500
  1967.          BZ    REMPNO        No, can't do it                   @SC90239 03983000
  1968.          TM    ATFL2,ATFDSP  Disposition attribute enabled?    @SC90239 03983500
  1969.          BZ    REMPNO        Can't do it                       @SC90239 03984000
  1970.          LA    0,FFSND+FFRCF                                   @SC90239 03984500
  1971.          KCALL FSPEC,JFSPEC  Default foreign filespec          @SC90239 03985000
  1972.          ST    6,LEN         Restore length of options         @SC90239 03985500
  1973.          MVC   MSNDPTR,MSNDBUF No extra files                  @SC90239 03986000
  1974.          SR    1,1                                             @SC90239 03986500
  1975.          IC    1,REMPCD      Pass command code for attribute   @SC91320 03987000
  1976.          IC    1,ETOAD(1)    (use ASCII version)               @SC90239 03987500
  1977.          KCALL SEND                                            @SC90239 03988000
  1978.          B     RTRN0                                           @SC90239 03988500
  1979. *                                                                       03989000
  1980. REMPFIL  WTEXT (3),(4)                                         @SC90239 03989500
  1981.          B     RTRN1         Indicate kermit command error     @SC90239 03990000
  1982. REMPNO   WTEXT '&ATTRIBU &AZDISAB'                             @SC90239 03990500
  1983.          B     REMPCNT                                         @SC90239 03991000
  1984. REMPER   WTEXT '&MANYOPT'                                      @SC90239 03991500
  1985. REMPCNT  SR    14,14                                           @SC90239 03992000
  1986.          IC    14,REMLEN     Length-1 of command               @SC90239 03992500
  1987.          LA    0,L'REMMSG+1(,14)  Length of explanation        @SC90239 03993000
  1988.          MVC   REMMSG,=C'&CANNOT'                              @SC90239 03993500
  1989.          WTEXT REMMSG,(0)                                      @SC90239 03994000
  1990.          B     RTRN1         Indicate kermit command error     @SC90239 03994500
  1991.          LOCALS ,                                              @SC86295 03995000
  1992. REMLEN   DS    X             Length-1 of command name          @SC90239 03995500
  1993. REMMSG   DS    C'&CANNOT'                                      @SC90239 03996000
  1994. REMPNM   DS    CL6           MAIL, PRINT, or SUBMIT            @SC90239 03996500
  1995. REMPCD   DS    C             M, P, or S                        @SC91320 03997000
  1996. REMCMD   EXIT  ,                                               @SC86155 03997500
  1997.          TITLE 'TBLSET Routine - set up character set'         @SC90040 03998000
  1998. * Define new translation tables                                         03998500
  1999. * Entry: Names of table in TRNALF and FILALF, R1->tables                03999000
  2000. *        R0->item just changed, if any (else, 0)                        03999500
  2001. *        Tables should be a pair with ATOE first                        04000000
  2002. * Exit: R15=0 if ok, R15=1 if error ERRNUM unchanged.                   04000500
  2003. TBLSET   ENTER ,                                               @SC90040 04001000
  2004.          LR    9,1           Save ptr to pair of tables        @SC90040 04001500
  2005.          CLC   TRNALF,=CL(LALF)'&TRANSPA'                      @SC91325 04002000
  2006.          BE    TBLNUL        Special "set" - no translation    @SC90250 04002500
  2007.          LA    1,ATOE        Usual table to fill               @SC90040 04003000
  2008.          CR    1,9                                             @SC90040 04003500
  2009.          BNE   *+8           Special case, don't enable attr.  @SC90040 04004000
  2010.           OI   ATFL2,ATFENC  Now allow Encoding attribute      @SC90040 04004500
  2011.          LA    5,TRNTBL      Ptr to list                       @SC90040 04005000
  2012.          LA    6,LTRNTBL                                       @SC90040 04005500
  2013.          LA    7,TRNTBLZ     Ptr to end of list                @SC90040 04006000
  2014.          LA    1,TRNALF      Ptr to transfer set name          @SC90040 04006500
  2015. TBLLKP   CLC   0(2*LALF,5),0(1)  Compare both names            @SC91325 04007000
  2016.          BE    TBLFND        Got it!                           @SC90040 04007500
  2017.          BXLE  5,6,TBLLKP                                      @SC90040 04008000
  2018.          LTR   0,0           Which char set just changed?      @SC90040 04008500
  2019.          BNZ   TBLFIX        Patch other to make valid combo   @SC90040 04009000
  2020. TBLNFND  WTEXT '&UNDEFTR'                                      @SC90040 04009500
  2021.          B     RTRN1                                           @SC90040 04010000
  2022. *                                                                       04010500
  2023. TBLREP   MVC   TRNALF(2*LALF),0(5) Set up new table name       @SC91325 04011000
  2024. *  Enter here with R9->tables, R5->needed translation entry    @SC90040 04011500
  2025. TBLFND   MVC   CDESPTR,2*LALF+16(5) Save char-set designator   @SC91325 04012000
  2026.          LR    1,9           Fill in ATOE table first          @SC91325 04012500
  2027.          LM    6,7,2*LALF(5)                                   @SC91325 04013000
  2028.          LTR   6,6                                             @SC91325 04013500
  2029.          BM    TBLSPEC       Special translation type          @SC91325 04014000
  2030.          BAL   2,TBLCPY                                        @SC90040 04014500
  2031.          LA    1,256(,9)     Fill in ETOA table second         @SC90040 04015000
  2032.          LM    6,7,2*LALF+8(5)                                 @SC91325 04015500
  2033.          BAL   2,TBLCPY                                        @SC90040 04016000
  2034.          MVC   FILALF2,FILALF Actual set matches logical       @SC91325 04016500
  2035.          B     RTRN0                                           @SC90040 04017000
  2036. *                                                                       04017500
  2037. TBLSPEC  LR    8,7           R7->list of permitted char sets   @SC91325 04018000
  2038. TBLSPL1  CLC   FILALF2,0(8)  See if actual file char set is ok @SC91325 04018500
  2039.          BE    TBLSPFN       Yes, all done                     @SC91325 04019000
  2040.          LA    8,LALF(,8)    Not this one, keep checking       @SC91325 04019500
  2041.          CLI   0(8),0        End of list?                      @SC91325 04020000
  2042.          BNE   TBLSPL1       No, keep looking                  @SC91325 04020500
  2043.          MVC   FILALF,0(7)   Yes, switch to 1st in list        @SC91325 04021000
  2044.          LA    0,FILALF      Indicate the file set is changed  @SC91325 04021500
  2045.          KCALL TBLSET        Fill in tables (R1->ATOE already) @SC91325 04022000
  2046.          MVC   TRNALF(2*LALF),0(5) Restore logical char sets   @SC91325 04022500
  2047.          MVC   CDESPTR,2*LALF+16(5) Resave char-set designator @SC91325 04023000
  2048. TBLSPFN  DS    0H                                              @SC91325 04023500
  2049.          B     RTRN0                                           @SC91325 04024000
  2050. *                                                                       04024500
  2051. TBLFIX   LA    5,TRNTBL      Ptr to list again                 @SC90040 04025000
  2052.          CR    0,1           Giving precedence to transfer set?@SC90040 04025500
  2053.          BNE   TBLLKF        No, insist on file set            @SC90040 04026000
  2054. TBLLKT   CLC   0(LALF,5),0(1) Compare just transfer set        @SC91325 04026500
  2055.          BE    TBLREP        First such entry selects file set @SC90040 04027000
  2056.          BXLE  5,6,TBLLKT                                      @SC90040 04027500
  2057. TBLLKF   CLC   LALF(LALF,5),LALF(1) Compare just file set      @SC91325 04028000
  2058.          BNE   TBLLKFZ       Keep looking                      @SC90040 04028500
  2059.          ICM   0,15,LTRNTBL-4(5)   Any preferred transfer set? @SC90040 04029000
  2060.          BM    TBLREP        Yes, this very one                @SC90040 04029500
  2061. TBLLKFZ  BXLE  5,6,TBLLKF                                      @SC90040 04030000
  2062.          B     TBLNFND       Something bizarre happened        @SC90040 04030500
  2063. *                                                                       04031000
  2064. * Make both tables null translators: at R9 and R9 + 256        @SC90250 04031500
  2065. TBLNUL   NI    ATFL2,255-ATFENC  Suppress Encoding attribute   @SC90250 04032000
  2066.          LA    7,255                                           @SC90250 04032500
  2067.          STC   7,0(7,9)      Fill with self mapping            @SC90250 04033000
  2068.          BCT   7,*-4                                           @SC90250 04033500
  2069.          MVI   0(9),0        Also map NULL to NULL             @SC90250 04034000
  2070.          MVC   256(256,9),0(9) and copy to 2nd table           @SC90250 04034500
  2071.          B     RTRN0                                           @SC90250 04035000
  2072. *                                                                       04035500
  2073. * Entry: R6->Designator string, R7=length                      @SC90040 04036000
  2074. * Exit:  Correct table set up and R15=0 if ok, else 1          @SC90040 04036500
  2075. TBLATT   ENTER ALT                                             @SC90040 04037000
  2076.          LA    1,TBLDS       Start of designator list          @SC90040 04037500
  2077.          SR    3,3                                             @SC90040 04038000
  2078. TBLALP   ICM   3,1,4(1)      Get length of next item in list   @SC90040 04038500
  2079.          BZ    RTRN1         End.  String not found            @SC90040 04039000
  2080.          CR    3,7           Right length?                     @SC90040 04039500
  2081.          BNE   TBLALQ        No, keep looking                  @SC90040 04040000
  2082.          LR    4,3           Get length for EX                 @SC90040 04040500
  2083.          BCTR  4,0                                             @SC90040 04041000
  2084.          EX    4,TBLACLC     Strings match?                    @SC90040 04041500
  2085.          BNE   TBLALQ        No, keep looking                  @SC90040 04042000
  2086.          ICM   5,15,0(1)     Yes, get table pointer            @SC90040 04042500
  2087.          LR    6,5           Set to scan through tables        @SC90040 04043000
  2088. TBLAFLP  CLC   0(LALF,6),0(5) See if still same transfer set   @SC91325 04043500
  2089.          BNE   TBLAFND       No, use default ???               @SC90040 04044000
  2090.          CLC   FILALF,LALF(6) See if found right local set     @SC91325 04044500
  2091.          BE    TBLAFNO       Yes, use this table               @SC90040 04045000
  2092.          LA    6,LTRNTBL(,6) No, try next                      @SC90040 04045500
  2093.          B     TBLAFLP                                         @SC90040 04046000
  2094. TBLAFNO  LR    5,6                                             @SC90040 04046500
  2095. TBLAFND  CLC   TRNALF(2*LALF),0(5) Already have this table?    @SC91325 04047000
  2096.          BE    RTRN0         Yes, all done                     @SC90040 04047500
  2097.          MVC   TRNALF(2*LALF),0(5) Set up new table name       @SC91325 04048000
  2098.          LA    9,ATOE        Set ptr to working tables         @SC90040 04048500
  2099.          B     TBLFND        Adopt table                       @SC90040 04049000
  2100. TBLALQ   LA    1,5(3,1)                                        @SC90040 04049500
  2101.          B     TBLALP                                          @SC90040 04050000
  2102. TBLACLC  CLC   0(,6),5(1)    Compare against list item         @SC90040 04050500
  2103. *                                                                       04051000
  2104. * Copy info into table: basic stuff + any "corrections"        @SC90040 04051500
  2105. *  R1->table, R6->basic stuff, R7->corrections, if any         @SC90040 04052000
  2106. *  R9->ATOE table                                              @SC90250 04052500
  2107. TBLCPY   LTR   6,6                                             @SC90040 04053000
  2108.          BZ    TBLCPI        No EtoA table - just invert AtoE  @SC90040 04053500
  2109.          MVC   0(256,1),0(6) Basic pattern                     @SC90040 04054000
  2110.          LTR   7,7           Ptr to modification list          @SC90040 04054500
  2111.          BZR   2             No list                           @SC90040 04055000
  2112.          SR    6,6                                             @SC90040 04055500
  2113. TBLCPL   ICM   6,1,0(7)      Get offset into table             @SC90040 04056000
  2114.          BZR   2             End of list                       @SC90040 04056500
  2115.          IC    0,1(,7)       Get changed value                 @SC90040 04057000
  2116.          STC   0,0(6,1)                                        @SC90040 04057500
  2117.          LA    7,2(,7)                                         @SC90040 04058000
  2118.          B     TBLCPL                                          @SC90040 04058500
  2119. TBLCPI   SR    7,7           Clear work regs.                  @SC90040 04059000
  2120.          XC    0(256,1),0(1) Clear out table                   @SC90040 04059500
  2121.          LA    7,255                                           @SC90040 04060000
  2122. TBLCPIL  IC    6,0(7,9)      Get EBCDIC for (7)                @SC90250 04060500
  2123.          STC   7,0(6,1)      And store inverse                 @SC90040 04061000
  2124.          BCT   7,TBLCPIL     Do all but NULL                   @SC90040 04061500
  2125.          IC    6,0(7,9)      Get EBCDIC for NULL               @SC90250 04062000
  2126.          STC   7,0(6,1)      And store inverse                 @SC90250 04062500
  2127.          BR    2                                               @SC90040 04063000
  2128. *                                                                       04063500
  2129. * Format is: CL(LALF)'transfer',CL(LALF)'local'                @SC91325 04064000
  2130. *            A(t-to-l,adjusts,l-to-t,adjusts,designator,flag)  @SC90040 04064500
  2131. *                     if any   or 0  if any                    @SC90040 04065000
  2132. *  Items should be grouped by transfer set, default 1st        @SC90040 04065500
  2133. *  Flag is -1 in exactly one entry for each possible file set, @SC90040 04066000
  2134. *  but flag is 0 for any others.  "-1" marks preferred entry.  @SC90040 04066500
  2135. TRNTBL   DS    0F            Table of translations             @SC90040 04067000
  2136.          DC    CL(LALF)'ASCII',CL(LALF)'EBCDIC' *** Default ***@SC91325 04067500
  2137.          DC    A(ATOED,0,ETOAD,0,0,0)                          @SC90040 04068000
  2138. LTRNTBL  EQU   *-TRNTBL      Item length                       @SC91325 04068500
  2139.          DC    CL(LALF)'ASCII',CL(LALF)'CP037'                 @SC91325 04069000
  2140.          DC    A(ATOED,ASE37F,ETOAD,0,0,0)                     @SC90040 04069500
  2141.          DC    CL(LALF)'ASCII',CL(LALF)'CP500'                 @SC91325 04070000
  2142.          DC    A(ATOED,ASE5F,ETOAD,0,0,0)                      @SC90040 04070500
  2143.          DC    CL(LALF)'ASCII',CL(LALF)'DKOI'                  @SC91325 04071000
  2144.          DC    A(CYTODKOI,ASDKF,DKOITOAS,0,0,0)                @SC90040 04071500
  2145.          DC    CL(LALF)'ASCII',CL(LALF)'CP880'                 @SC91325 04072000
  2146.          DC    A(CYTODKOI,ASDKF,DKOITOAS,E880ASF,0,0)          @SC90271 04072500
  2147. TRNTNCY  DC    CL(LALF)'&CYRILLC',CL(LALF)'DKOI' USSR          @SC91325 04073000
  2148.          DC    A(CYTODKOI,0,0,0,TBLDSCY,-1)                    @SC90040 04073500
  2149.          DC    CL(LALF)'&CYRILLC',CL(LALF)'CP880' USSR         @SC91325 04074000
  2150.          DC    A(CYTODKOI,CYE880F,0,0,TBLDSCY,-1)              @SC90152 04074500
  2151. TRNTNAR  DC    CL(LALF)'ARABIC',CL(LALF)'CP420'  Arabic        @SC93027 04075000
  2152.          DC    A(ARTOE420,0,0,0,TBLDSAR,-1)                    @SC93027 04075500
  2153. TRNTNL1  DC    CL(LALF)'LATIN1',CL(LALF)'EBCDIC'  Default L1   @SC91325 04076000
  2154.          DC    A(L1TOE,0,0,0,TBLDSL1,-1)                       @SC90040 04076500
  2155. TRNTNCA  DC    CL(LALF)'LATIN1',CL(LALF)'CP037' US, etc        @SC91325 04077000
  2156.          DC    A(L1TOE,L1E37F,0,0,TBLDSL1,-1)                  @SC90040 04077500
  2157. TRNTNDE  DC    CL(LALF)'LATIN1',CL(LALF)'CP273' Germany        @SC91325 04078000
  2158.          DC    A(L1TOE,L1E273F,0,0,TBLDSL1,-1)                 @SC90040 04078500
  2159. TRNTNBR  DC    CL(LALF)'LATIN1',CL(LALF)'CP275' Brazil         @SC91325 04079000
  2160.          DC    A(L1TOE,L1E275F,0,0,TBLDSL1,-1)                 @SC90040 04079500
  2161. TRNTNDK  DC    CL(LALF)'LATIN1',CL(LALF)'CP277' Denmark, Norway@SC91325 04080000
  2162.          DC    A(L1TOE,L1E277F,0,0,TBLDSL1,-1)                 @SC90040 04080500
  2163. TRNTNSE  DC    CL(LALF)'LATIN1',CL(LALF)'CP278' Finland, Sweden@SC91325 04081000
  2164.          DC    A(L1TOE,L1E278F,0,0,TBLDSL1,-1)                 @SC90040 04081500
  2165. TRNTNIT  DC    CL(LALF)'LATIN1',CL(LALF)'CP280' Italy          @SC91325 04082000
  2166.          DC    A(L1TOE,L1E280F,0,0,TBLDSL1,-1)                 @SC90040 04082500
  2167. TRNTNJR  DC    CL(LALF)'LATIN1',CL(LALF)'CP281' Japan          @SC91325 04083000
  2168.          DC    A(L1TOE,L1E281F,0,0,TBLDSL1,-1)                 @SC91325 04083500
  2169. TRNTNPT  DC    CL(LALF)'LATIN1',CL(LALF)'CP282' Portugal       @SC91325 04084000
  2170.          DC    A(L1TOE,L1E282F,0,0,TBLDSL1,-1)                 @SC90040 04084500
  2171. TRNTNES  DC    CL(LALF)'LATIN1',CL(LALF)'CP284' Spain          @SC91325 04085000
  2172.          DC    A(L1TOE,L1E284F,0,0,TBLDSL1,-1)                 @SC90040 04085500
  2173. TRNTNUK  DC    CL(LALF)'LATIN1',CL(LALF)'CP285' UK             @SC91325 04086000
  2174.          DC    A(L1TOE,L1E285F,0,0,TBLDSL1,-1)                 @SC90040 04086500
  2175. TRNTNFR  DC    CL(LALF)'LATIN1',CL(LALF)'CP297' France         @SC91325 04087000
  2176.          DC    A(L1TOE,L1E297F,0,0,TBLDSL1,-1)                 @SC90040 04087500
  2177. TRNTNBE  DC    CL(LALF)'LATIN1',CL(LALF)'CP500' Belgium, etc   @SC91325 04088000
  2178.          DC    A(L1TOE,L1E5F,0,0,TBLDSL1,-1)                   @SC90040 04088500
  2179. TRNTNIS  DC    CL(LALF)'LATIN1',CL(LALF)'CP871' Iceland        @SC91325 04089000
  2180.          DC    A(L1TOE,L1E871F,0,0,TBLDSL1,-1)                 @SC90040 04089500
  2181. TRNTNL2  DC    CL(LALF)'LATIN2',CL(LALF)'CP870' Yugoslavia     @SC91325 04090000
  2182.          DC    A(L2TOE870,0,0,0,TBLDSL2,-1)                    @SC90152 04090500
  2183. TRNTNCZ  DC    CL(LALF)'LATIN2',CL(LALF)'&CZECH' Czechoslovakia@SC91325 04091000
  2184.          DC    A(L2TOE870,L2ECZF,0,0,TBLDSL2,-1)               @SC90152 04091500
  2185. TRNTNL3  DC    CL(LALF)'LATIN3',CL(LALF)'CP905' Turkey         @SC91325 04092000
  2186.          DC    A(L3TOE905,0,0,0,TBLDSL3,-1)                    @SC90152 04092500
  2187. TRNTNGR  DC    CL(LALF)'&AAGREEK',CL(LALF)'CP875'  Greece      @SC91325 04093000
  2188.          DC    A(GRTOE875,0,0,0,TBLDSGR,-1)                    @SC90040 04093500
  2189. TRNTNIL  DC    CL(LALF)'&HEBREW',CL(LALF)'CP424' Israel        @SC91325 04094000
  2190.          DC    A(L8TOE424,0,0,0,TBLDSHE,-1)                    @SC90040 04094500
  2191. TRNTNTH  DC    CL(LALF)'THAI',CL(LALF)'CP838'   Thailand       @SC92233 04095000
  2192.          DC    A(THTOE838,0,0,0,TBLDSTH,-1)                    @SC92233 04095500
  2193. TRNTNKN  DC    CL(LALF)'&JAPNEUC',CL(LALF)'&KNJDEF.-KANJI'     @SC91325 04096000
  2194.          DC    A(-1,TBVJP&KNJLAB,0,0,TBLDSKN,-1)               @SC91325 04096500
  2195.          AIF   ('&KNJLAB' EQ 'F').TRNTHIT                      @SC91325 04097000
  2196.          DC    CL(LALF)'&JAPNEUC',CL(LALF)'FUJITSU-KANJI'      @SC91325 04097500
  2197.          DC    A(-1,TBVJPF,0,0,TBLDSKN,-1)                     @SC91325 04098000
  2198. .TRNTHIT AIF   ('&KNJLAB' EQ 'H').TRNTIBM                      @SC91325 04098500
  2199.          DC    CL(LALF)'&JAPNEUC',CL(LALF)'HITACHI-KANJI'      @SC91325 04099000
  2200.          DC    A(-1,TBVJPH,0,0,TBLDSKN,-1)                     @SC91325 04099500
  2201. .TRNTIBM AIF   ('&KNJLAB' EQ 'I').TRNTKZ                       @SC91325 04100000
  2202.          DC    CL(LALF)'&JAPNEUC',CL(LALF)'IBM-KANJI'          @SC91325 04100500
  2203.          DC    A(-1,TBVJPI,0,0,TBLDSKN,-1)                     @SC91325 04101000
  2204. .TRNTKZ  ANOP                                                  @SC91325 04101500
  2205. TRNTNJP  EQU   *                                               @SC91325 04102000
  2206.          AIF   ('&KNJLAB' EQ 'H').TRNTK1H                      @SC91325 04102500
  2207.          DC    CL(LALF)'KATAKANA',CL(LALF)'CP290' Japan        @SC91325 04103000
  2208.          DC    A(KATOE290,0,0,0,TBLDSKA,-1)                    @SC91325 04103500
  2209. .TRNTK1H DC    CL(LALF)'KATAKANA',CL(LALF)'H-EBCDIK-DASH' Japan@SC91325 04104000
  2210.          DC    A(KATOHEBK,0,0,0,TBLDSKA,-1)                    @SC91325 04104500
  2211.          AIF   ('&KNJLAB' NE 'H').TRNTK2H                      @SC91325 04105000
  2212.          DC    CL(LALF)'KATAKANA',CL(LALF)'CP290' Japan        @SC91325 04105500
  2213.          DC    A(KATOE290,0,0,0,TBLDSKA,-1)                    @SC91325 04106000
  2214. .TRNTK2H ANOP                                                  @SC91325 04106500
  2215. TRNTBLZ  EQU   *-LTRNTBL                                       @SC91325 04107000
  2216. *                                                                       04107500
  2217. *  List of transfer character set designators                  @SC90040 04108000
  2218. TBLDS    EQU   *                                               @SC90040 04108500
  2219. TBLDSAR  DC    AL4(TRNTNAR),AL1(6,AI,A6,ASL,A1,A2,A7) I6/127   @SC93027 04109000
  2220. TBLDSCY  DC    AL4(TRNTNCY),AL1(6,AI,A6,ASL,A1,A4,A4) I6/144   @SC90040 04109500
  2221. TBLDSGR  DC    AL4(TRNTNGR),AL1(6,AI,A6,ASL,A1,A2,A6) I6/126   @SC90040 04110000
  2222. TBLDSHE  DC    AL4(TRNTNIL),AL1(6,AI,A6,ASL,A1,A3,A8) I6/138   @SC90040 04110500
  2223. TBLDSKA  DC    AL4(TRNTNJP),AL1(6,AI,A1,A4,ASL,A1,A3) I14/13   @SC90040 04111000
  2224. TBLDSKN  DC    AL4(TRNTNKN),AL1(9,AI,A1,A4,ASL,A8,A7,ASL,A1,A3) SC91325 04111500
  2225.          DC    AL4(TRNTNKN),AL1(7,AI,A1,A4,ASL,A8,A7,AE) I14/87E *TEMP* 04112000
  2226. TBLDSL1  DC    AL4(TRNTNL1),AL1(6,AI,A6,ASL,A1,A0,A0) I6/100   @SC90040 04112500
  2227.          DC    AL4(TRNTNL1),AL1(6,AI,A2,ASL,A1,A0,A0) **TEMP** @SC90040 04113000
  2228. TBLDSL2  DC    AL4(TRNTNL2),AL1(6,AI,A6,ASL,A1,A0,A1) I6/101   @SC90152 04113500
  2229. TBLDSL3  DC    AL4(TRNTNL3),AL1(6,AI,A6,ASL,A1,A0,A9) I6/109   @SC90152 04114000
  2230. TBLDSTH  DC    AL4(TRNTNTH),AL1(6,AI,A6,ASL,A1,A6,A6) I6/166   @SC92233 04114500
  2231.          DC    XL5'0'        End of table                      @SC90040 04115000
  2232. *                                                                       04115500
  2233. * Lists of file char-sets to go with complex translations      @SC91325 04116000
  2234. TBVJPH   DC    CL(LALF)'H-EBCDIK-DASH'                         @SC91325 04116500
  2235. TBVJPF   EQU   *                                               @SC91325 04117000
  2236. TBVJPI   EQU   *                                               @SC91325 04117500
  2237. TBVJP    DC    CL(LALF)'CP290',CL(LALF)'CP500',CL(LALF)'CP281' @SC91325 04118000
  2238.          DC    CL(LALF)'H-EBCDIK-DASH'                         @SC91325 04118500
  2239.          DC    X'00'                                           @SC91325 04119000
  2240.          LOCALS ,                                              @SC90040 04119500
  2241. TBLSET   EXIT  ,                                               @SC90040 04120000
  2242. TRNTBLD  CSECT                                                 @SC90040 04120500
  2243. *                                                                       04121000
  2244. *          Corrections:  ASCII      ->   DKOI                  @SC90040 04121500
  2245. *          ref: Konstantin Vinogradov (ICSTI)                  @SC90040 04122000
  2246. ASDKF    HTBL  60B8,61B9,62BA,63BB,64BC,65BD                   @SC90271 04122500
  2247.          DC    X'66BE',X'67BF',X'68CA',X'69CB',X'6ACC',X'6BCD' @SC90040 04123000
  2248.          DC    X'6CCE',X'6DCF',X'6EDA',X'6FDB',X'70DC',X'71DD' @SC90040 04123500
  2249.          DC    X'72DE',X'73DF',X'74EA',X'75EB',X'76EC',X'77ED' @SC90040 04124000
  2250.          DC    X'78EE',X'79EF',X'7AFA',X'7BFB',X'7CFC',X'7DFD' @SC90040 04124500
  2251.          HTBL  7EFE,00                                         @SC90271 04125000
  2252. *                                                                       04125500
  2253. *          Corrections:  LATIN1     ->   CP 037                @SC90040 04126000
  2254. *          ref: Andre Pirard (U Liege)                         @SC90040 04126500
  2255. L1E37F   DC    X'AC5F',X'DDAD',X'A8BD'                         @SC90040 04127000
  2256. ASE37F   DC    X'5BBA',X'5DBB',X'5EB0',X'0'                    @SC90040 04127500
  2257. *                                                                       04128000
  2258. *          Corrections:  LATIN1     ->   CP 273                @SC90040 04128500
  2259. *          ref: Andre Pirard (U Liege)                         @SC90040 04129000
  2260. L1E273F  DC    X'214F',X'40B5',X'5B63',X'5CEC',X'5DFC',X'7B43' @SC90040 04129500
  2261.          DC    X'7CBB',X'7DDC',X'7E59',X'A2B0',X'A6CC',X'A77C' @SC90040 04130000
  2262.          DC    X'A8BD',X'ACBA',X'C44A',X'D6E0',X'DC5A',X'DDAD' @SC90040 04130500
  2263.          DC    X'DFA1',X'E4C0',X'F66A',X'FCD0',X'0'            @SC90040 04131000
  2264. *                                                                       04131500
  2265. *          Corrections:  LATIN1     ->   CP 275                @SC90040 04132000
  2266. *          ref: About Type (IBM S544-3516-02)                  @SC90040 04132500
  2267. L1E275F  DC    X'214F',X'23EF',X'245A',X'4066',X'5B71',X'5D68' @SC90040 04133000
  2268.          DC    X'6046',X'7BCF',X'7CBB',X'7D51',X'A2B0',X'A648' @SC90040 04133500
  2269.          DC    X'A8BD',X'ACBA',X'C37B',X'C75B',X'C94A',X'D57C' @SC90040 04134000
  2270.          DC    X'DDAD',X'E379',X'E76A',X'E9D0',X'F5C0',X'0'    @SC90040 04134500
  2271. *                                                                       04135000
  2272. *          Corrections:  LATIN1     ->   CP 277                @SC90040 04135500
  2273. *          ref: Andre Pirard (U Liege)                         @SC90040 04136000
  2274. L1E277F  DC    X'214F',X'234A',X'2467',X'4080',X'5B9E',X'5D9F' @SC90040 04136500
  2275.          DC    X'7B9C',X'7CBB',X'7D47',X'7EDC',X'A2B0',X'A45A' @SC90040 04137000
  2276.          DC    X'A670',X'A8BD',X'ACBA',X'C55B',X'C67B',X'D87C' @SC90040 04137500
  2277.          DC    X'DDAD',X'E5D0',X'E6C0',X'F86A',X'FCA1',X'0'    @SC90040 04138000
  2278. *                                                                       04138500
  2279. *          Corrections:  LATIN1     ->   CP 278                @SC90040 04139000
  2280. *          ref: Andre Pirard (U Liege)                         @SC90040 04139500
  2281. L1E278F  DC    X'214F',X'2363',X'2467',X'40EC',X'5BB5',X'5C71' @SC90040 04140000
  2282.          DC    X'5D9F',X'6051',X'7B43',X'7CBB',X'7D47',X'7EDC' @SC90040 04140500
  2283.          DC    X'A2B0',X'A45A',X'A6CC',X'A74A',X'A8BD',X'ACBA' @SC90040 04141000
  2284.          DC    X'C47B',X'C55B',X'C9E0',X'D67C',X'DDAD',X'E4C0' @SC90040 04141500
  2285.          DC    X'E5D0',X'E979',X'F66A',X'FCA1',X'0'            @SC90040 04142000
  2286. *                                                                       04142500
  2287. *          Corrections:  LATIN1     ->   CP 280                @SC90040 04143000
  2288. *          ref: Andre Pirard (U Liege)                         @SC90040 04143500
  2289. L1E280F  DC    X'214F',X'23B1',X'40B5',X'5B90',X'5C48',X'5D51' @SC90040 04144000
  2290.          DC    X'60DD',X'7B44',X'7CBB',X'7D54',X'7E58',X'A2B0' @SC90040 04144500
  2291.          DC    X'A37B',X'A6CD',X'A77C',X'A8BD',X'ACBA',X'B04A' @SC90040 04145000
  2292.          DC    X'DDAD',X'E0C0',X'E7E0',X'E8D0',X'E95A',X'ECA1' @SC90040 04145500
  2293.          DC    X'F26A',X'F979',X'0'                            @SC90040 04146000
  2294. *                                                                       04146500
  2295. *          Corrections:  LATIN1     ->   CP 281                @SC91325 04147000
  2296. *          ref: IBM C-H 3-220-050 (1989)                       @SC91325 04147500
  2297. L1E281F  HTBL  24E0,5BB1,5CB2,5DBB,5EBA,7EBC,A2B0,A34A,A55B    @SC91325 04148000
  2298.          HTBL  A8BD,AC5F,AFA1,DDAD,00                          @SC91325 04148500
  2299. *                                                                       04149000
  2300. *          Corrections:  LATIN1     ->   CP 282                @SC90040 04149500
  2301. *          ref: About Type (IBM S544-3516-02)                  @SC90040 04150000
  2302. L1E282F  DC    X'214F',X'2366',X'40EF',X'5B4A',X'5C68',X'5D5A' @SC90040 04150500
  2303.          DC    X'7B46',X'7CBB',X'7DBE',X'7E48',X'A2B0',X'A6CF' @SC90040 04151000
  2304.          DC    X'A8BD',X'ACBA',X'B4D0',X'C37B',X'C7E0',X'D57C' @SC90040 04151500
  2305.          DC    X'DDAD',X'E3C0',X'E7A1',X'F56A',X'0'            @SC90040 04152000
  2306. *                                                                       04152500
  2307. *          Corrections:  LATIN1     ->   CP 284                @SC90040 04153000
  2308. *          ref: Andre Pirard (U Liege)                         @SC90040 04153500
  2309. L1E284F  DC    X'21BB',X'2369',X'5B4A',X'5D5A',X'5EBA',X'7EBD' @SC90040 04154000
  2310.          DC    X'A2B0',X'A649',X'A8A1',X'AC5F',X'D17B',X'DDAD' @SC90040 04154500
  2311.          DC    X'F16A',X'0'                                    @SC90040 04155000
  2312. *                                                                       04155500
  2313. *          Corrections:  LATIN1     ->   CP 285                @SC90040 04156000
  2314. *          ref: Andre Pirard (U Liege)                         @SC90040 04156500
  2315. L1E285F  DC    X'244A',X'5BB1',X'5DBB',X'5EBA',X'7EBC',X'A2B0' @SC90040 04157000
  2316.          DC    X'A35B',X'A8BD',X'AC5F',X'AFA1',X'DDAD',X'0'    @SC90040 04157500
  2317. *                                                                       04158000
  2318. *          Corrections:  LATIN1     ->   CP 297                @SC90040 04158500
  2319. *          ref: Andre Pirard (U Liege)                         @SC90040 04159000
  2320. L1E297F  DC    X'214F',X'23B1',X'4044',X'5B90',X'5C48',X'5DB5' @SC90040 04159500
  2321.          DC    X'60A0',X'7B51',X'7CBB',X'7D54',X'7EBD',X'A2B0' @SC90040 04160000
  2322.          DC    X'A37B',X'A6DD',X'A75A',X'A8A1',X'ACBA',X'B04A' @SC90040 04160500
  2323.          DC    X'B579',X'DDAD',X'E07C',X'E7E0',X'E8D0',X'E9C0' @SC90040 04161000
  2324.          DC    X'F96A',X'0'                                    @SC90040 04161500
  2325. *                                                                       04162000
  2326. *          Corrections:  LATIN1     ->   CP 500                @SC90040 04162500
  2327. *          ref: Andre Pirard (U Liege)                         @SC90040 04163000
  2328. L1E5F    DC    X'A2B0',X'A8BD',X'ACBA',X'DDAD'                 @SC90040 04163500
  2329. ASE5F    DC    X'214F',X'5B4A',X'5D5A',X'7CBB',X'0'            @SC90040 04164000
  2330. *                                                                       04164500
  2331. *          Corrections:  LATIN1     ->   CP 871                @SC90040 04165000
  2332. *          ref: About Type (IBM S544-3516-02)                  @SC90040 04165500
  2333. L1E871F  DC    X'214F',X'40AC',X'5BAE',X'5CBE',X'5D9E',X'5EEC' @SC90040 04166000
  2334.          DC    X'608C',X'7B8E',X'7CBB',X'7D9C',X'7ECC',X'A2B0' @SC90040 04166500
  2335.          DC    X'A8BD',X'ACBA',X'B4E0',X'C65A',X'D07C',X'D65F' @SC90040 04167000
  2336.          DC    X'DDAD',X'DE4A',X'E6D0',X'F079',X'F6A1',X'FEC0' @SC90040 04167500
  2337.          DC    X'0'                                            @SC90040 04168000
  2338. *                                                                       04168500
  2339. *          Corrections:  CYRILLIC   ->   CP 880                @SC90152 04169000
  2340. *          ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04169500
  2341. CYE880F  HTBL  A163,A259,A362,A464,A565,A666,A767,A868,A969    @SC90152 04170000
  2342.          HTBL  AA70,AB71,AC72,AD73,AE74,AF75,CA57,F144,F242    @SC90152 04170500
  2343.          HTBL  F343,F445,F546,F647,F748,F849,F951,FA52,FB53    @SC90152 04171000
  2344.          HTBL  FC54,FD55,FEFF,FF56,00                          @SC90152 04171500
  2345. *                                                                       04172000
  2346. *          Corrections:  LATIN2     ->   CZECH                 @SC90152 04172500
  2347. *          ref: Konstantin Vinogradov (ICSTI)                  @SC90152 04173000
  2348. L2ECZF   HTBL  A178,A243,A465,A5CE,A671,A8B8,A9DF,AA75,ABEA    @SC90152 04173500
  2349.          HTBL  ACAE,ADEE,AEFA,B054,B167,B263,B355,B4EC,B59B    @SC90152 04174000
  2350.          HTBL  B645,B858,B9AB,BA51,BBAC,BEB2,BF8D,C0BE,C1B9    @SC90152 04174500
  2351.          HTBL  C4DD,C5CD,C8BB,C9ED,CCBD,CDCB,CFBC,D074,D1B6    @SC90152 04175000
  2352.          HTBL  D2DA,D3DB,D4DC,D5FE,D6CF,D8DE,D9CC,DAEB,DCCA    @SC90152 04175500
  2353.          HTBL  DDEF,E08C,E177,E4A0,E59A,E880,E9AF,EC8B,ED8F    @SC90152 04176000
  2354.          HTBL  EF8A,F047,F157,F29D,F39E,F49F,F5FC,F69C,F8AA    @SC90152 04176500
  2355.          HTBL  F990,FAAD,FBFD,FC8E,FDB1,00                     @SC90152 04177000
  2356. *                                                                       04177500
  2357. L1TOE    EQU   *             LATIN1 to EBCDIC                  @SC90040 04178000
  2358. *          ref: composite                                      @SC90040 04178500
  2359. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04179000
  2360.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04179500
  2361.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04180000
  2362.          HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04180500
  2363.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04181000
  2364.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04181500
  2365.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D 5 C90040 04182000
  2366.          HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04182500
  2367.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04183000
  2368.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04183500
  2369.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04184000
  2370.          HTBL  41,AA,4A,B1,9F,B2,6A,B5,BB,B4,9A,8A,B0,CA,AF,BC A C90040 04184500
  2371.          HTBL  90,8F,EA,FA,BE,A0,B6,B3,9D,DA,9B,8B,B7,B8,B9,AB B C90040 04185000
  2372.          HTBL  64,65,62,66,63,67,9E,68,74,71,72,73,78,75,76,77 C C90040 04185500
  2373.          HTBL  AC,69,ED,EE,EB,EF,EC,BF,80,FD,FE,FB,FC,BA,AE,59 D C90040 04186000
  2374.          HTBL  44,45,42,46,43,47,9C,48,54,51,52,53,58,55,56,57 E C90040 04186500
  2375.          HTBL  8C,49,CD,CE,CB,CF,CC,E1,70,DD,DE,DB,DC,8D,8E,DF F C90040 04187000
  2376. *                                                                       04187500
  2377. ARTOE420 EQU   *             Arabic ISO (+CP864) to CP420      @SC93027 04188000
  2378. *          ref: IBM code page registry                         @SC93027 04188500
  2379. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC93027 04189000
  2380.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C93027 04189500
  2381.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C93027 04190000
  2382.          HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C93027 04190500
  2383.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C93027 04191000
  2384.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C93027 04191500
  2385.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,53,54,B6,B7,6D 5 C93027 04192000
  2386.          HTBL  CC,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C93027 04192500
  2387.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,CE,4F,E1,EC,07 7 C93027 04193000
  2388.          HTBL  09,0A,14,1B,2C,20,21,2A,28,29,06,17,24,15,22,23 8 C93027 04193500
  2389.          HTBL  30,31,1A,33,34,35,36,08,38,B4,B5,3B,04,B8,B9,45 9 C93027 04194000
  2390.          HTBL  41,68,48,FA,FF,51,2B,39,57,59,63,65,79,CA,69,71 A C93027 04194500
  2391.          HTBL  DF,EA,EB,ED,EE,EF,FB,FC,FD,FE,AB,C0,77,80,8B,D0 B C93027 04195000
  2392.          HTBL  4A,46,47,49,52,9B,55,56,58,62,64,66,67,70,72,73 C C93027 04195500
  2393.          HTBL  74,75,76,78,8A,8C,8E,8F,90,9C,A0,6A,5F,A1,E0,9A D C93027 04196000
  2394.          HTBL  44,AC,AE,B0,BA,BC,BE,CB,CF,DA,DE,8D,9D,9F,9E,BB E C93027 04196500
  2395.          HTBL  43,42,BD,BF,CD,DB,DD,AA,AD,B2,B3,B1,AF,DC,3E,3A F C93027 04197000
  2396. *                                                                       04197500
  2397. DKOITOAS EQU   *             DKOI (EBCDIC) to ASCII            @SC90040 04198000
  2398. *          ref: Konstantin Vinogradov (ICSTI)                  @SC90040 04198500
  2399. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04199000
  2400.          HTBL  00,01,02,03,1C,09,06,7F,17,0D,0E,0B,0C,0D,0E,0F 0 C90271 04199500
  2401.          HTBL  10,11,12,13,1D,05,08,07,18,19,12,0F,1C,1D,1E,1F 1 C90271 04200000
  2402.          HTBL  00,01,02,03,04,0A,17,1B,08,09,0A,0B,0C,05,06,07 2 C90271 04200500
  2403.          HTBL  10,11,16,13,14,15,16,04,18,19,1A,1B,14,15,1E,1A 3 C90271 04201000
  2404.          HTBL  20,20,65,00,00,00,53,49,49,4A,5B,2E,3C,28,2B,21 4 C90271 04201500
  2405.          HTBL  26,00,00,00,6B,2D,75,00,00,65,5D,24,2A,29,3B,5E 5 C90271 04202000
  2406.          HTBL  2D,2F,00,00,00,53,49,49,4A,00,5C,2C,25,5F,3E,3F 6 C90271 04202500
  2407.          HTBL  00,00,6B,00,75,27,60,61,62,40,3A,23,40,27,3D,22 7 C90271 04203000
  2408.          HTBL  63,41,42,43,44,45,46,47,48,49,64,65,66,67,68,69 8 C90040 04203500
  2409.          HTBL  6A,4A,4B,4C,4D,4E,4F,50,51,52,6B,6C,6D,6E,6F,70 9 C90040 04204000
  2410.          HTBL  71,5E,53,54,55,56,57,58,59,5A,72,73,74,75,76,77 A C90271 04204500
  2411.          HTBL  78,79,7A,7B,7C,7D,7E,27,60,61,62,63,64,65,66,67 B C90040 04205000
  2412.          HTBL  5B,41,42,43,44,45,46,47,48,49,68,69,6A,6B,6C,6D C C90271 04205500
  2413.          HTBL  5D,4A,4B,4C,4D,4E,4F,50,51,52,6E,6F,70,71,72,73 D C90271 04206000
  2414.          HTBL  5C,1F,53,54,55,56,57,58,59,5A,74,75,76,77,78,79 E C90271 04206500
  2415.          HTBL  30,31,32,33,34,35,36,37,38,39,7A,7B,7C,7D,7E,00 F C90040 04207000
  2416. *                                                                       04207500
  2417. * Corrections for CP880 -> ASCII                               @SC90271 04208000
  2418. E880ASF  HTBL  4200,4465,5500,5600,5727,5900,6365,732D,7500    @SC90271 04208500
  2419.          HTBL  FF75,00                                         @SC90271 04209000
  2420. *                                                                       04209500
  2421. CYTODKOI EQU   *             CYRILLIC to DKOI (EBCDIC)         @SC90040 04210000
  2422. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04210500
  2423.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04211000
  2424.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04211500
  2425.          HTBL  40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04212000
  2426.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04212500
  2427.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04213000
  2428.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04213500
  2429.          HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04214000
  2430.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04214500
  2431.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04215000
  2432.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,E1 9 C90040 04215500
  2433.          HTBL  41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 A C90040 04216000
  2434.          HTBL  B9,BA,ED,BF,BC,BD,EC,FA,CB,CC,CD,CE,CF,DA,DB,DC B C90040 04216500
  2435.          HTBL  DE,DF,EA,EB,BE,CA,BB,FE,FB,FD,75,EF,EE,FC,B8,DD C C90040 04217000
  2436.          HTBL  77,78,AF,8D,8A,8B,AE,B2,8F,90,9A,9B,9C,9D,9E,9F D C90040 04217500
  2437.          HTBL  AA,AB,AC,AD,8C,8E,80,B6,B3,B5,B7,B1,B0,B4,76,A0 E C90040 04218000
  2438.          HTBL  58,59,62,63,64,65,66,67,68,69,70,71,72,73,74,FF F C90040 04218500
  2439. *                                                                       04219000
  2440. GRTOE875 EQU   *             Latin/Greek to Greece EBCDIC      @SC90040 04219500
  2441. *          ref: Michel Suignard                                @SC90040 04220000
  2442. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04220500
  2443.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04221000
  2444.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04221500
  2445.          HTBL  40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04222000
  2446.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04222500
  2447.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04223000
  2448.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04223500
  2449.          HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04224000
  2450.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04224500
  2451.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04225000
  2452.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04225500
  2453.          HTBL  74,CE,DE,B0,DC,E1,DF,EB,70,FB,EC,EE,EF,CA,ED,CF A C90040 04226000
  2454.          HTBL  90,DA,EA,FA,A0,80,71,DD,72,73,75,FE,76,DB,77,78 B C90040 04226500
  2455.          HTBL  CC,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 C C90040 04227000
  2456.          HTBL  57,58,FC,59,62,63,64,65,66,67,68,69,B1,B2,B3,B5 D C90040 04227500
  2457.          HTBL  CD,8A,8B,8C,8D,8E,8F,9A,9B,9C,9D,9E,9F,AA,AB,AC E C90040 04228000
  2458.          HTBL  AD,AE,BA,AF,BB,BC,BD,BE,BF,CB,B4,B8,B6,B7,B9,FD F C90040 04228500
  2459. *                                                                       04229000
  2460. L8TOE424 EQU   *             Latin/Hebrew to Israel EBCDIC     @SC90040 04229500
  2461. *          ref: Jonathan Rosenne (IBM Israel)                  @SC90040 04230000
  2462. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04230500
  2463.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04231000
  2464.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04231500
  2465.          HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04232000
  2466.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04232500
  2467.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04233000
  2468.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,BA,E0,BB,B0,6D 5 C90040 04233500
  2469.          HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04234000
  2470.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04234500
  2471.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04235000
  2472.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04235500
  2473.          HTBL  74,AA,4A,B1,9F,B2,6A,B5,BD,B4,BF,8A,5F,CA,AF,BC A C90040 04236000
  2474.          HTBL  90,8F,EA,FA,BE,A0,B6,B3,9D,DA,E1,8B,B7,B8,B9,AB B C90040 04236500
  2475.          HTBL  CB,CC,CD,9C,CE,CF,9E,9B,DD,DE,72,73,70,75,76,77 C C90040 04237000
  2476.          HTBL  AC,8C,ED,EE,EB,EF,EC,9A,80,FD,FE,FB,FC,AD,AE,78 D C90040 04237500
  2477.          HTBL  41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 E C90040 04238000
  2478.          HTBL  58,59,62,63,64,65,66,67,68,69,71,DB,DC,8D,8E,DF F C90040 04238500
  2479. *                                                                       04239000
  2480. KATOE290 EQU   *             KATAKANA to Japanese EBCDIC (290) @SC90040 04239500
  2481. *          ref: C-H 3-3220-050, composite                      @SC91067 04240000
  2482. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90040 04240500
  2483.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04241000
  2484.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04241500
  2485.          HTBL  40,5A,7F,7B,E0,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04242000
  2486.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04242500
  2487.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04243000
  2488.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,70,5B,80,B0,6D 5 C91067 04243500
  2489.          HTBL  79,62,63,64,65,66,67,68,69,71,72,73,74,75,76,77 6 C91067 04244000
  2490.          HTBL  78,8B,9B,AB,B3,B4,B5,B6,B7,B8,B9,C0,4F,D0,A1,07 7 C91067 04244500
  2491.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04245000
  2492.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,4A 9 C91325 04245500
  2493.          HTBL  57,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 A C91325 04246000
  2494.          HTBL  58,81,82,83,84,85,86,87,88,89,8A,8C,8D,8E,8F,90 B C90040 04246500
  2495.          HTBL  91,92,93,94,95,96,97,98,99,9A,9D,9E,9F,A2,A3,A4 C C90040 04247000
  2496.          HTBL  A5,A6,A7,A8,A9,AA,AC,AD,AE,AF,BA,BB,BC,BD,BE,BF D C90040 04247500
  2497.          HTBL  59,5F,6A,9C,A0,B1,B2,CA,DA,DF,EA,EB,EC,ED,EE,EF E C91325 04248000
  2498.          HTBL  FA,FB,CD,CE,CB,CF,CC,E1,FC,DD,DE,DB,DC,FD,FE,FF F C91325 04248500
  2499. *                                                                       04249000
  2500. KATOHEBK EQU   *             KATAKANA to Hitachi EBCDIK        @SC91325 04249500
  2501. *          ref: Hitachi manual, composite                      @SC91325 04250000
  2502.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C91325 04250500
  2503.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C91325 04251000
  2504.          HTBL  40,4F,7F,7B,E0,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C91325 04251500
  2505.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C91325 04252000
  2506.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C91325 04252500
  2507.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,5B,5A,5F,6D 5 C91325 04253000
  2508.          HTBL  79,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75 6 C91325 04253500
  2509.          HTBL  76,77,78,80,8B,9B,9C,A0,AB,B0,B1,C0,6A,D0,A1,07 7 C91325 04254000
  2510.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C91325 04254500
  2511.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,B9 9 C91325 04255000
  2512.          HTBL  57,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 A C91325 04255500
  2513.          HTBL  58,81,82,83,84,85,86,87,88,89,8A,8C,8D,8E,8F,90 B C91325 04256000
  2514.          HTBL  91,92,93,94,95,96,97,98,99,9A,9D,9E,9F,A2,A3,A4 C C91325 04256500
  2515.          HTBL  A5,A6,A7,A8,A9,AA,AC,AD,AE,AF,BA,BB,BC,BD,BE,BF D C91325 04257000
  2516.          HTBL  B3,B4,B5,B6,B7,B8,B2,CA,DA,DF,EA,EB,EC,ED,EE,EF E C91325 04257500
  2517.          HTBL  FA,FB,CD,CE,CB,CF,CC,E1,FC,DD,DE,DB,DC,FD,FE,FF F C91325 04258000
  2518. *                                                                       04258500
  2519. L2TOE870 EQU   *             Latin-2 to ROECE EBCDIC           @SC90152 04259000
  2520. *          ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04259500
  2521. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90152 04260000
  2522.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90152 04260500
  2523.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90152 04261000
  2524.          HTBL  40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90152 04261500
  2525.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90152 04262000
  2526.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90152 04262500
  2527.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90152 04263000
  2528.          HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90152 04263500
  2529.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90152 04264000
  2530.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90152 04264500
  2531.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90152 04265000
  2532.          HTBL  41,B1,80,BA,9F,77,AA,B5,BD,BC,AF,FD,B9,CA,B8,B4 A C90152 04265500
  2533.          HTBL  90,A0,9E,9A,BE,57,8A,70,9D,9C,8F,DD,B7,64,B6,B2 B C90152 04266000
  2534.          HTBL  ED,65,62,66,63,78,69,68,67,71,72,73,DA,75,76,FA C C90152 04266500
  2535.          HTBL  AC,BB,AB,EE,EB,EF,EC,BF,AE,74,FE,FB,FC,AD,B3,59 D C91067 04267000
  2536.          HTBL  CD,45,42,46,43,58,49,48,47,51,52,53,DF,55,56,EA E C90152 04267500
  2537.          HTBL  8C,9B,8B,CE,CB,CF,CC,E1,8E,54,DE,DB,DC,8D,44,B0 F C91067 04268000
  2538. *                                                                       04268500
  2539. L3TOE905 EQU   *             Latin-3 to Turkish EBCDIC         @SC90152 04269000
  2540. *          ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04269500
  2541. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC90152 04270000
  2542.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90152 04270500
  2543.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90152 04271000
  2544.          HTBL  40,4F,FC,EC,B9,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90152 04271500
  2545.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90152 04272000
  2546.          HTBL  AF,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90152 04272500
  2547.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,68,DC,B6,5F,6D 5 C90152 04273000
  2548.          HTBL  DA,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90152 04273500
  2549.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,48,8F,B3,CC,07 7 C90152 04274000
  2550.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90152 04274500
  2551.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90152 04275000
  2552.          HTBL  41,AA,80,B1,9F,70,BA,B5,BD,5B,7C,5A,BC,CA,AE,B4 A C90152 04275500
  2553.          HTBL  90,8A,EA,FA,BE,A0,9A,B7,9D,79,6A,D0,9C,B8,DF,B2 B C90152 04276000
  2554.          HTBL  64,65,62,66,63,67,AB,4A,74,71,72,73,78,75,76,77 C C90152 04276500
  2555.          HTBL  8E,69,ED,EE,EB,EF,7B,BF,BB,FD,FE,FB,7F,AD,AC,59 D C90152 04277000
  2556.          HTBL  44,45,42,46,43,47,8B,C0,54,51,52,53,58,55,56,57 E C90152 04277500
  2557.          HTBL  9E,49,CD,CE,CB,CF,A1,E1,9B,DD,DE,DB,E0,8D,8C,B0 F C90152 04278000
  2558. *                                                                       04278500
  2559. THTOE838 EQU   *             Thai ISO to Thai EBCDIC           @SC92233 04279000
  2560. *          ref: IBM code page registry + Trin Tantsetthi       @SC92233 04279500
  2561. *               0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F @SC92233 04280000
  2562.          HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C92233 04280500
  2563.          HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C92233 04281000
  2564.          HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C92233 04281500
  2565.          HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C92233 04282000
  2566.          HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C92233 04282500
  2567.          HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,49,E0,59,69,6D 5 C92233 04283000
  2568.          HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C92233 04283500
  2569.          HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C92233 04284000
  2570.          HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C92233 04284500
  2571.          HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C92233 04285000
  2572.          HTBL  41,42,43,44,45,46,47,48,52,53,54,55,56,57,58,62 A C92233 04285500
  2573.          HTBL  63,64,65,66,67,68,72,73,74,75,76,77,78,8A,8B,8C B C92233 04286000
  2574.          HTBL  8D,8E,8F,9A,9B,9C,9D,9E,9F,AA,AB,AC,AD,AE,AF,BA C C92233 04286500
  2575.          HTBL  BB,BC,BD,BE,BF,CB,CC,CD,CE,CF,DA,51,CA,FD,FE,70 D C92233 04287000
  2576.          HTBL  DB,DC,DD,DE,DF,EA,EB,EC,ED,EE,EF,FA,FB,FC,71,80 E C92233 04287500
  2577.          HTBL  B0,B1,B2,B3,B4,B5,B6,B7,B8,B9,90,A0,4A,5F,6A,E1 F C92233 04288000
  2578. *                                                                       04288500
  2579.          TITLE 'SETCON Routine - set correct controller type'  @SC91311 04289000
  2580. * Set TRMTP after determining that it's fullscreen             @SC91311 04289500
  2581. * Entry: R1= flags for desired technique:                      @SC91311 04290000
  2582. STCQBIT  EQU   X'01'         WSF Query is allowed              @SC91311 04290500
  2583. STCQNS1  EQU   X'02'         WSF Q implies *not* S/1           @SC91311 04291000
  2584. STCS1    EQU   X'04'         Always assume S/1                 @SC91311 04291500
  2585. STCNOS1  EQU   X'08'         Always assume *not* S/1           @SC91311 04292000
  2586. STCNORD  EQU   X'10'         Asynch READ MOD is forbidden      @SC91311 04292500
  2587. * Exit: R15=0 if ok.  TRMTP set.                               @SC91311 04293000
  2588. SETCON   ENTER                                                 @SC91311 04293500
  2589.          STC   1,STCFLGS                                       @SC91311 04294000
  2590.          MVI   TRMTP,C'S'    Remember going via S/1            @SC87166 04294500
  2591.          TM    STCFLGS,STCS1                                   @SC91311 04295000
  2592.          BO    RTRN0         Never check for S/1, assume it    @SC91311 04295500
  2593.          TM    STCFLGS,STCNOS1                                 @SC91311 04296000
  2594.          BO    STCGRP        Assume not S/1                    @SC91311 04296500
  2595.          TM    STCFLGS,STCQBIT+STCQNS1                         @SC91311 04297000
  2596.          BO    STCGRP        Definitely not S1                 @SC91311 04297500
  2597.          MVC   WRCMDL+4(4),F3  Preset the length to skip       @SC91150 04298000
  2598.          L     8,RIOPTRS                                       @SC90173 04298500
  2599.          XC    0(9,8),0(8)   Zero out buffer                   @SC88203 04299000
  2600.          LA    0,1                                             @SC88203 04299500
  2601.          KCALL SCRNIO        Clear screen and set up           @SC88203 04300000
  2602.          LA    0,6                                             @SC88203 04300500
  2603.          KCALL SCRNIO,STCS1ST,E=(STCSC,M) Issue status request @SC91311 04301000
  2604.          TM    STCFLGS,STCNORD READ MOD forbidden?             @SC91311 04301500
  2605.          BZ    STCSRST       No, do it                         @SC91311 04302000
  2606.          LA    0,7                                             @SC90264 04302500
  2607.          KCALL SCRNIO,RIOPTRS,E=(STCSC,NP) Read back screen    @SC91150 04303000
  2608.          CLC   =X'5BBC',4(8)                                   @SC90264 04303500
  2609.          BE    STCSC         String appeared on screen, not S1 @SC91150 04304000
  2610.          CLC   =X'5B60',4(8)                                   @SC93147 04304500
  2611.          BE    STCSC         Possible alternate appearance     @SC93147 04305000
  2612.          LA    0,6                                             @SC91150 04305500
  2613.          KCALL SCRNIO,STCS1STI,E=(STCSC,M) Again, with intrpt. @SC91150 04306000
  2614. STCSRST  LA    0,5                                             @SC91311 04306500
  2615.          KCALL SCRNIO,RIOPTRS Read back status                 @SC90173 04307000
  2616. STCSC    DS    0H                                              @SC91311 04307500
  2617.          LA    0,2                                             @SC88203 04308000
  2618.          KCALL SCRNIO        Release screen                    @SC88203 04308500
  2619.          CLI   0(8),X'E4'    Check for Yale status response    @SC88203 04309000
  2620.          BE    *+12          Ok, I trust                       @SC88294 04309500
  2621.           CLI  0(8),0        Other possibility                 @SC88294 04310000
  2622.           BNE  STCGRP        No, must be something else        @SC88294 04310500
  2623.          CLI   3(8),X'11'                                      @SC88203 04311000
  2624.          BNE   STCGRP        No, must be something else        @SC88203 04311500
  2625.          CLC   =X'2B5B5B',6(8)                                 @SC88203 04312000
  2626.          BE    RTRN0         Yes, all set                      @SC88203 04312500
  2627. STCGRP   MVI   TRMTP,C'A'    Assume AEA device                 @SC90173 04313000
  2628.          MVI   WRRD,5        Will want a reply in the test     @SC91311 04313500
  2629.          TM    STCFLGS,STCQBIT Query allowed?                  @SC91311 04314000
  2630.          BZ    STCGRG        No, assume GRAPHICS               @SC91311 04314500
  2631.          L     8,RIOPTRS                                       @SC90173 04315000
  2632.          XC    0(9,8),0(8)   Zero out buffer                   @SC90173 04315500
  2633.          LA    0,1                                             @SC90173 04316000
  2634.          KCALL SCRNIO        Clear screen and set up           @SC90173 04316500
  2635.          LA    0,4                                             @SC90173 04317000
  2636.          KCALL SCRNIO,STCAEAST,E=(STCAC,M) Issue Read Part'n   @SC91311 04317500
  2637.          LA    0,5                                             @SC90173 04318000
  2638.          KCALL SCRNIO,RIOPTRS Read back status                 @SC90173 04318500
  2639. STCAC    DS    0H                                              @SC91311 04319000
  2640.          LA    0,2                                             @SC90173 04319500
  2641.          KCALL SCRNIO        Release screen                    @SC90173 04320000
  2642.          CLI   0(8),X'88'    Check for WSF query reply         @SC90173 04320500
  2643.          BNE   STCGRG        No, must be something else        @SC90173 04321000
  2644.          CLC   3(2,8),=X'8180' Summary of replies 1st?         @SC90173 04321500
  2645.          BNE   STCGRG        No, must be something else        @SC90173 04322000
  2646.          SR    1,1                                             @SC90173 04322500
  2647.          ICM   1,3,1(8)      Get length of reply               @SC90173 04323000
  2648.          C     1,F64                                           @SC90173 04323500
  2649.          BNL   STCGRN        Too big, give up                  @SC90173 04324000
  2650.          LA    2,0(8,1)      Point to end                      @SC90173 04324500
  2651. STC5AL   CLI   0(2),X'8F'    OEM Aux device?                   @SC90173 04325000
  2652.          BE    RTRN0         Yes, all set                      @SC90173 04325500
  2653.          BCTR  2,0           No, keep looking                  @SC90173 04326000
  2654.          BCT   1,STC5AL                                        @SC90173 04326500
  2655. STCGRN   MVI   TRMTP,C'N'    Probably unsupported device       @SC90173 04327000
  2656.          B     RTRN0         That's all                        @SC90173 04327500
  2657. STCGRG   MVI   TRMTP,C'G'    Assume graphics device            @SC90173 04328000
  2658.          B     RTRN0                                           @SC90173 04328500
  2659. *                                                                       04329000
  2660. STCS1ST  DC    A(STCS1ORD,STCS1OL)                             @SC91311 04329500
  2661. STCS1ORD DC    &S1CMD1,AL1(SBA),X'4040'  Top of screen         @SC93147 04330000
  2662.          DC    X'2B5BBC'           Yale ASCII status request   @SC93147 04330500
  2663. STCS1OL  EQU   *-STCS1ORD                                      @SC91311 04331000
  2664. STCS1STI DC    A(STCS1ORI,STCS1OIL)                            @SC91311 04331500
  2665. STCS1ORI DC    &S1CMD1,X'2B5BBE'   Yale ASCII status w/ intrpt @SC91311 04332000
  2666. STCS1OIL EQU   *-STCS1ORI                                      @SC91311 04332500
  2667. STCAEAST DC    A(STCAEAQP,STCAEAL)                             @SC90173 04333000
  2668. STCAEAQP DC    &AEACMD,X'000501FF02' Read Partition Query      @SC90173 04333500
  2669. STCAEAL  EQU   *-STCAEAQP                                      @SC90173 04334000
  2670. *                                                                       04334500
  2671.          LOCALS ,                                              @SC86295 04335000
  2672. STCFLGS  DS    X             Flags for operation               @SC91311 04335500
  2673.          EXIT  ,                                               @SC86295 04336000
  2674.          TITLE 'HINTS Routine - give tips on setup etc'        @SC91295 04336500
  2675. HINTS    ENTER ,                                               @SC91295 04337000
  2676.          SR    0,0           Clear screen (if fullscreen)      @SC91295 04337500
  2677.          KCALL SCRNIO                                          @SC91295 04338000
  2678. ** BEGIN LANGUAGE-SPECIFIC DATA **                             @SC92300 04338500
  2679.          WTEXT 'Enter ? for a list of valid commands.'         @SC91295 04339000
  2680.          WTEXT 'Enter ? at any point (and press ENTER) for a list of op.04339500
  2681.                tions.  The minimum'                            @SC91295 04340000
  2682.          WTEXT '  abbreviations will be in uppercase.'         @SC91295 04340500
  2683.          WTEXT 'Generally, RECEIVE PACKET-SIZE should be set as large a.04341000
  2684.                s possible (to maximize'                        @SC91295 04341500
  2685.          WTEXT '  efficiency), but there may be buffer size limits due .04342000
  2686.                to comm hard/software.'                         @SC91295 04342500
  2687.          WTEXT '  For safety, set BLOCK-CHECK to 2 or 3 for packets >10.04343000
  2688.                0.'                                             @SC91295 04343500
  2689.          WTEXT 'For safety in sending binary files, set the FILE TYPE t.04344000
  2690.                o BINARY at both ends,'                         @SC91295 04344500
  2691.          WTEXT '  but maybe use V-BINARY at this end to preserve record.04345000
  2692.                 boundaries of the'                             @SC91295 04345500
  2693.          WTEXT '  original file.  Many Kermits convey the FILE TYPE aut.04346000
  2694.                omatically.'                                    @SC92300 04346500
  2695.          WTEXT '  Note: V-BINARY with RECEIVE is only for files origina.04347000
  2696.                lly sent that way.'                             @SC91295 04347500
  2697.          WTEXT 'Set the TRANSFER CHARACTER-SET to something appropriate.04348000
  2698.                 (the default of ASCII'                         @SC91295 04348500
  2699.          WTEXT '  limits text files to 128 code points, but it maps som.04349000
  2700.                e common EBCDIC'                                @SC91295 04349500
  2701.          WTEXT '  variants to the "expected" ASCII characters).  Reset .04350000
  2702.                the tables as needed.'                          @SC91295 04350500
  2703.          WTEXT 'Hint: gather your habitual setups into an INIT file.'   04351000
  2704. ** END LANGUAGE-SPECIFIC DATA **                               @SC92300 04351500
  2705.          WTEXT ' '                                             @SC91295 04352000
  2706.          STRTMSGS ,          Any system-specific messages...   @SC91295 04352500
  2707.          CLC   =C'ASCII',TRNALF Is it still default?           @SC91295 04353000
  2708.          BNE   HINTS1                                          @SC91295 04353500
  2709.          WTEXT '&TRANSFR &CHARSET&AAAAAIS.ASCII (7-bit)'       @SC91295 04354000
  2710. HINTS1   CLC   RPSIZ,=A(KMAX)  Default packet size (short)?    @SC91295 04354500
  2711.          BE    HINTS2          Yes, issue message              @SC91295 04355000
  2712.          BL    HINTS3          Actually smaller -- assume need @SC91295 04355500
  2713.          CLI   BCTC,C'1'       Greater, desire thorough check  @SC92085 04356000
  2714.          BNE   HINTS3          Ok, we're happy                 @SC92085 04356500
  2715.          WTEXT '&BLKCHCK&AAAAAIS.1 (&ZZSHORT)'                 @SC91295 04357000
  2716.          B     HINTS3                                          @SC91295 04357500
  2717. HINTS2   WTEXT '&RECEIVE &PACKSIZ&AAAAAIS.94 (&ZZSHORT)'       @SC91295 04358000
  2718. HINTS3   CLI   CLSNFL,C'O'     Overwrite?                      @SC91295 04358500
  2719.          BNE   HINTS4          No, don't quibble               @SC91295 04359000
  2720.          WTEXT '&AAAFILE &COLLISN&AAAAAIS.&OVERWRI (&ZZBEWAR)' @SC92300 04359500
  2721. HINTS4   DS    0H                                              @SC91295 04360000
  2722.          RET   ,                                               @SC91295 04360500
  2723. *                                                                       04361000
  2724.          LOCALS ,                                              @SC91295 04361500
  2725.          EXIT  ,                                               @SC91295 04362000
  2726.