home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / deleteme.tar.gz / deleteme.tar / ik0pro.asm < prev    next >
Assembly Source File  |  1993-10-21  |  241KB  |  2,973 lines

  1. *COPY                                                 IK0PRO            07500000
  2.          CHECKVER IK0PRO,4.3                                   @SC90072 07500500
  3.          TITLE 'SERVER Routine - performs Server mode functions'        07501000
  4. * Exit: ERRNUM set appropriately.                                       07501500
  5. SERVER   ENTER                                                          07502000
  6.          LA    0,SRVKFIN                                       @SC86295 07502500
  7.          L     1,=A(SRVKCMD)                                   @SC87012 07503000
  8.          BAL   14,LOOPS      Set up command loop               @SC86295 07503500
  9.          KCALL INTINI,1,E=SRVXIT Initialize for server         @SC87300 07504000
  10.          OI    FL2,SRV               Server is on                       07504500
  11.          MVI   ERRNUM,ERRNOE No errors yet                     @SC86156 07505000
  12.          XC    SRVIOS,SRVIOS Clear error count                 @SC90289 07505500
  13.          BAL   8,SRVLUP      Set state table                   @SC86135 07506000
  14. * Server mode Rpack interpret input table                      @SC86135 07506500
  15.          DC    AL1(AS),AL3(SRVREC)  Micro wants to send a file @SC86135 07507000
  16.          DC    AL1(AC),AL3(SRVHST)  A host command             @SC86171 07507500
  17.          DC    AL1(AI),AL3(0)       Micro sent parms           @SC86135 07508000
  18.          DC    AL1(AG),AL3(SRVGEN)  A generic command          @SC86135 07508500
  19.          DC    AL1(AK),AL3(SRVKRM)  A KERMIT command           @SC86158 07509000
  20.          DC    AL1(AR),AL3(SRVSND)  Micro wants to get a file  @SC86135 07509500
  21.          DC    XL1'FF',AL3(SRVSTP)  Stop                       @SC88074 07510000
  22.          DC    AL1(00),AL3(SRVILL)  Error routine              @SC86355 07510500
  23. SRVLUP   MVI   SEQ,0         Reset packet number               @SC86135 07511000
  24.          TM    FL3,ZPRO      Must stop?                        @SC88074 07511500
  25.          BO    SRVXIT        Yes, return immediately           @SC88074 07512000
  26.          OI    FL5,NAK0      Resend NAK during retry           @SC90037 07512500
  27.          MVC   SRVTIM,TIMOUT Save time-out limit               @SC86355 07513000
  28.          MVC   TIMOUT,TIMOSRV Set for server mode              @SC90045 07513500
  29.          MVC   LIMTRY,F5     Error loop 5 times for command    @SC86355 07514000
  30.          MVC   OLDERR,ERRNUM Save for STATUS                   @SC86158 07514500
  31.          MVC   SRVIOE,SRVIOS Current error count               @SC90289 07515000
  32.          XC    SRVIOS,SRVIOS Clear count in case no new error  @SC90289 07515500
  33.          BAL   9,INPUT       Read a packet and interpret       @SC86295 07516000
  34.          MVC   TIMOUT,SRVTIM Restore timeout setting           @SC86355 07516500
  35.          KCALL SPARSET       Set up for exchange               @SC86152 07517000
  36.          KCALL SPAR          Interpret I packet from other              07517500
  37.          KCALL RPAR          Reply to the I packet                      07518000
  38.          BAL   2,SENDACKL            Send an ACK, length set            07518500
  39.          MVC   ERRNUM(2),OLDERR Restore previous error code    @SC90059 07519000
  40.          B     SRVLUP        Loop again no matter what                  07519500
  41. *                                                                       07520000
  42. SRVREC   MVC   TIMOUT,SRVTIM Restore timeout setting           @SC86355 07520500
  43.          XC    SCANPTR,SCANPTR                                 @SC86295 07521000
  44.          LA    0,FFRCF                                         @SC86295 07521500
  45.          KCALL FSPEC,FILNAM  Get filespec                      @SC86295 07522000
  46.          KCALL INTINI,3,E=SRVXIT                               @SC87300 07522500
  47.          KCALL RECEIV        Get the file                               07523000
  48.          B     SRVLUP                End of file protocol               07523500
  49. *                                                                       07524000
  50. SRVSND   MVC   TIMOUT,SRVTIM Restore timeout setting           @SC86355 07524500
  51.          BAL   9,DECODEN     Decode the file name              @SC86295 07525000
  52.          ICM   0,B'1111',WBUFL       decoded name length                07525500
  53.          BNP   SRVMOP                                          @SC88323 07526000
  54.          L     1,WBUF                Decoded data                       07526500
  55. SRVSNT   STM   0,1,SCANPTR                                     @SC86295 07527000
  56.          LA    0,FFSND                                         @SC86295 07527500
  57.          KCALL FSPEC,IFILE,E=SRVERP   Get filespec             @SC86295 07528000
  58.          XC    SCANPTR,SCANPTR                                 @SC86295 07528500
  59.          LA    0,FFSND+FFRCF                                   @SC86295 07529000
  60.          KCALL FSPEC,JFSPEC,E=SRVERP  Get filespec             @SC86295 07529500
  61. SRVSNC   MVC   MSNDPTR,MSNDBUF No extra files                  @SC88306 07530000
  62.          KCALL SEND,0                                          @SC90239 07530500
  63.          B     SRVLUP                Go around again                    07531000
  64. *                                                                       07531500
  65. SRVGEN   MVC   TIMOUT,SRVTIM Restore timeout setting           @SC86355 07532000
  66.          BAL   9,DECODEN     Decode the command                @SC86295 07532500
  67.          ICM   0,15,WBUFL    Decoded command length            @SC86158 07533000
  68.          BNP   SRVMOP                                          @SC88323 07533500
  69.          MVI   ERRNUM,ERRNOE OK so far                         @SC86171 07534000
  70.          BCTR  0,0           Remove command from data length   @SC86158 07534500
  71.          L     1,WBUF        Decoded data                      @SC86158 07535000
  72.          IC    4,0(1)                                          @SC86158 07535500
  73.          BAL   2,CLKP        Dispatch on command               @SC86158 07536000
  74.          DC    AL1(AC),AL3(SRVCWD)  cwd                        @SC86158 07536500
  75.          DC    AL1(AD),AL3(SRVDIR)  directory                  @SC86158 07537000
  76.          DC    AL1(AE),AL3(SRVDEL)  erase                      @SC86158 07537500
  77.          DC    AL1(AF),AL3(SRVFIN)  finish                     @SC86158 07538000
  78.          DC    AL1(AH),AL3(SRVHLP)  help                       @SC86158 07538500
  79.          DC    AL1(AK),AL3(SRVCPY)  copy                       @SC86158 07539000
  80.          DC    AL1(AL),AL3(SRVFIN)  bye                        @SC86158 07539500
  81.          DC    AL1(AR),AL3(SRVREN)  rename                     @SC86158 07540000
  82.          DC    AL1(AT),AL3(SRVTYP)  type                       @SC86158 07540500
  83.          DC    AL1(AU),AL3(SRVQDS)  space                      @SC86158 07541000
  84.          DC    AL1(00),AL3(SRVERS)  Unknown command            @SC86158 07541500
  85. *                                                                       07542000
  86. SRVILL   MVC   TIMOUT,SRVTIM Restore timeout setting           @SC86355 07542500
  87.          CLI   ERRNUM,ERRTIE Terminal I/O?                     @SC90289 07543000
  88.          BE    SRVERP        Yes, not just bad command         @SC90289 07543500
  89. SRVERS   MVI   ERRNUM,ERRUSC Unknown Server command            @SC86156 07544000
  90. SRVERP   KCALL SUPFNC,5                                        @SC86158 07544500
  91.          KCALL ERPACK        Send an error packet              @SC86158 07545000
  92.          LA    0,1                                             @SC90289 07545500
  93.          AL    0,SRVIOE      Old I/O error count               @SC90289 07546000
  94.          ST    0,SRVIOS      New count                         @SC90289 07546500
  95.          CL    0,F5          Lots of consecutive errors?       @SC86158 07547000
  96.          BL    SRVLUP        Not yet, OK                       @SC86158 07547500
  97.          B     SRVXIT        Yes, give up now                  @SC86158 07548000
  98. *                                                                       07548500
  99. SRVMOP   MVI   ERRNUM,ERRMOP Missing operand                   @SC88323 07549000
  100.          B     SRVERP                                          @SC86158 07549500
  101. *                                                                       07550000
  102. SRVHST   MVC   TIMOUT,SRVTIM Restore timeout setting           @SC86355 07550500
  103.          BAL   9,DECODEN     Get command for host              @SC86171 07551000
  104.          BAL   9,SRVGPRW     To EBCDIC, start interception     @SC86295 07551500
  105.          B     LUPHST        Do it                             @SC86295 07552000
  106. *                                                                       07552500
  107. SRVKRM   MVC   TIMOUT,SRVTIM Restore timeout setting           @SC86355 07553000
  108.          BAL   9,DECODEN     Get command for Kermit            @SC86295 07553500
  109.          BAL   9,SRVGPRW     To EBCDIC, start interception     @SC86295 07554000
  110.          B     LUPTOK        Parse command                     @SC87012 07554500
  111. *                                                                       07555000
  112. SRVKF0   MVI   ERRNUM,ERRNOE No errors                         @SC86295 07555500
  113. SRVKFIN  MVC   OLDERR,ERRNUM Save error code                   @SC86295 07556000
  114.          KCALL SUPFNC,2      Clean up after interception       @SC86295 07556500
  115. SRVKFTX  LM    4,5,TXTPTR                                      @SC86158 07557000
  116.          SR    5,4           Any?                              @SC86158 07557500
  117.          LA    2,SRVLUP      Return adr                        @SC86158 07558000
  118.          BNP   SENDACK       No, just ACK command              @SC86158 07558500
  119.          LA    3,1023(5)     Round up                          @SC86158 07559000
  120.          SRA   3,10          Convert to kbytes                 @SC86158 07559500
  121.          ST    3,KBYTES                                        @SC86158 07560000
  122.          OI    FL4,SFM+TXT                                     @SC86158 07560500
  123.          XC    FLNOPTS(LFOPTS),FLNOPTS                         @SC91116 07561000
  124.          MVC   MSNDPTR,MSNDBUF No extra files                  @SC88306 07561500
  125.          KCALL SEND,0        Send all                          @SC90239 07562000
  126.          CLI   ERRNUM,ERRNOE Problem with SEND?                @SC86295 07562500
  127.          BNE   SRVLUP        Yes, remember that                @SC86295 07563000
  128.          MVC   ERRNUM(2),OLDERR No, use code from commands     @SC90033 07563500
  129.          B     SRVLUP        Get another command               @SC86158 07564000
  130. *                                                                       07564500
  131. SRVTYP   OI    FL4,TXT       Send disk file to remote display  @SC86158 07565000
  132.          BAL   9,SRVGSTR     Get file-spec                     @SC86295 07565500
  133.           B    SRVMOP        None, error                       @SC88323 07566000
  134.          B     SRVSNT                                          @SC86158 07566500
  135. *                                                                       07567000
  136. *        Send remote help message to other system              @SC86158 07567500
  137. SRVHLP   LA    4,RMHTXT      Where to copy HELP TEXT from      @SC86158 07568000
  138.          LA    5,RMHTXTZ     End of text                       @SC86158 07568500
  139.          STM   4,5,TXTPTR                                      @SC86158 07569000
  140.          B     SRVKFTX                                         @SC86158 07569500
  141. *                                                                       07570000
  142. SRVDIR   BAL   3,SRVUTL                                        @SC86295 07570500
  143.          DC    AL1(13,4+1)   Wild matches                      @SC86295 07571000
  144. *                                                                       07571500
  145. SRVDEL   BAL   3,SRVUTL                                        @SC86295 07572000
  146.          DC    AL1(14,0+1)   No wild matches                   @SC86295 07572500
  147. *                                                                       07573000
  148. SRVREN   BAL   3,SRVUTL                                        @SC86295 07573500
  149.          DC    AL1(15,4+2)   Wild matches                      @SC86295 07574000
  150. *                                                                       07574500
  151. SRVCPY   BAL   3,SRVUTL                                        @SC86295 07575000
  152.          DC    AL1(16,0+2)   No wild matches                   @SC86295 07575500
  153. *                                                                       07576000
  154. SRVCWD   BAL   9,SRVGSTR     Get operand                       @SC86295 07576500
  155.           B    SRVMOP                                          @SC88323 07577000
  156.          BAL   9,SRVGPRM     Convert to plist                  @SC86295 07577500
  157.          MVI   ERRNUM,ERRFNF In case of error                  @SC86158 07578000
  158.          KCALL CWDSET,E=SRVERP                                 @SC86158 07578500
  159.          B     SRVKF0        No errors                         @SC86295 07579000
  160. *                                                                       07579500
  161. SRVQDS   BAL   9,SRVGSTR     Extract letter                    @SC86295 07580000
  162.           LA   0,0           None, use default                 @SC86158 07580500
  163.          BAL   9,SRVGPRM                                       @SC86295 07581000
  164.          B     LUPSPA                                          @SC86295 07581500
  165. * Generate command PLIST: R3-> parms                           @SC86158 07582000
  166. SRVUTL   LA    2,FILNAM      1st or only filespec              @SC86295 07582500
  167.          LH    4,0(3)                                          @SC86295 07583000
  168.          N     4,F3          Get number of names               @SC86295 07583500
  169. SRVUTLP  XC    SCANPTR,SCANPTR                                 @SC86295 07584000
  170.          BAL   9,SRVGSTR     Extract file-spec                 @SC86295 07584500
  171.           B    SRVUT1        None, check if wildcard allowed   @SC86158 07585000
  172.          STM   0,1,SCANPTR                                     @SC86295 07585500
  173. SRVUT1   LA    0,FFUTL                                         @SC86295 07586000
  174.          TM    1(3),4        Test flag                         @SC86295 07586500
  175.          BZ    *+8                                             @SC86295 07587000
  176.          LA    0,FFUTL+FFWLD Wild match if part omitted        @SC86295 07587500
  177.          KCALL FSPEC,(2),E=SRVERP  Get filespec into command   @SC86295 07588000
  178.          LR    0,6           Length remaining                  @SC86158 07588500
  179.          LR    1,7           Next field                        @SC86158 07589000
  180.          LA    2,IFILE       2nd ptr                           @SC86158 07589500
  181.          BCT   4,SRVUTLP     Loop over file-specs              @SC86158 07590000
  182.          KCALL SUPFNC,1      Start interception                @SC86158 07590500
  183.          MVI   ERRNUM,ERRFNF File not found if error here      @SC90264 07591000
  184.          CLC   0(1,3),SRVDIR+4                                 @SC86158 07591500
  185.          BE    SRVUT6        Don't issue STATE if DIR cmd      @SC86158 07592000
  186.          OPENF V,FILNAM,E=SRVERP Verify its existence          @SC91269 07592500
  187.          MVI   ERRNUM,ERRKCE In case of any other problem      @SC90264 07593000
  188. SRVUT6   LA    1,FILNAM      1st or only filespec              @SC86295 07593500
  189.          LA    2,IFILE       Possible 2nd                      @SC86295 07594000
  190.          XR    0,0                                             @SC86295 07594500
  191.          IC    0,0(3)                                          @SC86295 07595000
  192.          KCALL DISKIO,E=SRVERP                                 @SC90264 07595500
  193.          MVI   ERRNUM,ERRNOE No problem                        @SC90264 07596000
  194.          B     SRVKFIN                                         @SC86295 07596500
  195. * Get substring from Generic command                           @SC86158 07597000
  196. * R0= no. of chars left in packet excluding substr count byte  @SC86158 07597500
  197. * R1-> one before count byte                                   @SC86158 07598000
  198. SRVGSTR  MVI   ERRNUM,ERRIPS Assume missing operand            @SC88323 07598500
  199.          BCTR  0,0           Remove operand length field       @SC86158 07599000
  200.          LA    7,1(1)        ditto                             @SC86158 07599500
  201.          LTR   6,0           If no operands                    @SC86158 07600000
  202.          BNPR  9              then return error                @SC86295 07600500
  203.          UNCHR 0,1(1)        Operand size                      @SC86158 07601000
  204.          BZR   9             Error if zero length field        @SC86295 07601500
  205.          BM    SRVERP        Really bad                        @SC88323 07602000
  206.          LA    1,2(1)        Location of operand               @SC86158 07602500
  207.          AR    7,0           Get ptr to next field             @SC86158 07603000
  208.          SR    6,0           Length remaining                  @SC86158 07603500
  209.          BM    SRVERP        Inconsistant                      @SC88323 07604000
  210.          B     4(9)                                            @SC86295 07604500
  211. * Set up copy                                                           07605000
  212. SRVGPRW  ICM   0,15,WBUFL                                      @SC86171 07605500
  213.          BNP   SRVMOP        No text                           @SC88323 07606000
  214.          L     1,WBUF        Ptr to text                       @SC86171 07606500
  215. * Copy parameter at (R1), length in R0 and set up interception @SC86158 07607000
  216. SRVGPRM  LTR   15,0          Any chars?                        @SC86171 07607500
  217.          BNP   SRVGPS        No                                @SC86171 07608000
  218.          BCTR  15,0          Yes, translate                    @SC86171 07608500
  219.          LA    14,ATOE        Current A-to-E                   @SC91284 07609000
  220.          CLC   =C'&TRANSPA',TRNALF                             @SC91284 07609500
  221.          BNE   *+8                                             @SC91284 07610000
  222.           LA   14,ATOED      Use default if "transparent"      @SC91284 07610500
  223.          EX    15,SRVGPTRA                                     @SC91284 07611000
  224.          EX    15,TRUPCAS                                      @SC86171 07611500
  225. SRVGPS   STM   0,1,SCANPTR   Save string ptrs                  @SC86158 07612000
  226.          KCALL SUPFNC,1      Start intercepting                @SC86158 07612500
  227.          BR    9                                               @SC86295 07613000
  228. SRVGPTRA TR    0(,1),0(14)                                     @SC91284 07613500
  229. *                                                                       07614000
  230. SRVFIN   MVI   WRRD,0                Just write (no read) when ending   07614500
  231.          MVI   AEAFLG,X'80'  ditto                             @SC90173 07615000
  232.          MVC   S1HND,SVHND   Always use requested handshake    @SC87343 07615500
  233.          BAL   2,SENDACK             Send an ACK                        07616000
  234.          L     1,WBUF        Ptr to decoded data               @SC86190 07616500
  235.          CLI   0(1),AL                                         @SC86190 07617000
  236.          BNE   SRVNOLOG      Skip logging out                  @SC86295 07617500
  237.          CLOSF LOGPTR        Close debug-log                   @SC86135 07618000
  238.          KCALL SUPFNC,8      Log out                           @SC86295 07618500
  239. SRVNOLOG DS    0H            (or fall through just in case)    @SC86295 07619000
  240.          MVC   ERRNUM(2),OLDERR Copy back error number         @SC90033 07619500
  241. SRVXIT   NI    FL2,255-SRV   Turn off SERVER mode              @SC86158 07620000
  242.          KCALL INTINI,0      Clear interrupt trapping                   07620500
  243.          RET                                                            07621000
  244. *                                                                       07621500
  245. SRVSTP   MVC   TIMOUT,SRVTIM Restore timeout                   @SC88074 07622000
  246.          B     SRVXIT                                          @SC88074 07622500
  247. *                                                                       07623000
  248. RMHTXT   EQU   *                                               @SC92300 07623500
  249. ** BEGIN LANGUAGE-SPECIFIC DATA **                             @SC92300 07624000
  250.          DC    C'Kermit-&KSYS. Server handles the following:'  @SC86268 07624500
  251.          DC    X'1515'                                         @SC86158 07625000
  252.          DC C'Function          Standard command',X'15'        @SC86158 07625500
  253.          DC C'--------          ----------------',X'1515'      @SC86158 07626000
  254.          DC C'Send a file       SEND file',X'15'               @SC86158 07626500
  255.          DC C'Retrieve a file   GET file',X'15'                @SC86158 07627000
  256.          DC C'Log off system    BYE or LOGOUT',X'15'           @SC86158 07627500
  257.          DC C'Exit from server  FINISH',X'15'                  @SC86158 07628000
  258.          DC C'Issue Kermit cmd  REMOTE KERMIT cmd',X'15'       @SC86158 07628500
  259.          DC C'Issue system cmd  REMOTE HOST [CP] cmd',X'15'    @SC86268 07629000
  260.          DC C'List directory    REMOTE DIRECTORY file',X'15'   @SC86158 07629500
  261.          DC C'Type a file       REMOTE TYPE file',X'15'        @SC86158 07630000
  262.          DC C'Copy a file       REMOTE COPY f1 f2',X'15'       @SC86158 07630500
  263.          DC C'Rename a file     REMOTE RENAME f1 f2',X'15'     @SC86158 07631000
  264.          DC C'Erase a file      REMOTE DELETE file',X'15'      @SC86158 07631500
  265.          DC C'Print a file      REMOTE PRINT file',X'15'       @SC91198 07632000
  266.          DC C'Change disk area  REMOTE CWD area',X'15'         @SC86158 07632500
  267.          DC C'Show disk space   REMOTE SPACE area',X'15'       @SC86158 07633000
  268. ** END LANGUAGE-SPECIFIC DATA **                               @SC92300 07633500
  269. RMHTXTZ  EQU   *                                               @SC86158 07634000
  270.          LOCALS ,                                              @SC86295 07634500
  271. RETADR   DS    A             Return adr if no more TAKE stuff  @SC86295 07635000
  272. CMDPTR   DS    A             Adr of command table              @SC86295 07635500
  273. TAKLEV   DS    F             Take file level                   @SC86121 07636000
  274. TAKTAB   DS    (TAKMAX)F     Tickets for I/O                   @SC86295 07636500
  275. SRVTIM   DS    X             Saved timeout limit               @SC86355 07637000
  276. SRVIOE   DS    F             Current terminal I/O error count  @SC90289 07637500
  277. SRVIOS   DS    F             Saved terminal I/O error count    @SC90289 07638000
  278. SERVER   EXIT                                                           07638500
  279.          TITLE 'SEND Routine - sends a file'                            07639000
  280. * Send file(s) and set ERRNUM appropriately                             07639500
  281. * Entry: filespec pattern in IFILE, Disp code (if any) in R1   @SC90239 07640000
  282. SEND     ENTER                                                          07640500
  283.          STC   1,SNDDSP      Save code                         @SC90239 07641000
  284.          XC    NSENTAC(LSTATS),NSENTAC Clear statistics        @SC90179 07641500
  285.          KCALL SUPFNC,10                                       @SC86295 07642000
  286.          ST    15,SECTOT     Save start time                   @SC86295 07642500
  287.          ST    15,TINSV+12   Also for length tuning            @SC88325 07643000
  288.          ST    15,TINSV+28                                     @SC88325 07643500
  289.          ST    15,TINSV+44                                     @SC88325 07644000
  290.          TM    FL4,SFM                                         @SC86295 07644500
  291.          BO    *+10          From memory: keep old file list   @SC86295 07645000
  292.          XC    NSENT,NSENT           Number of files sent               07645500
  293.          MVI   SNFLG,FIRST   Haven't started yet               @SC86295 07646000
  294.          XC    FDATE,FDATE   Clear file date                   @SC86295 07646500
  295.          LA    0,TUNECT      Time to tune up                   @SC88349 07647000
  296.          STH   0,SNPKCT                                        @SC86345 07647500
  297.          MVI   REASON,0      Not rejected yet                  @SC86316 07648000
  298.          MVI   SEQ,0         Reset packet number               @SC86135 07648500
  299.          TM    FL4,SFM                                         @SC88100 07649000
  300.          BO    SNDS8         Just sending from memory          @SC88100 07649500
  301. SNDSET   OI    SNFLG,NEWGRP  Haven't started yet               @SC88306 07650000
  302.        NXTFSET IFILE,E=SNDNON Init for NXTFST call             @SC87012 07650500
  303. SNDS8    LA    8,SNDST       Set state table                   @SC89263 07651000
  304. SNDNXT   CLI   CXZ,AZ                                                   07651500
  305.          BE    SNDBRK        Stop file group send                       07652000
  306.          MVI   FRECF,C'F'    Just in case                      @SC86151 07652500
  307.          TM    FL4,SFM                                         @SC86158 07653000
  308.          BO    SNDNOW        Just sending from memory          @SC86158 07653500
  309.          NXTF  E=SNDNON      Get next/first file               @SC86295 07654000
  310.          MVI   CXZ,0                 In case aborted last file          07654500
  311.          MVI   REASON,0      Not rejected yet                  @SC86316 07655000
  312.          MVC   FLNOPTS(LFOPTS),IFOPTS Copy file options        @SC89218 07655500
  313.          L     5,TSENT       Table of files sent (transactions)@SC90179 07656000
  314.          ICM   4,15,NSENT    Number of files sent              @SC90179 07656500
  315.          AIF   ('&KSYS' NE 'CMS').SOPN                         @SC86295 07657000
  316.          BZ    SNDOPN        Go if none sent yet               @SC86295 07657500
  317.          NI    SNFLG,255-NEWGRP Not first of this group        @SC92300 07658000
  318. SNDTBL   CLC   0(16,5),FILNAM                                  @SC86295 07658500
  319.          BE    SNDNXT                Go if sent already                 07659000
  320.          A     5,FLFID1      Next filespec                     @SC88092 07659500
  321.          BCT   4,SNDTBL                                                 07660000
  322. .SOPN    ANOP                                                           07660500
  323. SNDOPN   OPENF I,FILNAM,FILFDB,FILPTR,E=SNDFNF                 @SC87012 07661000
  324.          USING FDBD,1                                          @SC86295 07661500
  325.          MVC   FRECF,FDBRCF  Save format and file size         @SC86295 07662000
  326.          MVC   KBYTES,FDBSIZE                                  @SC86295 07662500
  327.          MVC   FDATE,FDBDATE Save file date                    @SC86295 07663000
  328.          DROP  1                                               @SC86295 07663500
  329.          KCALL ACCTST,FILNAM Copy name to table                @SC90179 07664000
  330.          POINTF FILPTR,FLNOPTS,E=SNDSHRT Skip, if requested    @SC89218 07664500
  331.          CLI   TRMLIN,C' '   Alt. line?                        @SC87300 07665000
  332.          BE    SNDNOW        No, be quiet                      @SC87300 07665500
  333.          INITSTR '&SENDING',CMD,REG=7 Yes, display message     @SC92300 07666000
  334.          LA    1,FILNAM                                        @SC87300 07666500
  335.          BAL   2,STAFSP      Format name and show it           @SC87300 07667000
  336. SNDNOW   NI    SNFLG,255-NEWGRP Not first of this group        @SC88306 07667500
  337.          TM    SNFLG,FIRST                                     @SC86295 07668000
  338.          BZ    SNDFIL                Go if not first file               07668500
  339.          NI    SNFLG,255-FIRST No first file flag              @SC86295 07669000
  340.          MVC   LIMTRY,MAXTNT Limit for INIT retries            @SC86345 07669500
  341.          TM    FL4,NPS       Non-protocol?                     @HF86232 07670000
  342.          BZ    SNDPRO        No, normal send message           @HF86232 07670500
  343.          KCALL INTINI,5,E=SNDRET  Initialize for non-protocol  @SC87300 07671000
  344.          B     SNDATZ        Skip protocol stuff               @HF86232 07671500
  345. SNDPRO   KCALL INTINI,2,E=SNDRET  Initialize for send          @SC87300 07672000
  346.          TM    FL2,SRV                                                  07672500
  347.          BO    SNDINI                Go if Server mode                  07673000
  348.          L     0,LCLDLY      Time to wait                      @SC86164 07673500
  349.          KCALL SUPFNC,9                                        @SC86295 07674000
  350. SNDINI   DS    0H                                              @SC86152 07674500
  351.          KCALL RPARSET       Set up for exchange               @SC86152 07675000
  352.          KCALL RPAR          Our S packet to send              @SC86152 07675500
  353.          MVI   STYPE,AS              PACKET TYPE = SEND INITIATE        07676000
  354.          MVC   RTYPPRV,RTYPE Set up in case S packet gets lost @SC89263 07676500
  355.          BAL   9,INPUTSPK    Send RPAR and Interpret response  @SC86295 07677000
  356.          KCALL SPAR          Interpret reply to our S packet            07677500
  357.          MVC   BCTU,BCTR     Switch chk,flg to negotiated one  @SC92085 07678000
  358.          CLI   BCTR,AA       Blank suppression?                @SC92085 07678500
  359.          BL    *+8           No, flag was off already          @SC92085 07679000
  360.           MVI  BCTOFF+3,1    Yes, turn it on                   @SC92085 07679500
  361.          NI    BCTU,15       Use just length here              @SC92085 07680000
  362.          MVC   LIMTRY,MAXTRY Reset limit                       @SC86164 07680500
  363.          BAL   14,INCRSEQ                                               07681000
  364.          CLI   SNDDSP,0      Any special disposition?          @SC90239 07681500
  365.          BE    SNDFIL        No, skip it                       @SC90239 07682000
  366.          TM    RCAPA,8       Yes -- can we send attributes?    @SC90239 07682500
  367.          BZ    SNDCMDER      No.  Give up                      @SC90239 07683000
  368. SNDFIL   MVI   STYPE,AX      Text transmission?                @SC86158 07683500
  369.          TM    FL4,TXT                                         @SC86158 07684000
  370.          BO    *+8           Yes                               @SC86158 07684500
  371.          MVI   STYPE,AF      Packet type = file header         @SC86158 07685000
  372.          XC    DATL,DATL     Null file spec.                   @SC86158 07685500
  373.          TM    FL4,SFM                                         @SC86158 07686000
  374.          BNZ   SNDCNTH       From memory, no file name         @SC86158 07686500
  375.          BAL   9,PAKFIL      Compress to buffer with appends   @HF86223 07687000
  376.          CLI   TRMLIN,C' '   Alt. line?                        @SC87300 07687500
  377.          BE    SNDFIL2       No, be quiet                      @SC87300 07688000
  378.          INITSTR '&AAAAAAS',CMD  Yes, display message          @SC92300 07688500
  379.          L     1,RBUF        Ptr to name in ASCII              @SC87300 07689000
  380.          MVC   0(250,15),0(1)                                  @SC87300 07689500
  381.          TR    0(250,15),ATOED Back to EBCDIC                  @SC89301 07690000
  382.          AR    15,7          End of msg + name                 @SC87300 07690500
  383.          BAL   2,STAPM15     Show sending name                 @SC87300 07691000
  384. SNDFIL2  DS    0H                                              @SC87300 07691500
  385. SNDCNT   BAL   9,ENCODEN     Encode fn                         @SC86295 07692000
  386. SNDCNTH  BAL   9,INPUTSPK    Send name and interpret response  @SC86295 07692500
  387.          BAL   14,INCRSEQ                                               07693000
  388.          MVC   TMP,SCAPA     Copy my flags                     @SC86149 07693500
  389.          NI    TMP,8         Attributes                        @SC86149 07694000
  390.          NC    TMP,RCAPA     Check if both on                  @SC86149 07694500
  391.          BZ    SNDATZ        No, skip it                       @SC86149 07695000
  392.          L     5,ASDATA                                        @SC86295 07695500
  393.          BAL   2,SNDPKLC     Check length of attribute info    @SC90037 07696000
  394.          ICM   4,15,KBYTES   File length known?                @SC86295 07696500
  395.          BZ    SNDAT0        No, skip it                       @SC86316 07697000
  396.          TM    ATFLG,ATFLNG  Length attribute desired?         @SC90037 07697500
  397.          BZ    SNDAT0        No, skip it                       @SC90037 07698000
  398.          MVI   0(5),AEXCL    Yes, ASCII ! => size              @SC88273 07698500
  399.          LA    15,2(5)                                         @SC86295 07699000
  400.          BAL   2,EDDEC       Format it                         @SC86295 07699500
  401.          TR    2(9,5),ETOAD  Convert plenty to ASCII           @SC88273 07700000
  402.          SR    15,5                                            @SC86295 07700500
  403.          LA    4,ABL-2(15)   Number of digits (printably)      @SC88273 07701000
  404.          STC   4,1(5)                                          @SC86295 07701500
  405.          AR    5,15          End of string                     @SC86295 07702000
  406. SNDAT0   TM    ATFL2,ATFORG  Origin wanted?                    @SC90037 07702500
  407.          BZ    SNDAT0B       No, skip it                       @SC90037 07703000
  408.          BAL   2,SNDPKLC     Check length of attribute info    @SC90037 07703500
  409.          MVC   0(LSYSATR,5),SYSATR                             @SC90037 07704000
  410.          LA    5,LSYSATR(5) System code                        @SC88273 07704500
  411. SNDAT0B  TM    ATFLG,ATFTYP  Type wanted?                      @SC90037 07705000
  412.          BZ    SNDAT1Z       No, skip it and encoding too      @SC90037 07705500
  413.          BAL   2,SNDPKLC     Check length of attribute info    @SC90037 07706000
  414.          MVC   0(3,5),=AL1(ABL+2,ABL+1,AB) "!B - it's binary   @SC88273 07706500
  415.          TM    FL4,SFM       Sending from memory buffer?       @SC90016 07707000
  416.          BO    *+12          Yes, always text file             @SC90016 07707500
  417.          TM    FL1,BINF      Binary file?                      @SC86149 07708000
  418.          BO    SNDAT1        Yes                               @SC86316 07708500
  419.          MVC   2(4,5),=AL1(AA,ABL+10,ABL+1,AA) A*!A - ASCII    @SC88273 07709000
  420.          TM    ATFL2,ATFENC  Encoding wanted?                  @SC90037 07709500
  421.          BZ    SNDAT1        No, skip it                       @SC90037 07710000
  422.          LA    5,3(5)        Advance over extra item           @SC86316 07710500
  423.          ICM   2,15,CDESPTR                                    @SC90040 07711000
  424.          BZ    SNDAT1                                          @SC90040 07711500
  425.          MVI   2(5),AC       Level-1 syntax                    @SC90040 07712000
  426.          SR    1,1                                             @SC90040 07712500
  427.          IC    1,4(,2)       Get length of designator          @SC90040 07713000
  428.          LA    0,ABL+1(,1)   Modified length of ENC attribute  @SC90040 07713500
  429.          STC   0,1(,5)                                         @SC90040 07714000
  430.          MVC   3(11,5),5(2)  Copy plenty of text               @SC90040 07714500
  431.          AR    5,1           Account for extra stuff           @SC90040 07715000
  432. SNDAT1   LA    5,3(5)                                          @SC86316 07715500
  433. SNDAT1Z  TM    ATFL2,ATFFMT  Format wanted?                    @SC90037 07716000
  434.          BZ    SNDAT3        No, skip it                       @SC90037 07716500
  435.          BAL   2,SNDPKLC     Check length of attribute info    @SC90037 07717000
  436.          IC    4,TYPFIL      Specific file type                @SC86295 07717500
  437.          BAL   2,CLKP        Dispatch via table                @SC86295 07718000
  438.          DC    C'T',AL3(SNDATT)  Text                          @SC86295 07718500
  439.          DC    C'D',AL3(SNDATD)  D-binary                      @SC86295 07719000
  440.          DC    C'V',AL3(SNDATV)  V-binary                      @SC86295 07719500
  441.          DC    X'0',AL3(SNDAT3)  Must be Binary                @SC86295 07720000
  442. SNDATT   BAL   2,SNDAT2                                        @SC86295 07720500
  443.          DC    AL1(ABL+3,AA,AM,AJ) #AMJ Delimited              @SC88273 07721000
  444. SNDATD   BAL   2,SNDAT2                                        @SC86295 07721500
  445.          DC    AL1(ABL+2,AD,A5)    "D5  Undelimited 5-byte pref@SC90037 07722000
  446. SNDATV   BAL   2,SNDAT2                                        @SC86295 07722500
  447.          DC    AL1(ABL+2,AV,A2)    "V2  2-byte bin. pref.      @SC90037 07723000
  448. SNDAT2   MVI   0(5),ABL+15   ASCII / => Format                 @SC88273 07723500
  449.          MVC   1(9,5),0(2)   Copy string                       @SC86295 07724000
  450.          UNCHR 4,0(2)        Get length                        @SC88273 07724500
  451.          LA    5,2(4,5)      Update string ptr                 @SC86295 07725000
  452. SNDAT3   CLI   FDATE,0       File date defined?                @SC86295 07725500
  453.          BE    SNDAT5        No, skip it                       @SC90037 07726000
  454.          TM    ATFLG,ATFDAT  Date wanted?                      @SC90037 07726500
  455.          BZ    SNDAT5        No, skip it                       @SC90037 07727000
  456.          BAL   2,SNDPKLC     Check length of attribute info    @SC90037 07727500
  457.          MVC   0(2,5),=AL1(A#,ABL+8) Yes, yyyymmdd (ASCII #)   @SC88273 07728000
  458.          UNPK  2(9,5),FDATE(5) Insert zones                    @SC86295 07728500
  459.          LA    4,10(5)       End of date                       @SC88273 07729000
  460.          CLC   FDATE+4(3),F0 Time defined too?                 @SC88235 07729500
  461.          BE    SNDAT4        No, just use date                 @SC88235 07730000
  462.          MVI   1(5),ABL+17   Yes, add string length - hh:mm:ss @SC88273 07730500
  463.          MVC   10(9,5),TIMPLT and edit time                    @SC88235 07731000
  464.          ED    10(9,5),FDATE+4                                 @SC88235 07731500
  465.          CLI   11(5),C' '                                      @SC88235 07732000
  466.          BNE   *+8                                             @SC88235 07732500
  467.          MVI   11(5),C'0'    Insist on leading zeroes          @SC88235 07733000
  468.          LA    4,9(4)        Advance over time                 @SC88273 07733500
  469. SNDAT4   TR    2(17,5),ETOAD Convert date/time to ASCII        @SC88273 07734000
  470.          LR    5,4           New ptr in either case            @SC88273 07734500
  471. SNDAT5   TM    ATFL2,ATFDSP  Disposition wanted?               @SC90239 07735000
  472.          BZ    SNDAT6        No                                @SC90239 07735500
  473.          CLI   SNDDSP,0                                        @SC90239 07736000
  474.          BE    SNDAT6        No special disposition            @SC90239 07736500
  475.          BAL   2,SNDPKLC     Check length of attribute info    @SC90239 07737000
  476.          MVI   0(5),APLUS    Disposition attribute             @SC90239 07737500
  477.          MVC   2(,5),SNDDSP  Selected code                     @SC90239 07738000
  478.          LM    6,7,LEN       Any options?                      @SC90239 07738500
  479.          LTR   6,6                                             @SC90239 07739000
  480.          BZ    SNDAT5B       No                                @SC90239 07739500
  481.          MVC   3(80,5),0(7)  Yes, allow up to 80 bytes         @SC90239 07740000
  482.          TR    3(80,5),ETOAD Convert to ASCII                  @SC90239 07740500
  483. SNDAT5B  LA    2,1(,6)       Length of code + options          @SC90239 07741000
  484.          TOCHR 2,,1(,5)      Save in packet                    @SC90239 07741500
  485.          LA    5,3(6,5)      Advance ptr                       @SC90239 07742000
  486. SNDAT6   DS    0H                                              @SC90239 07742500
  487.          TM    ATFL4,ATFEND  End-signal wanted?                @SC91109 07743000
  488.          BZ    SNDATY        No                                @SC91109 07743500
  489.          BAL   2,SNDPKLC     Check length of attribute info    @SC90037 07744000
  490.          MVC   0(2,5),=AL1(A@,ABL)  Zero-length attribute      @SC91109 07744500
  491.          LA    5,2(,5)       Advance ptr                       @SC91109 07745000
  492. SNDATY   BAL   2,SNDPKLC     Check length of attribute info    @SC91109 07745500
  493.          SR    8,8           Unconditionally send all          @SC90037 07746000
  494.          LA    2,SNDATZ      Place to go when done             @SC90037 07746500
  495.          ST    2,SNDPKLR                                       @SC90037 07747000
  496.          B     SNDAT9                                          @SC90037 07747500
  497. * Send A-packet if buffer full.  Use last version that fit.    @SC90037 07748000
  498. SNDPKLC  L     8,MAXSIZ      Set limit for packet              @SC90037 07748500
  499. SNDAT9   L     15,ASDATA                                       @SC86295 07749000
  500.          SR    5,15                                            @SC86295 07749500
  501.          BNP   SNDPKLZ                                         @SC90037 07750000
  502.          CR    5,8           Full yet?                         @SC90037 07750500
  503.          BNH   SNDPKLZ       No, go back for more              @SC90037 07751000
  504.          ICM   8,15,SNDPKLN  Length from last time through     @SC90239 07751500
  505.          BZ    *+6           None. Must be one big attribute   @SC90239 07752000
  506.           LR   5,8           Ok, use it                        @SC90239 07752500
  507.          ST    5,DATL        Set length                        @SC86295 07753000
  508.          LA    8,SNDST       Restore state ptr                 @SC89263 07753500
  509.          MVI   STYPE,AA                                        @SC86149 07754000
  510.          BAL   9,INPUTSPK    Send it                           @SC86295 07754500
  511.          BAL   14,INCRSEQ                                      @SC86149 07755000
  512.          CLC   DATL,F0       Any objections?                   @SC86149 07755500
  513.          BE    SNDPKLX       Ok                                @SC90037 07756000
  514.          L     1,ARDATA                                        @SC86316 07756500
  515.          CLI   0(1),AN       Refused?                          @SC86149 07757000
  516.          BE    SNDCAN        Sigh                              @SC86149 07757500
  517. SNDPKLX  SR    5,5           Clear length to send              @SC90037 07758000
  518.          L     2,SNDPKLR     Will have to redo                 @SC90037 07758500
  519. SNDPKLZ  ST    5,SNDPKLN     Save length available             @SC90037 07759000
  520.          A     5,ASDATA      Restore as ptr into buffer        @SC90037 07759500
  521.          ST    2,SNDPKLR     Where to go if need to redo       @SC90037 07760000
  522.          BR    2                                               @SC90037 07760500
  523. *                                                              @SC90037 07761000
  524. SNDATZ   DS    0H                                              @SC86149 07761500
  525.          NI    FL1,255-EOF           Not end of file yet                07762000
  526.          BAL   14,RDWSET     Check for special format          @SC86151 07762500
  527.          MVI   LCKOLD,0      Start at normal state             @SC91275 07763000
  528.          XC    RBUFL,RBUFL           No data in input buffer            07763500
  529.          MVI   CARCTL,0      Initialize flag, if CC            @SC91116 07764000
  530.          TM    FL4,NPS       Non-protocol?                     @SC86165 07764500
  531.          BO    SNDNPS        Yes, do it                        @SC86165 07765000
  532. SNDENC   KCALL ENCODE,E=SNDENX Encode the data and more                 07765500
  533. SNDDAT   MVI   STYPE,AD              PACKET TYPE = DATA                 07766000
  534.          BAL   9,INPUTSPK    Send data and interpret reply     @SC86295 07766500
  535.          BAL   14,INCRSEQ                                               07767000
  536.          LH    15,SNPKCT                                       @SC86345 07767500
  537.          BCT   15,SNDTUNZ    No tuning yet                     @SC86345 07768000
  538.          CLC   MAXSIZ+4,AKMAX Long packets selected?           @SC86345 07768500
  539.          BNP   SNDTUNY       No                                @SC86345 07769000
  540.          KCALL SUPFNC,10     Get time                          @SC88325 07769500
  541.          ST    15,CSECTOT    Save                              @SC88325 07770000
  542.          KCALL OPTPKT        Calculate optimum size            @SC88325 07770500
  543.          LTR   15,15         Valid?                            @SC86345 07771000
  544.          BNP   SNDTUNY       No                                @SC86345 07771500
  545.          C     15,MAXSIZ+4   Other Kermit's limit              @SC86345 07772000
  546.          BNH   *+8                                             @SC86345 07772500
  547.          L     15,MAXSIZ+4                                     @SC86345 07773000
  548.          C     15,AKMAX                                        @SC86345 07773500
  549.          BNL   *+8                                             @SC86345 07774000
  550.          L     15,AKMAX      Don't get too small               @SC86345 07774500
  551.          ST    15,MAXSIZ     Set send limit                    @SC86345 07775000
  552. SNDTUNY  LA    15,TUNECT     Repeat target                     @SC88349 07775500
  553. SNDTUNZ  STH   15,SNPKCT                                       @SC86345 07776000
  554.          CLC   DATL,F1                                                  07776500
  555.          BNE   SNDENC                Go if no Data in ack               07777000
  556.          L     1,ARDATA                                        @SC86190 07777500
  557.          CLI   0(1),AX                                         @SC86190 07778000
  558.          BE    SNDCAN                Go if Abort sending file           07778500
  559.          CLI   0(1),AZ                                         @SC86190 07779000
  560.          BNE   SNDENC                Go if not Abort sending grp        07779500
  561. SNDCAN   MVC   CXZ,0(1)      Pick up data                      @SC86190 07780000
  562.          MVI   ERRNUM,ERRTRC Send cancelled                    @SC86156 07780500
  563.          CLC   DATL,F2       Any reason given (if A-pkt)       @SC86316 07781000
  564.          BL    SNDEOF        None                              @SC86316 07781500
  565.          UNCHR 2,1(1),REASON Yes, save it                      @SC86316 07782000
  566. SNDEOF   BAL   9,SNDCLS      Close file                        @SC86295 07782500
  567.          KCALL ACCTNG        Save code in table                @SC88092 07783000
  568.          MVI   STYPE,AZ              PACKET TYPE = EOF                  07783500
  569.          XC    DATL,DATL                                                07784000
  570.          L     9,ASDATA                                        @SC86295 07784500
  571.          MVI   0(9),AD       In case of discard                @SC86295 07785000
  572.          CLI   CXZ,0         Aborting this file?               @SC86125 07785500
  573.          BE    *+8           No, ok                            @SC86125 07786000
  574.          MVI   DATL+3,1      Yes, send 'D'                     @SC86125 07786500
  575.          BAL   9,INPUTSPK    Send EOF and Interpret response   @SC86295 07787000
  576.          BAL   14,INCRSEQ                                               07787500
  577.          TM    FL4,SFM                                         @SC86158 07788000
  578.          BO    SNDBRK        Memory has only one 'file'        @SC86158 07788500
  579.          B     SNDNXT                else GET-NEXT-FILE                 07789000
  580. *                                                                       07789500
  581. SNDNPS   MVI   WRRD,0        Set for send only                 @SC86165 07790000
  582.          MVI   AEAFLG,X'80'  ditto                             @SC90173 07790500
  583. SNDNPSL  KCALL NPREAD,E=(SNDABR,P)                             @SC86165 07791000
  584.          CLC   SNDPKL,F0     OK, any data?                     @SC86165 07791500
  585.          BE    SNDNPZ        No, must be done                  @SC86165 07792000
  586.          KCALL SIO,E=SNDABR  Send what we got                  @SC86165 07792500
  587.          TM    FL1,EOF       Any more?                         @SC86165 07793000
  588.          BZ    SNDNPSL       Yes, get it                       @SC86165 07793500
  589. SNDNPZ   BAL   9,SNDCLS      Reached end                       @SC86295 07794000
  590.          MVI   ERRNUM,ERRNOE Set code = no errors              @SC90179 07794500
  591.          KCALL ACCTNG        Save code in table                @SC90179 07795000
  592.          TM    FL4,SFM       Internal file?                    @SC90179 07795500
  593.          BZ    SNDNXT        If not, on to next file (if any)  @SC90179 07796000
  594.          B     SNDBR2        All done                          @SC86165 07796500
  595. *                                                                       07797000
  596. SNDENX   LTR   15,15                 Positive or negative error?        07797500
  597.          BP    SNDABR                Pos: error from ENCODE, not EOF    07798000
  598.          MVI   ERRNUM,ERRNOE No error yet                      @SC88092 07798500
  599.          CLC   DATL,F0                                                  07799000
  600.          BE    SNDEOF                No more data to send               07799500
  601.          B     SNDDAT                Send last chunk                    07800000
  602. *                                                                       07800500
  603. SNDNON   TM    SNFLG,NEWGRP                                    @SC88306 07801000
  604.          BZ    SNDMNXT       Filespec wasn't totally missing   @SC89218 07801500
  605. SNDFNF   MVI   ERRNUM,ERRFNF Not found                         @SC87012 07802000
  606.          KCALL ACCTST,IFILE  Copy name to table                @SC88306 07802500
  607. SNDACT   KCALL ACCTNG        Set error number                  @SC89218 07803000
  608. SNDMNXT  DS    0H                                              @SC89218 07803500
  609.          CLC   MSNDPTR,MSNDBUF Any more filespecs pending?     @SC88306 07804000
  610.          BNH   SNDBRK        No, all done                      @SC88306 07804500
  611.          L     1,MSNDPTR                                       @SC88306 07805000
  612.          SH    1,=Y(LFSTF)   Back up to next filespec          @SC89218 07805500
  613.          ST    1,MSNDPTR     And save new ptr                  @SC88306 07806000
  614.          MVC   IFILE(LFSTF),0(1) Copy out names                @SC89218 07806500
  615.          B     SNDSET        Start all over again              @SC88306 07807000
  616. *                                                                       07807500
  617. SNDBRK   MVC   ERRNUM(2),ERRLAST Last error code+reason code   @SC89218 07808000
  618.          CLI   ERRNUM,ERRNOE Last transfer ok?                 @SC89218 07808500
  619.          BE    SNDBRKP       Yes                               @SC89218 07809000
  620.          TM    SNFLG,FIRST                                     @SC88306 07809500
  621.          BZ    SNDAB2        Send E-packet: transfer started   @SC89218 07810000
  622.          TM    FL2,SRV                                                  07810500
  623.          BO    SNDAB2        Go if server                      @SC89218 07811000
  624.          B     SNDRET                                          @SC86295 07811500
  625. *                                                                       07812000
  626. SNDSHRT  BAL   9,SNDCLS      Close input file                  @SC89218 07812500
  627.          NI    SNFLG,255-NEWGRP Not first of the group anymore @SC89218 07813000
  628.          MVI   ERRNUM,ERRFTS File too short for request        @SC89218 07813500
  629.          B     SNDACT        On to next file, if any           @SC89218 07814000
  630. *                                                                       07814500
  631. SNDBRKP  TM    SNFLG,FIRST   See if actually started           @SC89218 07815000
  632.          BO    SNDRET        No, just quit                     @SC89218 07815500
  633.          TM    FL4,NPS       Non-protocol?                     @SC90292 07816000
  634.          BO    SNDBR2        Yes, skip break packet            @SC90292 07816500
  635.          MVI   STYPE,AB      Packet type = BREAK               @SC89218 07817000
  636.          XC    DATL,DATL                                                07817500
  637.          BAL   9,INPUTSPK    Send BRK and Interpret response   @SC86295 07818000
  638. SNDBR2   DS    0H                                              @SC86165 07818500
  639.          MVC   ERRNUM(2),ERRLAST Reset error+reason            @SC89218 07819000
  640.          B     SNDRET        Done                              @SC89218 07819500
  641. *                                                                       07820000
  642. SNDCMDER MVI   ERRNUM,ERRDSP Say can't dispose of file         @SC90239 07820500
  643. *                                                                       07821000
  644. SNDABR   BAL   9,SNDCLS      Close disk file                   @SC86295 07821500
  645.          KCALL ACCTNG        Save code in table                @SC88092 07822000
  646. SNDAB2   DS    0H                                              @SC89218 07822500
  647.          TM    FL4,NPS       Non-protocol?                     @SC86165 07823000
  648.          BO    SNDRET        Yes, skip error packet            @SC86165 07823500
  649.          KCALL ERPACK        Send error packet                          07824000
  650. SNDRET   NI    FL4,255-NPS-SFM-TXT                             @SC86165 07824500
  651.          LA    0,0           Indicate return from SEND         @AB89191 07825000
  652.          B     RETSNRC       Close statistics and return       @SC86295 07825500
  653. *                                                                       07826000
  654. SNDCLS   TM    FL4,SFM       Text xmit?                        @SC86158 07826500
  655.          BOR   9             Yes, no disk file                 @SC86295 07827000
  656.          CLOSF FILPTR        Close it                          @SC86158 07827500
  657.          BR    9                                               @SC86295 07828000
  658. *                                                                       07828500
  659. TIMPLT   DC    C' ',X'2120',C':',2X'20',C':',2X'20'  Time edit @SC88235 07829000
  660.          LOCALS ,                                              @SC86295 07829500
  661. SNPKCT   DS    H             Cyclic counter for tuning         @SC86345 07830000
  662. CXZ      DS    X             Flag for aborted transmission     @SC86295 07830500
  663. SNFLG    DS    X             More local flags                  @SC86295 07831000
  664. FIRST    EQU   X'80'         File is the first one             @SC86295 07831500
  665. NEWGRP   EQU   X'40'         File is the first of a new group  @SC88306 07832000
  666. SNDPKLR  DS    A             Saved return adr for attribute    @SC90037 07832500
  667. SNDPKLN  DS    F             Length of attributes composed     @SC90037 07833000
  668. SNDDSP   DS    X             Saved code for disposition        @SC90239 07833500
  669. SEND     EXIT                                                           07834000
  670.          TITLE 'RECEIV Routine - receives a file'                       07834500
  671. * Receive file(s) and set ERRNUM appropriately                          07835000
  672. * Entry: filespec in FILNAM if ROVR is set                              07835500
  673. RECEIV   ENTER                                                          07836000
  674.          XC    NSENTAC(LSTATS),NSENTAC Clear statistics        @SC90179 07836500
  675.          XC    NSENT,NSENT   Clear count of files              @SC88092 07837000
  676.          MVC   FL1SV,FL1     Save file attribute defaults:     @SC90037 07837500
  677.          MVC   TYPFSV,TYPFIL File type...                      @SC90037 07838000
  678.          MVC   RCFSV,FILRCF  Format                            @SC90037 07838500
  679.          MVC   LRCSV,FILLRC  Record length...                  @SC90037 07839000
  680.          KCALL SUPFNC,10                                       @SC86295 07839500
  681.          ST    15,SECTOT     Save start time                   @SC86295 07840000
  682.          CLI   RTYPE,AF      Starting with file header packet? @SC88074 07840500
  683.          BE    RECFHD        Yes, skip INIT stuff              @SC88074 07841000
  684.          CLI   RTYPE,AX                                        @SC88074 07841500
  685.          BE    RECFHD        Yes, skip INIT stuff              @SC88074 07842000
  686.          KCALL SPARSET       Set up for exchange               @SC86152 07842500
  687.          LA    8,RECINST             Next state table for RECEIVE I     07843000
  688.          MVC   LIMTRY,MAXTNT Limit for INIT retries            @SC86345 07843500
  689.          CLI   RTYPE,0                                         @SC88074 07844000
  690.          BNE   RECSRV        Skip read if already got packet   @SC88074 07844500
  691.          MVI   SEQ,0         Reset packet number               @SC88074 07845000
  692.          KCALL RPACK         Get init info                              07845500
  693. RECSRV   SR    3,3                   Clear retry counter for INPUTLUP   07846000
  694.          BAL   9,INPUTINR    Interpret response to RPAC        @SC86295 07846500
  695.          KCALL SPAR          Interpret his S packet                     07847000
  696.          KCALL RPAR          Reply to the S packet                      07847500
  697.          BAL   2,SENDACKL            Send an ACK, length set            07848000
  698.          MVC   BCTU,BCTR     Switch to negotiated chksum/flag  @SC92085 07848500
  699.          CLI   BCTR,AA       Blank suppression?                @SC92085 07849000
  700.          BL    *+8           No, flag was off already          @SC92085 07849500
  701.           MVI  BCTOFF+3,1    Yes, turn it on                   @SC92085 07850000
  702.          NI    BCTU,15       Use just length here              @SC92085 07850500
  703.          MVC   LIMTRY,MAXTRY Set retry limit                   @SC86164 07851000
  704.          BAL   14,INCRSEQ                                               07851500
  705. RECFIL   KCALL RPACK         Get header packet                 @SC88074 07852000
  706. RECFHD   LA    8,RECFNST     Next state table for RECEIVE F    @SC88074 07852500
  707.          SR    3,3           Clear retry counter for INPUTLUP  @SC88074 07853000
  708.          BAL   9,INPUTINR    Interpret header packet           @SC88074 07853500
  709.          NI    RFLG,255-RTRC-RRJC Clear each time              @SC86316 07854000
  710.          MVI   REASON,0                                                 07854500
  711.          NI    FL1,255-EOF           Turn of EOF = no ctl-z seen        07855000
  712.          MVC   FILFSIZ,F0    Clear expected size in Kbytes     @SC90037 07855500
  713.          XC    FDATE,FDATE   Clear file date/time              @SC91094 07856000
  714.          TM    FL1,ROVR                                                 07856500
  715.          BO    RECOVR                Overwrite the name sent?           07857000
  716.          BAL   9,DECODEN     Decode the input                  @SC86295 07857500
  717.          L     1,WBUF                Start of data                      07858000
  718.          L     0,WBUFL               Data length decoded                07858500
  719.          TR    0(256,1),ATOED Convert to std EBCDIC            @SC89301 07859000
  720.          STM   0,1,SCANPTR   Set up scan                       @SC86295 07859500
  721.          MVC   CMD+&MSGFILL.(255-&MSGFILL),0(1)  Extra copy    @SC92300 07860000
  722.          LA    0,FFHDR                                         @SC86295 07860500
  723.          KCALL FSPEC,FILNAM,E=RECNER  Invalid, somehow?        @SC91017 07861000
  724.          CLI   TRMLIN,C' '   Alt. line?                        @SC87300 07861500
  725.          BE    RECOVR        No, be quiet                      @SC87300 07862000
  726.          MVC   CMD(&MSGFILL),=C'&MSGFILE' Yes, display message @SC92300 07862500
  727.          LA    0,CMD+&MSGFILL                                  @SC87300 07863000
  728.          A     0,WBUFL                                         @SC87300 07863500
  729.          BAL   2,STAPMSG     Show name                         @SC87300 07864000
  730. RECOVR   LA    3,FILNAM              Point to fn                        07864500
  731.          TM    FL3,APPN      Appending to old files?           @SC86203 07865000
  732.          BO    RECOPN        Yes, just do it                   @SC86295 07865500
  733.          TM    FL1,REN                                                  07866000
  734.          BZ    RECOPN        No, just do it                    @SC86295 07866500
  735.          LA    0,FFNEW                                         @SC86295 07867000
  736.          KCALL FSPEC,FILNAM,E=RECNER Check collisions          @SC88053 07867500
  737.          TM    FL4,NMCHNG                                      @SC90033 07868000
  738.          BZ    RECCMSG                                         @SC90033 07868500
  739.          CLI   CLSNFL,C'B'                                     @SC90033 07869000
  740.          BNE   RECCTSTD                                        @SC90033 07869500
  741.          LA    2,FILNAM      Must back up original file        @SC90033 07870000
  742.          LA    0,15          Rename it to unique new name      @SC90033 07870500
  743.          KCALL DISKIO,XFILE,E=RECNER Give up if rename fails   @SC90264 07871000
  744.          CLI   TRMLIN,C' '   Alt. line?                        @SC90033 07871500
  745.          BE    RECCBZ        No, be quiet                      @SC90033 07872000
  746.          INITSTR '&BACKDUP',CMD,REG=7                          @SC92300 07872500
  747.          LA    1,FILNAM                                        @SC90033 07873000
  748.          BAL   2,STAFSP      Format backup name and show it    @SC90033 07873500
  749. RECCBZ   MVC   FILNAM,XFILE  Now, just use intended name       @SC90033 07874000
  750.          B     RECCMSG                                         @SC90033 07874500
  751. RECCTSTD CLI   CLSNFL,C'D'                                     @SC90033 07875000
  752.          BNE   RECCMSG       Other case is just "rename"       @SC90033 07875500
  753. RECNER   DS    0H            Invalid name, cancel the transfer @SC91017 07876000
  754.          OI    RFLG,RRJC     Reject file                       @SC90033 07876500
  755.          MVI   REASON,STACNCLS Reason was file collision       @SC90033 07877000
  756.          CLI   TRMLIN,C' '   Alt. line?                        @SC90033 07877500
  757.          BE    RECOPN        No, be quiet                      @SC90033 07878000
  758.          WTEXT '&DSCARDD'                                      @SC90033 07878500
  759.          B     RECOPN                                          @SC90033 07879000
  760. RECCMSG  DS    0H                                              @SC90033 07879500
  761.          CLI   TRMLIN,C' '   Alt. line?                        @SC87300 07880000
  762.          BE    RECOPN        No, be quiet                      @SC87300 07880500
  763.          INITSTR '&RECVDAS',CMD,REG=7  Yes, display message    @SC92300 07881000
  764.          LA    1,FILNAM                                        @SC87300 07881500
  765.          BAL   2,STAFSP      Format name and show it           @SC87300 07882000
  766. RECOPN   XC    FILFLGS,FL3   Set flag for DISP                 @SC86295 07882500
  767.          NI    FILFLGS,255-APPN-SVATT                          @SC90033 07883000
  768.          XC    FILFLGS,FL3                                     @SC86295 07883500
  769.          XC    RECRCNT,RECRCNT Count of packets after rejection@SC91165 07884000
  770.          KCALL ACCTST,FILNAM Copy name to table                @SC88306 07884500
  771.          L     7,RBUF        Ptr to input buffer               @SC88264 07885000
  772.          LA    0,FFDSP                                         @SC88264 07885500
  773.          KCALL FSPEC,FILNAM  Copy chosen name into buffer      @SC88264 07886000
  774.          L     2,RBUF                                          @SC88264 07886500
  775.          LR    3,15          End of string                     @SC88264 07887000
  776.          SR    3,2           Get length of string              @SC88264 07887500
  777.          ST    3,RBUFL                                         @SC88264 07888000
  778.          LA    15,ETOAD      Standard table                    @SC89301 07888500
  779.          BAL   14,TRANSLAT   Convert to ASCII                  @SC88264 07889000
  780.          BAL   9,ENCODEN     Copy into packet buffer           @SC88264 07889500
  781.          BAL   2,SENDACKL                                      @SC88264 07890000
  782.          XC    WBUFL,WBUFL           Data length in WBUF                07890500
  783.          MVI   LCKOLD,0      Start at normal state             @SC91275 07891000
  784.          MVI   DECESCP,0                                       @SC91275 07891500
  785.          MVI   PREV,0                Char previously decoded            07892000
  786.          LA    8,RECANST     State table: REC D or A           @SC86149 07892500
  787. RECDAT   BAL   14,INCRSEQ                                      @SC86316 07893000
  788.          BAL   9,INPUT       Read a packet and interpret       @SC86295 07893500
  789.          LA    9,RECDNST     From now on accept D only         @SC90037 07894000
  790.          CR    8,9           Already seen a D packet?          @SC90037 07894500
  791.          BE    RECDATN       Yes, handle routinely             @SC90037 07895000
  792.          LR    8,9           No, 1st open file                 @SC90037 07895500
  793.          TM    RFLG,RRJC     File rejected?                    @SC90037 07896000
  794.          BO    RECRJX        Yes, ignore all data              @SC90037 07896500
  795.          OPENF O,FILNAM,FILFDB,FILPTR,E=RECOER                 @SC91017 07897000
  796.          USING FDBD,1                                          @SC86295 07897500
  797.          L     2,FABLRTR     Get effective record length       @SC88120 07898000
  798.          ST    2,FSIZE       Copy LRECL                        @SC86295 07898500
  799.          MVC   FRECF,FDBRCF  Save info                         @SC86295 07899000
  800.          DROP  1                                               @SC86295 07899500
  801.          TM    FL1,BINF                                        @SC88120 07900000
  802.          BO    RECMAXO       Binary, just fold at LRECL        @SC88120 07900500
  803.          CLI   TRNCFL,C'H'   Test: F, H, or T                  @SC88120 07901000
  804.          BL    RECMAXO       F => fold at LRECL                @SC88120 07901500
  805.          LA    2,1(2)        Assume H => abort at LRECL+1      @SC88120 07902000
  806.          BE    RECMAXO                                         @SC88120 07902500
  807.          ICM   2,8,LOBIT+3   T => fold at "infinity", but trunc@SC88120 07903000
  808. RECMAXO  ST    2,MAXOUT                                        @SC88120 07903500
  809.          BAL   14,RDWSET     Check for special format          @SC86295 07904000
  810.          ICM   0,15,FILFSIZ  Expected size, if known           @SC90037 07904500
  811.          BZ    RECDATN       Not known, proceed                @SC90037 07905000
  812.          OPENF S,FILNAM,FILFDB,FILPTR,E=RECRJL Check disk space@SC90037 07905500
  813. RECDATN  DS    0H                                              @SC90037 07906000
  814.          TM    RFLG,RRJC     File rejected?                    @SC89218 07906500
  815.          BO    RECRJX        Yes, ignore all data              @SC90033 07907000
  816.          KCALL DECODE,E=RECABR Decode and write to file        @SC86316 07907500
  817. RECDAK   BAL   2,SENDACK     Send an ack                       @SC86149 07908000
  818.          B     RECDAT                                                   07908500
  819. *                                                                       07909000
  820. RECSCN   LR    7,6           Start one before number           @SC90037 07909500
  821. RECSCL   CLI   0(7),ACOM     Look for comma                    @SC90037 07910000
  822.          BER   14            Found one                         @SC90037 07910500
  823.          CR    7,5                                             @SC90037 07911000
  824.          BNLR  14            Already at end of string          @SC90037 07911500
  825.          LA    7,1(,7)                                         @SC90037 07912000
  826.          B     RECSCL        Keep looking                      @SC90037 07912500
  827. *                                                                       07913000
  828. RECALKP  LTR   7,7                                             @SC90037 07913500
  829.          BNP   RECRJC        No value at all.  Give up         @SC90037 07914000
  830.          IC    4,0(,6)       Get value code                    @SC90037 07914500
  831.          LA    6,1(,6)       Advance scan ptr over code char   @SC90037 07915000
  832.          BCTR  7,0           Length of stuff left              @SC90037 07915500
  833.          B     CLKP          Dispatch on value, table at (2)   @SC90037 07916000
  834. *                                                                       07916500
  835. RECAMJ   NI    FL1,255-BINF  Set it Text                       @SC90037 07917000
  836.          MVI   TYPFIL,C'T'                                     @SC90037 07917500
  837.          LTR   7,7           Any more stuff?                   @SC90037 07918000
  838.          BZR   14            No, assume AMJ                    @SC90037 07918500
  839.          C     7,F2          Yes, had better be AMJ!           @SC90037 07919000
  840.          BNE   RECRJC        Isn't AMJ, give up                @SC90037 07919500
  841.          CLC   0(2,6),=AL1(AM,AJ)                              @SC90037 07920000
  842.          BNE   RECRJC        Isn't AMJ, give up                @SC90037 07920500
  843.          BR    14            Ok                                @SC90037 07921000
  844. *                                                                       07921500
  845. RECTRTD  TRT   0(,6),TRTDIG  Scan for invalid data bytes       @SC91094 07922000
  846. RECTRTB  TRT   0(,6),TRTBL   Scan for a blank                  @SC91094 07922500
  847. RECMVTM  MVC   FDATE+4(0),TMPDW+4 Copy to output field         @SC91094 07923000
  848. TRTDIG   DC    (C' ')X'1',X'0'         Detect space            @SC91094 07923500
  849.          DC    (C':'-C' '-1)X'1',X'0'   and colon              @SC91094 07924000
  850.          DC    (C'0'-C':'-1)X'1',10X'0',(255-C'9')X'1'  digits @SC91094 07924500
  851. *                                                                       07925000
  852. RECADT   BCTR  7,0                                             @SC91094 07925500
  853.          EX    7,RECTRAT     Convert to EBCDIC                 @SC91094 07926000
  854.          EX    7,RECTRTD     Check if valid data               @SC91094 07926500
  855.          BNZ   RECRJC        Invalid, reject                   @SC91094 07927000
  856.          LA    1,1(,7)       Total length                      @SC91094 07927500
  857.          EX    7,RECTRTB                                       @SC91094 07928000
  858.          BZ    *+6                                             @SC91094 07928500
  859.           SR   1,6           Length of data alone              @SC91094 07929000
  860.          PACK  FDATE(5),0(9,6)                                 @SC91094 07929500
  861.          C     1,F8          Full yyyymmdd?                    @SC91094 07930000
  862.          BH    RECRJC        Too big, kill it                  @SC91094 07930500
  863.          BE    RECADT1       Ok                                @SC91094 07931000
  864.          CH    1,=H'6'       Just yymmdd?                      @SC91094 07931500
  865.          BNE   RECRJC        No, illegal                       @SC91094 07932000
  866.          PACK  FDATE+1(4),0(7,6) Leave room for century        @SC91094 07932500
  867.          MVI   FDATE,X'19'   Assume 20th                       @SC91094 07933000
  868.          CLI   FDATE+1,X'50' Unless yy<50                      @SC91094 07933500
  869.          BNL   RECADT1                                         @SC91094 07934000
  870.          MVI   FDATE,X'20'   Must be 21st                      @SC91094 07934500
  871. RECADT1  MVI   FDATE+4,0     Repair damage                     @SC91094 07935000
  872.          LA    1,1(,1)       Account for separator             @SC91094 07935500
  873.          SR    7,1           See if time also present          @SC91094 07936000
  874.          BNP   RECCKL        No, all done                      @SC91094 07936500
  875.          AR    6,1           Ok, advance ptr                   @SC91094 07937000
  876.          MVC   TMPDW(6),=AL1(0,1,3,4,6,7)                      @SC91094 07937500
  877.          TR    TMPDW(6),0(6) Compress out colons               @SC91094 07938000
  878.          PACK  TMPDW+4(4),TMPDW(7)                             @SC91094 07938500
  879.          CH    7,=H'4'       Just hh:mm?                       @SC91094 07939000
  880.          BE    *+12          Ok                                @SC91094 07939500
  881.           CH   7,=H'7'       hh:mm:ss?                         @SC91094 07940000
  882.           BNE  RECRJC        No, error                         @SC91094 07940500
  883.          SRL   7,1                                             @SC91094 07941000
  884.          BCTR  7,0                                             @SC91094 07941500
  885.          EX    7,RECMVTM     Move to FDATE: 2 or 3 bytes       @SC91094 07942000
  886.          B     RECCKL                                          @SC91094 07942500
  887. *                                                                       07943000
  888. RECCKA   L     5,ARDATA      Attributes                        @SC88273 07943500
  889.          L     3,DATL        Get length                        @SC86316 07944000
  890.          AR    3,5           Ptr to end                        @SC88273 07944500
  891.          MVI   ERRNUM,ERRIPS In case of error                  @SC86316 07945000
  892. RECCKL   CR    5,3           Another attribute?                @SC86316 07945500
  893.          BNL   RECDAK        No, done                          @SC86316 07946000
  894.          TM    RFLG,RRJC     File rejected?                    @SC90033 07946500
  895.          BO    RECDAK        Yes, ignore further attributes    @SC90033 07947000
  896.          UNCHR 4,0(5),REASON Get code                          @SC90037 07947500
  897.          BNP   RECABR        Invalid: code must be >0          @SC90037 07948000
  898.          UNCHR 7,1(5)        Get length of value               @SC88273 07948500
  899.          BM    RECABR        Invalid: length was <0            @SC86316 07949000
  900.          LA    6,2(5)        Space over code+length            @SC88273 07949500
  901.          LA    5,0(7,6)      Next field                        @SC86316 07950000
  902.          CR    5,3           Does it match?                    @SC86316 07950500
  903.          BH    RECABR        Overflows data                    @SC86316 07951000
  904.          LR    14,4                                            @SC90037 07951500
  905.          BCTR  14,0          Bit index for this attribute      @SC90037 07952000
  906.          SRDL  14,3          Get byte index                    @SC90037 07952500
  907.          SRL   15,29         And bit remainder                 @SC90037 07953000
  908.          LA    1,X'80'                                         @SC90037 07953500
  909.          SRL   1,0(15)       Convert to bit mask               @SC90037 07954000
  910.          IC    15,ATFLG(14)  Load attribute flags              @SC90037 07954500
  911.          NR    15,1          Honor this attribute?             @SC90037 07955000
  912.          BZ    RECCKL        No, just ignore it                @SC90037 07955500
  913.          BAL   2,CLKP                                          @SC86316 07956000
  914. RECLNCOD DC    AL1(01),AL3(RECALN) ! - File length             @SC90037 07956500
  915.          DC    AL1(02),AL3(RECATP) " - Type                    @SC90037 07957000
  916.          DC    AL1(03),AL3(RECADT) # - Date                    @SC91094 07957500
  917.          DC    AL1(09),AL3(RECAAC) ) - Access                  @SC90037 07958000
  918.          DC    AL1(10),AL3(RECAEN) * - Encoding                @SC90037 07958500
  919.          DC    AL1(11),AL3(RECADI) + - Disposition             @SC90037 07959000
  920.          DC    AL1(15),AL3(RECAFM) / - Format                  @SC90037 07959500
  921.          DC    AL1(32),AL3(RECAZZ) @ - End                     @SC91109 07960000
  922.          DC    X'0',AL3(RECCKL) Other                          @SC86316 07960500
  923. *          Access attribute                                    @SC90037 07961000
  924. RECAAC   BAL   2,RECALKP                                       @SC90037 07961500
  925.          DC    AL1(AA),AL3(RECAAA) Append                      @SC90037 07962000
  926.          DC    AL1(AN),AL3(RECCKL) Normal (obey user)          @SC90037 07962500
  927.          DC    AL1(AS),AL3(RECAAS) Supersede                   @SC90037 07963000
  928.          DC    AL1(00),AL3(RECRJC) unknown, reject             @SC90037 07963500
  929. RECAAA   OI    FILFLGS,APPN  Append                            @SC90037 07964000
  930.          B     RECCKL                                          @SC90037 07964500
  931. RECAAS   NI    FILFLGS,255-APPN Don't append                   @SC90037 07965000
  932.          B     RECCKL                                          @SC90037 07965500
  933. *          Format attribute                                    @SC90037 07966000
  934. RECAFM   BAL   14,RECSCN     Check for comma                   @SC90037 07966500
  935.          SR    7,6           Length of extra stuff             @SC90037 07967000
  936.          BAL   2,RECALKP                                       @SC90037 07967500
  937.          DC    AL1(AA),AL3(RECAFA) ASCII                       @SC90037 07968000
  938.          DC    AL1(AD),AL3(RECAFD) D (binary)                  @SC90037 07968500
  939.          DC    AL1(AF),AL3(RECAFF) Fixed (binary)              @SC90037 07969000
  940.          DC    AL1(AM),AL3(RECLRC) LRECL                       @SC90037 07969500
  941.          DC    AL1(AV),AL3(RECAFD) V (binary)                  @SC90037 07970000
  942.          DC    AL1(00),AL3(RECRJC) ?                           @SC90037 07970500
  943. RECAFA   BAL   14,RECAMJ     Set it Text                       @SC90037 07971000
  944.          B     RECALP                                          @SC90037 07971500
  945. RECAFF   LA    4,AB          Plain old Binary                  @SC90037 07972000
  946. RECAFD   OI    FL1,BINF      Binary selected                   @SC90037 07972500
  947.          IC    4,ATOED(4)    Ok, set file type as well         @SC90037 07973000
  948.          STC   4,TYPFIL                                        @SC90037 07973500
  949. RECALP   BAL   14,RECSCN     Look for comma                    @SC90037 07974000
  950.          LA    6,1(,7)       Skip over comma for next piece    @SC90037 07974500
  951.          CR    6,5                                             @SC90037 07975000
  952.          BNL   RECCKL        Ran out of attribute stuff        @SC90037 07975500
  953.          B     RECAFM        Do next piece                     @SC90037 07976000
  954. RECLRC   BAL   14,RECSCN     Look for comma                    @SC90037 07976500
  955.          SR    7,6           Length of number string           @SC90037 07977000
  956.          LR    14,7          Convert number to EBCDIC          @SC90037 07977500
  957.          BNP   RECRJC        Impossible, reject it             @SC90037 07978000
  958.          BCTR  14,0                                            @SC90037 07978500
  959.          EX    14,RECTRAT                                      @SC90037 07979000
  960.          BAL   14,GETNUM     Get number                        @SC90037 07979500
  961.           B    RECRJC        Not proper numeric string         @SC90037 07980000
  962.          LTR   0,0           Validate LRECL                    @SC90037 07980500
  963.          BNP   RECRJC        No good                           @SC90037 07981000
  964.          STCM  0,3,FILLRC    Ok, use it                        @SC90037 07981500
  965.          B     RECALP        Look for another subattribute     @SC90037 07982000
  966. *          Length attribute                                    @SC90037 07982500
  967. RECALN   LTR   14,7          Copy length                       @SC88273 07983000
  968.          BNP   RECRJC        No good                           @SC88273 07983500
  969.          BCTR  14,0                                            @SC88273 07984000
  970.          EX    14,RECTRAT                                      @SC88273 07984500
  971.          BAL   14,GETNUM     Get file length                   @SC88273 07985000
  972.           B    RECRJC                                          @SC88273 07985500
  973.          ST    0,FILFSIZ     Save expected size                @SC90037 07986000
  974.          OPENF S,FILNAM,FILFDB,FILPTR,E=RECRJC Check disk space@SC90037 07986500
  975.          B     RECCKL        Ok, keep looking                  @SC86316 07987000
  976. RECTRAT  TR    0(,6),ATOED   Convert to EBCDIC for decoding    @SC88273 07987500
  977. *          Type attribute                                      @SC90037 07988000
  978. RECATP   BAL   2,RECALKP                                       @SC90037 07988500
  979.          DC    AL1(AA),AL3(RECATA) ASCII                       @SC90037 07989000
  980.          DC    AL1(AB),AL3(RECATB) Binary                      @SC90037 07989500
  981.          DC    AL1(00),AL3(RECRJC) Don't allow any other       @SC90037 07990000
  982. RECATA   BAL   14,RECAMJ     Set it Text                       @SC90037 07990500
  983.          B     RECCKL        Ok                                @SC90037 07991000
  984. RECATB   TM    FL1,BINF      Already binary?                   @SC90037 07991500
  985.          BO    RECCKL        Yes, that's fine                  @SC90037 07992000
  986.          OI    FL1,BINF      No, set it binary                 @SC90037 07992500
  987.          MVI   TYPFIL,C'B'   And choose simple binary          @SC90037 07993000
  988.          B     RECCKL                                          @SC90037 07993500
  989. *          Disposition attribute                               @SC90037 07994000
  990. RECADI   BAL   2,RECALKP                                       @SC90037 07994500
  991.          DC    AL1(AA),AL3(RECCKL) Archive (not implemented)   @SC90037 07995000
  992.          DC    AL1(AM),AL3(RECADM) Mail                        @SC90037 07995500
  993.          DC    AL1(AP),AL3(RECADP) Print                       @SC90037 07996000
  994.          DC    AL1(AS),AL3(RECADS) Submit as batch job         @SC90037 07996500
  995.          DC    AL1(00),AL3(RECRJC) unknown, reject             @SC90037 07997000
  996. *                                                                       07997500
  997. RECADM   LTR   7,7           Any recipients given?             @SC90037 07998000
  998.          BNP   RECRJC        No, that's bad                    @SC90037 07998500
  999.          BAL   2,RECAD1                                        @SC90037 07999000
  1000.          DC    AL4(KMAIL1),AL2(L'KMAIL1,L'KMAIL2,L'KMAIL3)     @SC90037 07999500
  1001. RECADP   BAL   2,RECAD1                                        @SC90037 08000000
  1002.          DC    AL4(KPRNT1),AL2(L'KPRNT1,L'KPRNT2,L'KPRNT3)     @SC90037 08000500
  1003. RECADS   BAL   2,RECAD1                                        @SC90037 08001000
  1004.          DC    AL4(KSUBM1),AL2(L'KSUBM1,L'KSUBM2,L'KSUBM3)     @SC90037 08001500
  1005. RECAD1   ICM   0,15,0(2)     Get prototype ptr                 @SC90037 08002000
  1006.          LH    1,4(,2)       Get length of 1st piece           @SC90037 08002500
  1007.          LA    14,CMD                                          @SC90037 08003000
  1008.          ST    14,ADR        Save ptr to command buffer        @SC90037 08003500
  1009.          LA    4,1(,1)       Leave room for null name          @SC92120 08004000
  1010.          ST    4,LEN         Save length of 1st piece + '.'    @SC92120 08004500
  1011.          LR    15,1                                            @SC90037 08005000
  1012.          MVCL  14,0          Copy first piece to buffer        @SC90037 08005500
  1013.          ST    0,RECDSPTR    Save ptr to 2nd piece             @SC90037 08006000
  1014.          LR    4,7           Save length of options            @SC90037 08006500
  1015.          LA    0,FFDSP                                         @SC90037 08007000
  1016.          LR    7,14          Feed output ptr to FSPEC          @SC90037 08007500
  1017.          KCALL FSPEC,FILNAM  Copy filespec to buffer           @SC90037 08008000
  1018.          LR    14,15         New output ptr                    @SC90037 08008500
  1019.          LR    7,4           Retrieve option length            @SC90037 08009000
  1020.          L     0,RECDSPTR    Get ptr to 2nd piece              @SC90037 08009500
  1021.          LH    1,6(,2)       Get length of 2nd piece           @SC90037 08010000
  1022.          LR    15,1                                            @SC90037 08010500
  1023.          MVCL  14,0          Copy 2nd piece to buffer          @SC90037 08011000
  1024.          LR    4,14          Save ptr to insert                @SC90037 08011500
  1025.          LR    15,7                                            @SC90037 08012000
  1026.          MVCL  14,6          Copy attribute stuff to buffer    @SC90037 08012500
  1027.          TR    0(94,4),ATOED Convert to EBCDIC                 @SC90037 08013000
  1028.          LH    1,8(,2)       Get length of 3rd piece           @SC90037 08013500
  1029.          LR    15,1                                            @SC90037 08014000
  1030.          MVCL  14,0          Copy 3nd piece to buffer          @SC90037 08014500
  1031.          ST    14,RECDSPTR   Save ptr to end of command        @SC90037 08015000
  1032.          LA    7,CMD-1                                         @SC92120 08015500
  1033.          A     7,LEN                                           @SC92120 08016000
  1034.          IC    4,0(,7)                                         @SC92120 08016500
  1035.          MVI   0(7),C'.'     Use null name for 1st call        @SC92120 08017000
  1036.          OI    FL4,UCMD                                        @SC90037 08017500
  1037.          KCALL SUPFNC,3,E=RECRJC Test if facility exists       @SC90037 08018000
  1038.          STC   4,0(,7)       Restore name                      @SC92120 08018500
  1039.          B     RECCKL                                          @SC90037 08019000
  1040. *                                                                       08019500
  1041. *          Encoding attribute                                  @SC90037 08020000
  1042. RECAEN   BAL   2,RECALKP                                       @SC90037 08020500
  1043.          DC    AL1(AA),AL3(RECCKL) ASCII                       @SC90037 08021000
  1044.          DC    AL1(AC),AL3(RECAEC) Special character set       @SC90040 08021500
  1045.          DC    AL1(AE),AL3(RECATB) Binary                      @SC90037 08022000
  1046.          DC    AL1(00),AL3(RECRJC) Don't allow any other       @SC90037 08022500
  1047. *                                                                       08023000
  1048. RECAEC   LTR   7,7                                             @SC90040 08023500
  1049.          BNP   RECCKL        Character set not specified       @SC90040 08024000
  1050.          KCALL TBLATT,E=RECRJC                                 @SC90040 08024500
  1051.          B     RECCKL                                          @SC90040 08025000
  1052. *                                                                       08025500
  1053. RECAZZ   CR    5,3           End of attributes, must be last   @SC91109 08026000
  1054.          BNE   RECRJC        No, reject                        @SC91109 08026500
  1055.          B     RECCKL                                          @SC91109 08027000
  1056. *                                                                       08027500
  1057. RECRJL   MVC   REASON,RECLNCOD Because of length               @SC90037 08028000
  1058. RECRJX   L     9,ASDATA      Output buffer                     @SC90037 08028500
  1059.          MVI   0(9),AX       Reject this file                  @SC90033 08029000
  1060.          MVC   DATL,F1                                         @SC90033 08029500
  1061.          LA    2,1           Count up cancel packets           @SC91165 08030000
  1062.          AH    2,RECRCNT                                       @SC91165 08030500
  1063.          STH   2,RECRCNT                                       @SC91165 08031000
  1064.          CH    2,=H'10'      Other Kermit too persistent?      @SC91165 08031500
  1065.          BNL   RECECNCL      Yes, call a halt                  @SC91165 08032000
  1066.          B     RECRJ2        Now accept only EOF pkt           @SC90033 08032500
  1067. RECRJC   L     9,ASDATA      Output buffer                     @SC86316 08033000
  1068.          MVI   0(9),AN       Mark it rejected                  @SC88273 08033500
  1069.          TOCHR 0,REASON,1(9) Copy attribute code to response   @SC90037 08034000
  1070.          MVC   DATL,F2       Data = 'N' + code                 @SC86316 08034500
  1071. RECRJ2   DS    0H                                              @SC90033 08035000
  1072.          OI    RFLG,RRJC     Mark it rejected                  @SC86316 08035500
  1073.          BAL   2,SENDACKL    Acknowledge                       @SC86316 08036000
  1074.          B     RECDAT        And wait for EOF                  @SC86316 08036500
  1075. *                                                                       08037000
  1076. RECEOF   TM    RFLG,RRJC     File rejected?                    @SC89218 08037500
  1077.          BO    RECDISC       Yes, discard                      @SC89218 08038000
  1078.          CLC   DATL,F1                                         @SC89218 08038500
  1079.          BNE   RECWR                 One piece of data                  08039000
  1080.          L     1,ARDATA                                        @SC86190 08039500
  1081.          CLI   0(1),AD                                         @SC86190 08040000
  1082.          BNE   RECWR                 Go if not discard                  08040500
  1083.          MVI   REASON,0      Micro canceling; don't know why   @SC91263 08041000
  1084. RECDISC  DS    0H                                              @SC89218 08041500
  1085.          CLOSF FILPTR        Close the file                    @SC86135 08042000
  1086.          TM    FILFLGS,APPN  Appending to old file?            @SC90033 08042500
  1087.          BO    RECKEP        Yes, keep what we got             @SC86225 08043000
  1088.          TM    FL1,KEEP                                        @SC90037 08043500
  1089.          BO    RECKEP        Don't delete it anyway            @SC86225 08044000
  1090.          ERASF FILNAM        And delete it                     @SC86295 08044500
  1091. RECKEP   MVI   ERRNUM,ERRTRC Receive cancelled                 @SC86225 08045000
  1092.          OI    RFLG,RTRC     Remember that                     @SC86295 08045500
  1093.          B     RECACK                Pick up later on                   08046000
  1094. * If data left in buffer when we get EOF, write remaining data.         08046500
  1095. RECWR    ICM   1,15,WBUFL    Check length in buffer            @SC88120 08047000
  1096.          BE    RECCLO                No data in WBUF, send Ack          08047500
  1097.          KCALL OUTBUF,E=RECABR Write out buffer                         08048000
  1098. RECCLO   CLOSF FILPTR,E=RECCER Close the file                  @SC92076 08048500
  1099.          MVI   ERRNUM,ERRNOE No error yet                      @SC88092 08049000
  1100.          ICM   1,15,RECDSPTR Any special disposition?          @SC90037 08049500
  1101.          BZ    RECACK                                          @SC90037 08050000
  1102.          LA    14,CMD                                          @SC90037 08050500
  1103.          ST    14,ADR        Save ptr to command buffer        @SC90037 08051000
  1104.          SR    1,14          Get length of command             @SC90037 08051500
  1105.          ST    1,LEN                                           @SC90037 08052000
  1106.          OI    FL4,UCMD                                        @SC90037 08052500
  1107.          KCALL SUPFNC,3,E=RECDSPX Disposition failed           @SC90037 08053000
  1108. RECACK   KCALL ACCTNG        Save code in table                @SC89218 08053500
  1109.          BAL   14,RECRSTA    Restore attributes                @SC90037 08054000
  1110.          BAL   2,SENDACK     Send an ACK                       @SC89218 08054500
  1111.          BAL   14,INCRSEQ                                               08055000
  1112.          NI    FL1,255-ROVR          Only change first file             08055500
  1113.          NI    FL4,255-NMOK-NMCHNG Check collision on next file@SC90211 08056000
  1114.          B     RECFIL                                                   08056500
  1115. *                                                                       08057000
  1116. RECBRK   MVI   ERRNUM,ERRTRC Receive cancelled?                @SC90033 08057500
  1117.          TM    RFLG,RTRC+RRJC                                  @SC90033 08058000
  1118.          BNZ   RECERP        Yes, send an error packet         @SC90033 08058500
  1119.          TM    FL2,SRV       Server will read another command  @SC90033 08059000
  1120.          BO    *+12           so don't zap write/read flag     @SC90173 08059500
  1121.           MVI  WRRD,0        No read for Ack'ing BRK pkt       @SC87343 08060000
  1122.           MVI  AEAFLG,X'80'  ditto                             @SC90173 08060500
  1123.          BAL   2,SENDACK             Send an ACK                        08061000
  1124.          MVI   ERRNUM,ERRNOE Reset error                       @SC86156 08061500
  1125.          B     RECRET                                          @SC89218 08062000
  1126. *                                                                       08062500
  1127. RECDSPX  MVI   ERRNUM,ERRDSP Code for disposition failure      @SC90037 08063000
  1128.          B     RECABR                                          @SC90037 08063500
  1129. *                                                                       08064000
  1130. RECECNCL MVI   ERRNUM,ERRTRC Code for drastic cancellation     @SC91165 08064500
  1131.          B     RECABR                                          @SC91165 08065000
  1132. *                                                                       08065500
  1133. RECCER   MVC   FABCOMM-FABD+DSKSTT(8),=CL8'CLOSE' Error type   @SC92076 08066000
  1134.          B     RECRER                                          @SC92076 08066500
  1135. RECOER   MVC   FABCOMM-FABD+DSKSTT(8),=CL8'OPEN' Error type    @SC91017 08067000
  1136. RECRER   LA    1,DSKSTT      Name error, point to dummy block  @SC91017 08067500
  1137.          ERRF  ,             Cannot write. Analyze error       @SC91017 08068000
  1138. RECABR   CLOSF FILPTR        Close open file                   @SC86135 08068500
  1139.          KCALL ACCTNG        Save code in table                @SC88092 08069000
  1140.          BAL   14,RECRSTA    Restore attributes                @SC90037 08069500
  1141. RECERP   KCALL ERPACK        Send error packet                 @SC90033 08070000
  1142. RECRET   ICM   0,15,RECTRC   Any records truncated?            @SC87268 08070500
  1143.          LA    0,4           Indicate return from RECEIVE      @AB89191 08071000
  1144.          BZ    RETSNRC       None                              @SC87268 08071500
  1145.          CLI   ERRNUM,0                                        @SC87268 08072000
  1146.          BNE   *+8           Already got some (worse) error    @SC87268 08072500
  1147.          MVI   ERRNUM,ERRRTR Indicate error                    @SC87268 08073000
  1148.          B     RETSNRC       Close statistics and return       @SC87268 08073500
  1149. * Restore file attribute defaults from saved values            @SC90037 08074000
  1150. RECRSTA  XC    FL1,FL1SV     Restore flags                     @SC90037 08074500
  1151.          NI    FL1,255-BINF-REN-KEEP Restore only these flags  @SC90037 08075000
  1152.          XC    FL1,FL1SV                                       @SC90037 08075500
  1153.          MVC   TYPFIL,TYPFSV Restore file type                 @SC90037 08076000
  1154.          MVC   FILRCF,RCFSV  Restore record format             @SC90037 08076500
  1155.          MVC   FILLRC,LRCSV  Restore record length             @SC90037 08077000
  1156.          BR    14                                              @SC90037 08077500
  1157. * Receive mode Rpack interpret input tables                             08078000
  1158. RECINST  DC    AL1(AS),AL3(0)        Micro sent parm                    08078500
  1159.          DC    XL1'FF',AL3(RECABR)   Stop                      @SC88074 08079000
  1160.          DC    AL1(00),AL3(RECABR)   Error routine                      08079500
  1161. RECFNST  DC    AL1(AF),AL3(0)        Micro sent a filename              08080000
  1162.          DC    AL1(AX),AL3(0)        Micro sent a filename     @SC86155 08080500
  1163.          DC    AL1(AB),AL3(RECBRK)   Micro sent end of transaction      08081000
  1164.          DC    XL1'FF',AL3(RECABR)   Stop                      @SC88074 08081500
  1165.          DC    AL1(00),AL3(RECABR)   Error return                       08082000
  1166. RECANST  DC    AL1(AA),AL3(RECCKA)   Micro sent A-packet       @SC86316 08082500
  1167. RECDNST  DC    AL1(AD),AL3(0)        Micro sent data                    08083000
  1168. RECZNST  DC    AL1(AZ),AL3(RECEOF)   Micro sent EOF            @SC86316 08083500
  1169.          DC    XL1'FF',AL3(RECABR)   Stop                      @SC88074 08084000
  1170.          DC    AL1(00),AL3(RECABR)   Error return                       08084500
  1171.          LOCALS ,                                              @SC86295 08085000
  1172. RECDSPTR DS    F             Saved length of command           @SC90037 08085500
  1173. RFLG     DS    X             Local flags                       @SC86295 08086000
  1174. RTRC     EQU   X'80'         Other side cancelled              @SC86295 08086500
  1175. RRJC     EQU   X'40'         I cancelled                       @SC86316 08087000
  1176. FL1SV    DS    X             Saved global flags                @SC90037 08087500
  1177. TYPFSV   DS    C             Saved file type                   @SC90037 08088000
  1178. RCFSV    DS    C             Saved record format               @SC90037 08088500
  1179. LRCSV    DS    H             Saved record length               @SC90037 08089000
  1180. RECRCNT  DS    H             Count of packets after rejection  @SC91165 08089500
  1181. RECEIV   EXIT                                                           08090000
  1182.          TITLE 'ACCTNG Routine - save statistics for a transfer'        08090500
  1183. ACCTNG   ENTER                                                          08091000
  1184.          MVC   ERRLAST(2),ERRNUM Save error codes for file     @SC89218 08091500
  1185.          LM    2,3,DSKTOT    Current byte count                @SC88092 08092000
  1186.          SL    3,SSVDSK+4    Get difference from this file     @SC88092 08092500
  1187.          BC    3,*+6                                           @SC88092 08093000
  1188.           BCTR 2,0                                             @SC88092 08093500
  1189.          AL    3,=F'512'     Round up                          @SC88092 08094000
  1190.          BC    12,*+8                                          @SC88092 08094500
  1191.           AL   2,F1                                            @SC88092 08095000
  1192.          SL    2,SSVDSK                                        @SC88092 08095500
  1193.          SRDL  2,10          Convert to Kbytes                 @SC88092 08096000
  1194.          MVC   SSVDSK(8),DSKTOT                                @SC88092 08096500
  1195.          TS    ACCTFLG       See if file is current            @SC89218 08097000
  1196.          BNZ   RTRN0         No, do nothing                    @SC89218 08097500
  1197.          ICM   2,15,NSENT    Calculate offset into table       @SC88092 08098000
  1198.          BZ    RTRN          Must not be counting              @SC88092 08098500
  1199.          BCTR  2,0           Ok, back up one                   @SC91172 08099000
  1200.          MH    2,FLFID1+2                                      @SC88092 08099500
  1201.          A     2,TSENT       Ptr to next name slot             @SC88092 08100000
  1202.          USING ACTBUF,2                                        @SC91172 08100500
  1203.          CLC   ACTSIZ,F0     Already set?                      @SC91172 08101000
  1204.          BNE   RTRN          Yes, don't mess it up             @SC88092 08101500
  1205.          STCM  3,15,ACTSIZ   Save file size in Kbytes          @SC91172 08102000
  1206.          MVC   ACTERR(2),ERRNUM Save error code for file       @SC91172 08102500
  1207.          BAL   14,ACCTTOD    Get time in R0                    @SC91172 08103000
  1208.          STCM  0,15,TRANEND                                    @SC92210 08103500
  1209.          DROP  2                                               @SC91172 08104000
  1210.          B     RTRN0                                           @SC88306 08104500
  1211. *                                                                       08105000
  1212. * Copy file name from (R1) to file table, if possible; update count.    08105500
  1213. ACCTST   ENTER ALT                                             @SC88306 08106000
  1214.          MVI   ACCTFLG,0     Indicate file is current          @SC89218 08106500
  1215.          L     3,NSENT       Number of files sent so far       @SC88306 08107000
  1216.          LA    4,1(,3)       Incr number of sent files         @AB89191 08107500
  1217.          ST    4,NSENTAC     Number of files for acctng        @AB89191 08108000
  1218.          C     3,=A(MAXNSENT) Did we send more than countable? @SC88306 08108500
  1219.          BNL   RTRN0         Yes, cannot keep track of 'em     @SC88306 08109000
  1220.          MH    3,FLFID1+2    Times length of items             @SC88306 08109500
  1221.          A     3,TSENT       Loc in sent-table                 @SC88306 08110000
  1222.          USING ACTBUF,3                                        @SC91172 08110500
  1223.          XC    ACTBUF(ACTLEN),ACTBUF Clear out entry           @SC91172 08111000
  1224.          MVC   ACTFID,0(1)   Save filespec                     @SC91172 08111500
  1225.          BAL   14,ACCTTOD    Get time in R0                    @SC91172 08112000
  1226.          STCM  0,7,ACTBEG                                      @SC91172 08112500
  1227.          ST    4,NSENT       Keep it                           @SC88306 08113000
  1228.          B     RTRN0                                           @SC88306 08113500
  1229.          DROP  3                                               @SC91172 08114000
  1230.          LOCALS ,                                              @SC91172 08114500
  1231. ACCTNG   EXIT  ,                                               @SC88092 08115000
  1232.          TITLE 'SPAR Routine - use parms from other host in DATA'       08115500
  1233. SPAR     ENTER                                                          08116000
  1234.          L     7,DATL        Data length                       @SC86120 08116500
  1235.          L     5,ARDATA      Point to data                     @SC86190 08117000
  1236.          LA    8,DEFPARM                                       @SC86190 08117500
  1237.          SR    8,5           Set up offset for defaults        @SC86190 08118000
  1238.          BCTR  5,0           Point one before data             @SC86190 08118500
  1239.          LA    6,1           Set up BXH                        @SC86120 08119000
  1240.          AR    7,5           Point to last data char           @SC86120 08119500
  1241.          BAL   14,SPARFTCH   Get a char                        @SC86120 08120000
  1242.          UNCHR 4             Max send packet size              @SC86120 08120500
  1243.          C     4,AKMIN       Less than min Kermit size?        @SC86295 08121000
  1244.          BNL   SPARSPM               No, it's OK                        08121500
  1245.          LA    4,KMIN                Else, use the min value            08122000
  1246. SPARSPM  C     4,AKMAX       More than max Kermit size?        @SC86295 08122500
  1247.          BNH   SPARSPS               No, it's OK                        08123000
  1248.          LA    4,KMAX                                                   08123500
  1249. SPARSPS  ST    4,SPSIZ               Save max send packet size          08124000
  1250.          BAL   14,SPARFTCH   Get a char                        @SC86120 08124500
  1251.          UNCHR 4,,TIMOUT     Timeout micro wants us to do      @SC86120 08125000
  1252.          BAL   14,SPARFTCH   Get a char                        @SC86120 08125500
  1253.          UNCHR 4,,SPADN      Pad count micro wants             @SC86120 08126000
  1254.          BAL   14,SPARFTCH                                     @SC86120 08126500
  1255.          CTL   4,,SPADC      Pad char micro wants              @SC86120 08127000
  1256.          BAL   14,SPARFTCH                                     @SC86120 08127500
  1257.          UNCHR 4,,SEOL       EOL char we have to use           @SC86120 08128000
  1258.          CLC   SEOL,SMARK                                               08128500
  1259.          BE    SPARCR                Use CR if EOL=MARK char            08129000
  1260.          CLI   SEOL,ABL                                                 08129500
  1261.          BL    SPAREOL1      OK if within ctl range            @SC92030 08130000
  1262. SPARCR   MVI   SEOL,CR               Send a CR to that crazy micro      08130500
  1263. SPAREOL1 CLI   TRMTP,C'F'    Doing FULL?                       @SC92030 08131000
  1264.          BNE   SPAREOL2      No, leave it                      @SC92030 08131500
  1265.          MVI   SEOL,AEXCL    Yes, insist on printable EOL!     @SC92030 08132000
  1266. SPAREOL2 MVC   S1EOL,SEOL    Make extra copy                   @SC87274 08132500
  1267. SPARCTL  BAL   14,SPARFTCH                                     @SC86120 08133000
  1268.          NOTQR *+8           Go if not 33-62 or 96-126         @SC86120 08133500
  1269.           LA   4,A#          Default ctl-quote                 @SC86120 08134000
  1270.          STC   4,RCTLQ       Save ctl-quote micro's using      @SC86120 08134500
  1271.          BAL   14,SPARFTCH                                     @SC86120 08135000
  1272.          CLI   EBQC,0                                          @SC87008 08135500
  1273.          BE    SPARNB        8-bit is off                      @SC87008 08136000
  1274.          CLI   LCKFRC,X'21'  Forcing locks?                    @SC91275 08136500
  1275.          BE    SPARNB        Yes, turn off 8-bit quote         @SC91275 08137000
  1276.          CLM   4,1,=AL1(AY)                                    @SC86120 08137500
  1277.          BNE   *+8                                             @SC86120 08138000
  1278.          IC    4,EBQC        Micro agrees                      @SC86120 08138500
  1279.          BAL   14,SPARCKQX                                     @SC86120 08139000
  1280.           B    SPARNB        Micro says no 8-bit quoting       @SC86120 08139500
  1281.          CLI   EBQ,0                                                    08140000
  1282.          BE    SPAREBQ               Use it if we agree                 08140500
  1283.          CLM   4,1,EBQ                                         @SC86120 08141000
  1284.          BE    SPAREBQ               Or we match                        08141500
  1285. SPARNB   SR    4,4                   Otherwise cannot do it             08142000
  1286. SPAREBQ  STC   4,EBQ                 Set 8-bit-quoting char/flag        08142500
  1287.          BAL   14,SPARFTCH                                     @SC86120 08143000
  1288.          CLM   4,1,=AL1(AB)                                    @SC92085 08143500
  1289.          BE    SPARBCM       Go if 'B'                         @SC92085 08144000
  1290.          CH    4,SPARBCD+2                                     @SC92085 08144500
  1291.          BL    SPARBCD       Go if less than 1, use 1          @SC92085 08145000
  1292.          CLM   4,1,=AL1(A3)                                    @SC92085 08145500
  1293.          BH    SPARBCD       Go if over 3, use 1               @SC92085 08146000
  1294. SPARBCM  CLM   4,1,BCTR      Requested and our BCT same?       @SC92085 08146500
  1295.          BE    SPARBCT               Yes, they are the same             08147000
  1296.          CLI   BCTR,0                                                   08147500
  1297.          BE    SPARBCT               We'll accept anything              08148000
  1298. SPARBCD  LA    4,A1          We don't match, use 1             @SC92085 08148500
  1299. SPARBCT  STC   4,BCTR                Micro's chksum length              08149000
  1300.          BAL   14,SPARFTCH                                     @SC86120 08149500
  1301.          BAL   14,SPARCKQX   See if valid                      @SC86120 08150000
  1302.           B    SPARNR        No good                           @SC86120 08150500
  1303.          CLM   4,1,EBQ                                         @SC86120 08151000
  1304.          BE    SPARNR                Go if same prefix                  08151500
  1305.          CLI   RPTQ,0                                                   08152000
  1306.          BE    SPARRQ                We can use anything                08152500
  1307.          CLM   4,1,RPTQ                                        @SC86120 08153000
  1308.          BE    SPARRQ                We match                           08153500
  1309. SPARNR   SR    4,4                   No repeat quoting                  08154000
  1310. SPARRQ   STC   4,RPTQ                Use negotiated repeat quote        08154500
  1311.          BAL   14,SPARFTCH   Get capabilities                  @SC86149 08155000
  1312.          UNCHR 4,,RCAPA                                        @SC86149 08155500
  1313.          MVC   LCKCAPA,RCAPA See if agree on locking shift     @SC91275 08156000
  1314.          NC    LCKCAPA,SCAPA                                   @SC91275 08156500
  1315.          NI    LCKCAPA,X'20'                                   @SC91275 08157000
  1316.          CLI   EBQ,0         Negotiated 8-bit quoting?         @SC91275 08157500
  1317.          BNE   *+8           Yes, locking is permitted         @SC91275 08158000
  1318.           MVI  LCKCAPA,0     No, suppress locking              @SC91275 08158500
  1319.          OC    LCKCAPA,LCKFRC Set anyway if FORCE mode         @SC91275 08159000
  1320.          TM    RCAPA,LONGP   Test for long packet bit          @TB86196 08159500
  1321.          BZ    SPARNX        No extended packets               @TB86196 08160000
  1322.          MVC   TMP,RCAPA                                       @SC86202 08160500
  1323. SPARNS1  TM    TMP,MORCAPAS  Test for more CAPAS bytes         @SC86202 08161000
  1324.          BZ    SPARNS2       No more                           @TB86196 08161500
  1325.          BAL   14,SPARFTCH   Get capabilities                  @TB86196 08162000
  1326.          UNCHR 4,,TMP                                          @TB86196 08162500
  1327.          B     SPARNS1                                         @TB86196 08163000
  1328. SPARNS2  BAL   14,SPARFTCH   Skip window byte                  @SC86202 08163500
  1329.          BAL   14,SPARFTCH   Get next header byte              @TB86196 08164000
  1330.          LR    1,4                                             @TB86196 08164500
  1331.          UNCHR 1             MAXLX1 byte                       @TB86196 08165000
  1332.          MH    1,XLFCT+2     Times the factor                  @SC86202 08165500
  1333.          BAL   14,SPARFTCH   Get next header byte              @TB86196 08166000
  1334.          UNCHR 4             MAXLX2 byte                       @TB86196 08166500
  1335.          AR    1,4           Compute total length              @TB86196 08167000
  1336.          BNP   SPARNX        If zero, use default              @TB86196 08167500
  1337.          ST    1,SPSIZ       New SPSIZ for extended            @TB86196 08168000
  1338. SPARNX   DS    0H                                              @TB86196 08168500
  1339. * Now compute MAXSIZ                                                    08169000
  1340.          L     5,SPSIZ               Maximum send packet size           08169500
  1341.          LA    6,MAXWS       Longest full-screen write         @SC92030 08170000
  1342.          BAL   14,TTYCHK                                       @SC92030 08170500
  1343.           LA   6,MAXWT       Longest linemode write            @SC92030 08171000
  1344.          CLI   TRMTP,C'F'                                      @SC92030 08171500
  1345.          BNE   *+8           Not a full-screen non-transparent @SC92030 08172000
  1346.           LA   6,77          Strictly limited                  @SC92030 08172500
  1347.          CR    5,6                                             @SC92030 08173000
  1348.          BNH   SPAREHL                                         @SC90134 08173500
  1349.          LR    5,6           Biggest we can send               @SC92030 08174000
  1350. SPAREHL  S     5,F3          SOP, LEN, EOP don't count in LEN  @SC92030 08174500
  1351.          IC    4,SPADN       Length of padding, if any         @SC90277 08175000
  1352.          SR    5,4           Part of I/O limit if long         @SC90277 08175500
  1353.          CLI   S1HND,0                                         @SC90010 08176000
  1354.          BE    SPARNY        Ok, no handshake                  @SC90010 08176500
  1355.          BCTR  5,0           Deduct one for handshake          @SC90010 08177000
  1356. SPARNY   DS    0H                                              @SC86205 08177500
  1357.          C     5,AKMAX       Can this be a long packet?        @SC92030 08178000
  1358.          BNH   *+8           No                                @SC92030 08178500
  1359.           S    5,F3          Yes, minus extended header length @SC92030 08179000
  1360.          S     5,F3          Minus SEQ,TYP, and quoting leeway @SC92030 08179500
  1361.          IC    4,BCTR                Get user's negotiated BCT          08180000
  1362.          N     4,F           Get just length code: 1,2,3       @SC92085 08180500
  1363.          SR    5,4                   Minus checksum length              08181000
  1364.          CLI   EBQ,0                                                    08181500
  1365.          BE    SPARNEBQ              Go if no 8-Bit quoting             08182000
  1366.          BCTR  5,0                   Another one for 8-bit quoting      08182500
  1367. SPARNEBQ CLI   RPTQ,0                                                   08183000
  1368.          BE    SPARNRQ               Go if no repeat char quoting       08183500
  1369.          BCTR  5,0                                                      08184000
  1370.          BCTR  5,0                   Minus two for repeat prefix        08184500
  1371. SPARNRQ  ST    5,MAXSIZ              Save max length for data field     08185000
  1372.          ST    5,MAXSIZ+4    Static extra copy (for tuning)             08185500
  1373.          CLI   TRMTP,C'F'    FULLSCREEN?                       @SC93173 08186000
  1374.          BNE   SPARCTST                                        @SC93173 08186500
  1375.          XC    CTLTAB(32),CTLTAB  Yes, must encode everything  @SC93173 08187000
  1376.          XC    CTLTAB+127(33),CTLTAB+127  (DEL + C1)           @SC93173 08187500
  1377. SPARCTST LA    1,XOFF        Pretty dangerous to send XOFF!    @SC93173 08188000
  1378.          BAL   14,SPARENC                                      @SC93173 08188500
  1379.          IC    1,SEOL        Must encode EOL                   @SC93173 08189000
  1380.          BAL   14,SPARENC                                      @SC93173 08189500
  1381.          IC    1,SMARK       Must encode SOP                   @SC93173 08190000
  1382.          BAL   14,SPARENC                                      @SC93173 08190500
  1383.          IC    1,S1HND       Must encode handshake             @SC93173 08191000
  1384.          BAL   14,SPARENC                                      @SC93173 08191500
  1385.          MVI   CTLTAB+ABL,1  Mark all printables unprefixed    @SC93173 08192000
  1386.          MVC   CTLTAB+ABL+1(94),CTLTAB+ABL                     @SC93173 08192500
  1387. SPARBAK  RET                                                   @SC86152 08193000
  1388. *                                                                       08193500
  1389. SPARENC  CL    1,=F'160'     Proper control?                   @SC93173 08194000
  1390.          BNLR  14            No, ignore this one               @SC93173 08194500
  1391.          LTR   1,1           Assume "0" means not defined      @SC93173 08195000
  1392.          BZR   14            and ignore such                   @SC93173 08195500
  1393.          SR    0,0                                             @SC93173 08196000
  1394.          STC   0,CTLTAB(1)   Mark this one to encode           @SC93173 08196500
  1395.          BR    14                                              @SC93173 08197000
  1396. *                                                                       08197500
  1397. SPARCKQX CLM   4,1,RCTLQ                                       @SC86120 08198000
  1398.          BER   14            Cannot use same prefix            @SC86120 08198500
  1399.          CLM   4,1,SCTLQ                                       @SC86120 08199000
  1400.          BER   14                                              @SC86120 08199500
  1401.          B     CHKQR         Test if 33-62 or 96-126           @SC86120 08200000
  1402. SPARFTCH L     4,SPACE       Default                           @SC86120 08200500
  1403.          BXH   5,6,*+8       Check for more data               @SC86120 08201000
  1404.          IC    4,0(5)        OK, use it                        @SC86120 08201500
  1405.          C     4,SPACE       Default?                          @SC86120 08202000
  1406.          BNER  14                                              @SC86120 08202500
  1407.          IC    4,0(5,8)      Yes, get default value            @SC86190 08203000
  1408.          BR    14                                              @SC86120 08203500
  1409. *                                                                       08204000
  1410. *        SPARSET Routine - set up for exchange (SPAR 1st)      @SC86152 08204500
  1411. *                                                                       08205000
  1412. SPARSET  ENTER ALT                                             @SC86152 08205500
  1413.          MVI   BCTR,0        Use whatever micro wants          @SC86152 08206000
  1414.          MVI   EBQ,0                                           @SC86152 08206500
  1415.          MVI   RPTQ,0                                          @SC86152 08207000
  1416.          MVI   BCTU,1        Must start at 1                   @SC86295 08207500
  1417.          MVC   BCTOFF,F0     (and flag at 0)                   @SC92085 08208000
  1418.          B     SPARBAK                                         @SC86152 08208500
  1419.          LOCALS ,                                              @SC86295 08209000
  1420. SPAR     EXIT                                                           08209500
  1421.          TITLE 'RPAR Routine - sets up parms to send to other host'     08210000
  1422. RPAR     ENTER                                                          08210500
  1423.          OI    FL3,PXCH      Parameters exchanged now          @SC87012 08211000
  1424.          L     9,ASDATA                                        @SC86295 08211500
  1425.          TOCHR 5,RTIMO,1(9)  Time limit for micro to wait      @SC86295 08212000
  1426.          TOCHR 5,RPADN,2(9)  Number of padding chars.          @SC86295 08212500
  1427.          CTL   5,RPADC,3(9)  Pad character                     @SC86295 08213000
  1428.          TOCHR 5,REOL,4(9)   EOL char I need                   @SC86295 08213500
  1429.          MVC   5(1,9),SCTLQ                                    @SC86295 08214000
  1430.          MVC   6(1,9),EBQ                                      @SC86295 08214500
  1431.          CLI   EBQ,0                                                    08215000
  1432.          BNE   RPARBCT               It's OK if not null                08215500
  1433.          MVI   6(9),AN       Else, use an N                    @SC86295 08216000
  1434. RPARBCT  MVC   7(1,9),BCTR   Negotiated checksum               @SC86295 08216500
  1435.          MVC   8(1,9),RPTQ                                     @SC86295 08217000
  1436.          CLI   RPTQ,0                                                   08217500
  1437.          BNE   *+8           It's ok if not null               @SC86149 08218000
  1438.          MVI   8(9),ABL      Else, use a blank                 @SC86295 08218500
  1439.          LA    0,10          Size of data                      @SC86149 08219000
  1440.          NI    SCAPA,255-LONGP No long packets                 @TB86196 08219500
  1441.          L     5,RPSIZ       Packet size                       @SC92030 08220000
  1442.          L     6,AMAXRS      Biggest send for full-screen      @SC92030 08220500
  1443.          CLI   TRMTP,C'A'    3174 AEA mode?                    @SC92030 08221000
  1444.          BNE   *+8           No, fine                          @SC92030 08221500
  1445.           LA   6,127         Strict limit of 3174 buffer       @SC92030 08222000
  1446.          BAL   14,TTYCHK                                       @SC92030 08222500
  1447.           L    6,AMAXRT      TTY limited separately by system  @SC92030 08223000
  1448.          CLI   TRMTP,C'F'    Full-screen non-transparent?      @SC92030 08223500
  1449.          BNE   *+8           No                                @SC92030 08224000
  1450.           LA   6,78          Strict limit                      @SC92030 08224500
  1451.          CR    5,6                                             @SC92030 08225000
  1452.          BNH   *+6                                             @SC92030 08225500
  1453.           LR   5,6           Biggest we can receive            @SC92030 08226000
  1454.          LA    4,KMAX        Limit for short packets           @SC92030 08226500
  1455.          CR    4,5           Check against actual limit        @SC92030 08227000
  1456.          BNH   *+6                                             @SC92030 08227500
  1457.           LR   4,5           Use actual limit                  @SC92030 08228000
  1458.          TOCHR 4,,0(9)       Largest short packet size         @SC92030 08228500
  1459.          C     5,AKMAX       Are we allowing long packets?     @SC92030 08229000
  1460.          BNH   RPARNEX       KMAX >= RPSIZ                     @SC92030 08229500
  1461.          OI    SCAPA,LONGP   Long packets                      @TB86196 08230000
  1462.          MVI   10(9),ABL     Window size is blank              @SC86295 08230500
  1463. RPARS1   SR    4,4                                             @SC86205 08231000
  1464.          SH    5,=H'7'       Allow for long header             @SC90277 08231500
  1465.          D     4,XLFCT       Compute extended size bytes       @TB86196 08232000
  1466.          TOCHR 5,,11(9)      Extended size 1                   @SC86295 08232500
  1467.          TOCHR 4,,12(9)      Extended size 2                   @SC86295 08233000
  1468.          LA    0,13          Size of data                      @TB86196 08233500
  1469. RPARNEX  DS    0H                                              @TB86196 08234000
  1470.          TOCHR 5,SCAPA,9(9)  Capabilities                      @SC86295 08234500
  1471.          ST    0,DATL        Return it                         @SC86149 08235000
  1472.          LA    0,3           Reset function                    @SC86295 08235500
  1473.          BAL   14,TTYCHK                                       @SC92030 08236000
  1474.           B    RPARSTT       Line mode                         @SC92030 08236500
  1475.          KCALL SCRNIO                                          @SC86295 08237000
  1476.          B     RPARBAK                                         @SC86295 08237500
  1477. RPARSTT  KCALL TERMIO                                          @SC86295 08238000
  1478. RPARBAK  RET                                                   @SC86152 08238500
  1479. *                                                                       08239000
  1480. *        RPARSET Routine - set up for exchange (RPAR 1st)      @SC86152 08239500
  1481. *                                                                       08240000
  1482. RPARSET  ENTER ALT                                             @SC86152 08240500
  1483.          MVI   BCTU,1        Must start at 1                   @SC86295 08241000
  1484.          MVC   BCTOFF,F0     (and flag at 0)                   @SC92085 08241500
  1485.          CLI   TRMTP,C'F'                                      @SC92030 08242000
  1486.          BNE   *+8                                             @SC92030 08242500
  1487.           MVI  S1EOL,AEXCL   Insist on printable EOL for FULL  @SC92030 08243000
  1488.          TM    FL2,SRV       Possible I-packet exchange?       @SC87169 08243500
  1489.          BZ    RPSCLR        Not in Server mode                @SC87169 08244000
  1490.          TM    FL3,PXCH      Any exchange since last SET?      @SC87169 08244500
  1491.          BO    RPARBAK       Yes, keep latest settings         @SC87169 08245000
  1492. RPSCLR   MVC   BCTR,BCTC     Use what user set                 @SC87169 08245500
  1493.          TR    BCTR,ETOAD    Convert to ASCII code             @SC92085 08246000
  1494.          MVC   EBQ,EBQC      Set what we want otherwise        @SC86152 08246500
  1495.          CLI   LCKFRC,X'21'  Forcing locks?                    @SC91275 08247000
  1496.          BNE   RPSEBQ        No, ok                            @SC91275 08247500
  1497.          MVI   EBQ,0         Yes, disable 8-bit quote          @SC91275 08248000
  1498. RPSEBQ   CLI   RPTQ,0                                          @SC86152 08248500
  1499.          BNE   RPARBAK       If RPTQ is set leave it alone     @SC86152 08249000
  1500.          MVC   RPTQ,RPTQC    Set what we want otherwise        @SC86152 08249500
  1501.          B     RPARBAK                                         @SC86152 08250000
  1502.          LOCALS ,                                              @SC86295 08250500
  1503. RPAR     EXIT                                                           08251000
  1504.          TITLE 'ENCODE Routine - encode pkts from RBUF into DATA'       08251500
  1505. ENCODE   ENTER                                                          08252000
  1506.          L     6,MAXSIZ                                        @SC86295 08252500
  1507.          L     9,ASDATA      Pointer to data to fill           @SC86190 08253000
  1508.          AR    6,9           Limit on output                   @SC86295 08253500
  1509. ENCAGAIN L     8,RBUFP               Index of next char in RBUF         08254000
  1510.          L     5,RBUFL       Data length in RBUF               @SC86163 08254500
  1511.          L     1,RBUF                Point to start of buffer           08255000
  1512.          AR    5,1                   Point to char after last one       08255500
  1513.          AR    8,1           Point to char to encode           @SC86163 08256000
  1514.          CR    8,1           Are we at the start?              @SC91116 08256500
  1515.          BH    ENCNXT        No, proceed                       @SC91116 08257000
  1516.          TM    FL1,NAME                                        @SC91320 08257500
  1517.          BO    ENCNXT        Names don't have CC anyway        @SC91320 08258000
  1518.          TM    FL1,EOF       Are we at the end?                @SC91116 08258500
  1519.          BO    ENCNXT        Yes, quit inserting CC            @SC91116 08259000
  1520.          TM    FLNFLGS,FLNCC Yes, see if handling carriage ctl @SC91116 08259500
  1521.          BZ    ENCNXT        No, proceed                       @SC91116 08260000
  1522.          CR    5,1           Are we before 1st record?         @SC91116 08260500
  1523.          BE    ENCNXT        Yes, must read and look again     @SC91116 08261000
  1524.          SR    1,1                                             @SC91116 08261500
  1525.          ICM   1,1,CARCTL                                      @SC91116 08262000
  1526.          BZ    ENCNXTIN                                        @SC91116 08262500
  1527.          C     1,F3                                            @SC91116 08263000
  1528.          BH    ENCNXT        Already set up: 1 replacement     @SC91116 08263500
  1529.          LA    0,0(1,9)      Allow for the inserts             @SC91116 08264000
  1530.          CR    0,6           Plenty of room?                   @SC91116 08264500
  1531.          BH    ENCGOOD       No, dump out a packet now         @SC91116 08265000
  1532. ENCCCLP  MVC   0(1,9),SCTLQ  Insert a LF                       @SC91116 08265500
  1533.          MVI   1(9),ALF+64                                     @SC91116 08266000
  1534.          LA    9,2(,9)                                         @SC91116 08266500
  1535.          BCT   1,ENCCCLP     Repeat correct number of LF's     @SC91116 08267000
  1536.          B     ENCNXTIN      Done inserting                    @SC91116 08267500
  1537. ENCNXT   CR    8,5           Are we past the last char?        @SC86163 08268000
  1538.          BL    ENCPKT        No, not exhausted RBUF yet        @SC86163 08268500
  1539.          TM    FL1,NAME                                        @SC86163 08269000
  1540.          BO    ENCEMPT       No more disk read if file name    @SC86163 08269500
  1541.          KCALL INBUF,E=ENCRET                                  @SC86163 08270000
  1542.          B     ENCAGAIN                                        @SC86163 08270500
  1543. ENCPKT   MVC   NEWCHAR,0(8)  Get next input character          @SC91275 08271000
  1544.          TM    LCKCAPA,X'20'                                   @SC91275 08271500
  1545.          BZ    ENCLKZ        Locking shift not enabled         @SC91275 08272000
  1546.          MVC   LCKNEW,0(8)   Look ahead 5 characters           @SC91275 08272500
  1547.          NC    LCKNEW,=5X'80' Grab the 8th bits                @SC91275 08273000
  1548.          CLC   LCKOLD,LCKNEW Is the next one the right state?  @SC91275 08273500
  1549.          BE    ENCLKOK       Yes, go on                        @SC91275 08274000
  1550.          CLI   EBQ,0         8th-bit quoting allowed?          @SC91275 08274500
  1551.          BE    ENCLKSW       No, must switch                   @SC91275 08275000
  1552.          CLI   0(8),CR                                         @SC91275 08275500
  1553.          BE    ENCLKSW       CR, prevent interference with CC  @SC91275 08276000
  1554.          CLI   0(8),SI+128                                     @SC91275 08276500
  1555.          BE    ENCLKOK       Avoid quoting shifted <1>SI       @SC91275 08277000
  1556.          CLC   LCKNEW(4),LCKNEW+1 Different state; isolated?   @SC91275 08277500
  1557.          BNE   ENCLKOK       Yes, keep same state              @SC91275 08278000
  1558. ENCLKSW  MVC   LCKOLD,LCKNEW Adjust state                      @SC91275 08278500
  1559.          MVC   0(1,9),SCTLQ  Insert prefix                     @SC91275 08279000
  1560.          MVI   1(9),SO+64    Make a Shift Out                  @SC91275 08279500
  1561.          CLI   LCKNEW,X'80'  8-bit chars?                      @SC91275 08280000
  1562.          BE    *+8           Yes, that's it                    @SC91275 08280500
  1563.           MVI  1(9),SI+64    No, make a Shift In               @SC91275 08281000
  1564.          LA    9,2(,9)       Advance output ptr                @SC91275 08281500
  1565.          CR    9,6           Did we reach max pkt size?        @SC91275 08282000
  1566.          BNL   ENCFULL       Yes, must empty buffer now        @SC91275 08282500
  1567. ENCLKOK  XC    NEWCHAR,LCKOLD Apply state                      @SC91275 08283000
  1568.          CLI   NEWCHAR,SO                                      @SC91275 08283500
  1569.          BL    ENCLKZ        Not a data-link special           @SC91275 08284000
  1570.          CLI   NEWCHAR,DLE                                     @SC91275 08284500
  1571.          BH    ENCLKZ        Not a special                     @SC91275 08285000
  1572.          LA    14,2(,9)      Updated pointer                   @SC91275 08285500
  1573.          CR    14,6          Special, is there enough room?    @SC91275 08286000
  1574.          BNL   ENCFULL       No, must empty buffer now         @SC91275 08286500
  1575.          MVC   0(1,9),SCTLQ  Special, quote with DLE           @SC91275 08287000
  1576.          MVI   1(9),DLE+64                                     @SC91275 08287500
  1577.          LR    9,14          Advance ptr                       @SC91275 08288000
  1578. ENCLKZ   CLI   RPTQ,0                                          @SC91275 08288500
  1579.          BE    ENCEBQ                Go if no repeat quoting            08289000
  1580.          CLC   0(1,8),1(8)   At least 2 of these?              @SC92052 08289500
  1581.          BNE   ENCEBQ        No, not enough                    @SC86163 08290000
  1582.          LA    14,2(,8)      Next untested character           @SC92052 08290500
  1583.          LR    2,8           Start of string                   @SC86163 08291000
  1584.          LA    3,KMAX(8)     Max allowed by notation           @SC86163 08291500
  1585.          CR    3,5           Watch for end of data             @SC86163 08292000
  1586.          BNH   *+6                                             @SC86163 08292500
  1587.          LR    3,5           Truncate at max                   @SC86163 08293000
  1588.          LR    15,3          Same limit                        @SC86163 08293500
  1589.          SR    3,2           Get lengths                       @SC86163 08294000
  1590.          SR    15,14         Length of shorter string          @SC86163 08294500
  1591.          BM    ENCEBQ        2nd one wasn't real after all     @SC92052 08295000
  1592.          ICM   15,8,0(8)     Use starting char for fill        @SC86163 08295500
  1593.          CLCL  2,14          Find end of match                 @SC86163 08296000
  1594.          SR    14,8          Get repeat count                  @SC86163 08296500
  1595.          C     14,=A(RPTMIN) Enough to justify?                @SC92052 08297000
  1596.          BL    ENCEBQ        No, not enough                    @SC92052 08297500
  1597.          AR    8,14          Advance ptr to                    @SC86163 08298000
  1598.          BCTR  8,0             last matching char              @SC86163 08298500
  1599.          MVC   0(1,9),RPTQ   Put repeat quote into DATA        @SC86163 08299000
  1600.          TOCHR 14,,1(9)                                        @SC86163 08299500
  1601.          LA    9,2(9)        Count 2 for RPTQ and rpt count    @SC86295 08300000
  1602. ENCEBQ   TM    NEWCHAR,X'80' 8th bit on?                       @SC91275 08300500
  1603.          BZ    ENCCTL                no 8th bit                         08301000
  1604.          CLI   EBQ,0                                                    08301500
  1605.          BNE   ENC8B         Can use 8bit quoting, do it       @SC89072 08302000
  1606.          TM    SPRTY,DAT8    Can't: see if 8-bit channel       @SC89072 08302500
  1607.          BO    ENCCTL        Yes, that's ok too                @SC89072 08303000
  1608.          MVI   ERRNUM,ERRPTY No, can't send this byte!         @SC89072 08303500
  1609.          LA    15,1                                            @SC89072 08304000
  1610.          B     ENCRET        Save length, in case ERPACK loop  @SC89072 08304500
  1611. ENC8B    DS    0H                                              @SC89072 08305000
  1612.          NI    NEWCHAR,127   Get rid of 8th bit                @SC91275 08305500
  1613.          MVC   0(1,9),EBQ            Move EBQ into DATA                 08306000
  1614.          LA    9,1(9)        Count for it                      @SC86295 08306500
  1615. ENCCTL   IC    7,NEWCHAR     Load desired char                 @SC91275 08307000
  1616.          CLI   NEWCHAR,160   Corresponds to control character? @SC93173 08307500
  1617.          BNL   ENCNCTL       Not within control range          @SC93173 08308000
  1618.          TRT   NEWCHAR,CTLTAB Check table of safe ctls         @SC93173 08308500
  1619.          BNZ   ENCNCTLT      Don't need to encode it           @SC93173 08309000
  1620. ENCSCTL  CTL   7             Convert to non-control            @SC86163 08309500
  1621.          B     ENCMVCTL                                                 08310000
  1622. *                                                                       08310500
  1623. ENCNCTLT LTR   7,7                                             @SC93173 08311000
  1624.          BZ    ENCNOCTL      NUL can't be a prefix char        @SC93173 08311500
  1625. ENCNCTL  CLM   7,1,SCTLQ                                       @SC93173 08312000
  1626.          BE    ENCMVCTL              send prefix if ctl quote char      08312500
  1627.          CLM   7,1,EBQ                                         @SC93173 08313000
  1628.          BE    ENCMVCTL              ditto if 8bit quote                08313500
  1629.          CLM   7,1,RPTQ                                        @SC93173 08314000
  1630.          BNE   ENCNOCTL              not so if not repeat quote         08314500
  1631. ENCMVCTL MVC   0(1,9),SCTLQ          Move a ctl quote                   08315000
  1632.          LA    9,1(9)                incr for it                        08315500
  1633. ENCNOCTL STC   7,0(9)        Move the char, finally!           @SC86163 08316000
  1634.          LA    9,1(9)                incr for it                        08316500
  1635. ENCNXTIN MVI   CARCTL,1      Indicate started output           @SC91116 08317000
  1636.          LA    8,1(8)        Incr RBUF pointer                 @SC86163 08317500
  1637.          CR    9,6           Did we reach max pkt size?        @SC86295 08318000
  1638.          BL    ENCNXT        Test for more data                @SC86295 08318500
  1639. *                                                                       08319000
  1640. ENCFULL  CR    8,5           Are we past the last char?        @SC86163 08319500
  1641.          BL    ENCGOOD       No, not exhausted RBUF data yet   @SC86163 08320000
  1642. ENCEMPT  XC    RBUFL,RBUFL   Zap data length for next time     @SC86163 08320500
  1643. ENCGOOD  SR    15,15                                                    08321000
  1644.          S     8,RBUF        Get current index                 @SC86163 08321500
  1645.          ST    8,RBUFP               Save RBUF index                    08322000
  1646. ENCRET   S     9,ASDATA      Get length                        @SC86295 08322500
  1647.          ST    9,DATL        Save encoded DATA length          @SC86295 08323000
  1648.          RET   ,                                               @SC86295 08323500
  1649.          LOCALS ,                                              @SC86295 08324000
  1650. LCKNEW   DS    CL5           5-byte lookahead for shift lock   @SC91275 08324500
  1651. NEWCHAR  DS    C             Current character with shifts     @SC91275 08325000
  1652. ENCODE   EXIT                                                           08325500
  1653.          TITLE 'NPREAD Routine - copy from RBUF to SDATA'      @HF86150 08326000
  1654. NPREAD   ENTER                                                 @HF86150 08326500
  1655.          L     6,SPSIZ       Max packet length                 @SC86295 08327000
  1656.          LR    4,6           Save                              @SC86295 08327500
  1657.          L     9,ASPKT       Fill pointer (includes header)    @SC86165 08328000
  1658.          SR    7,7                                             @SC86165 08328500
  1659.          ICM   7,1,TCTLQ     Fetch control quote               @SC91180 08329000
  1660.          BZ    *+8           Quoting is off                    @SC91180 08329500
  1661.           ICM  7,2,EBQC      Get 8th-bit quote as well         @SC91180 08330000
  1662. NPRAGAIN L     8,RBUFP       Index of next char in RBUF        @SC86165 08330500
  1663.          L     5,RBUFL       Data length in RBUF               @SC86165 08331000
  1664.          L     1,RBUF        Start of buffer                   @SC86165 08331500
  1665.          AR    5,1           Point to char after last one      @SC86165 08332000
  1666.          AR    8,1           Point to char to encode           @SC86165 08332500
  1667.          CR    8,1           Are we at the start?              @SC91116 08333000
  1668.          BH    NPRNXT        No, proceed                       @SC91116 08333500
  1669.          TM    FLNFLGS,FLNCC Yes, see if handling carriage ctl @SC91116 08334000
  1670.          BZ    NPRNXT        No, proceed                       @SC91116 08334500
  1671.          TM    FL1,BINF                                        @SC91116 08335000
  1672.          BO    NPRNXT        No CC if binary                   @SC91116 08335500
  1673.          CR    5,1           Are we before 1st record?         @SC91116 08336000
  1674.          BE    NPRNXT        Yes, must read and look again     @SC91116 08336500
  1675.          SR    1,1                                             @SC91116 08337000
  1676.          ICM   1,1,CARCTL                                      @SC91116 08337500
  1677.          BZ    NPRNXTIN                                        @SC91116 08338000
  1678.          C     1,F3                                            @SC91116 08338500
  1679.          BH    NPRNXT        Already set up: 1 replacement     @SC91116 08339000
  1680.          CR    1,6           Plenty of room?                   @SC91116 08339500
  1681.          BH    NPRGOOD       No, dump out a packet now         @SC91116 08340000
  1682. NPRCCLP  MVI   0(9),ALF      Insert a LF                       @SC91116 08340500
  1683.          LA    9,1(,9)                                         @SC91116 08341000
  1684.          BCTR  6,0           Count down space remaining        @SC91116 08341500
  1685.          BCT   1,NPRCCLP     Repeat correct number of LF's     @SC91116 08342000
  1686. NPRNXTIN MVI   CARCTL,1      Mark it begun                     @SC91116 08342500
  1687.          LA    8,1(,8)       Skip over the control             @SC91116 08343000
  1688.          LTR   6,6                                             @SC91116 08343500
  1689.          BNP   NPRGOOD                                         @SC91116 08344000
  1690. NPRNXT   CR    8,5           Are we past the last char?        @SC86165 08344500
  1691.          BL    NPRTCT        No, not exhausted RBUF yet        @SC86165 08345000
  1692. NPRRD    KCALL INBUF,E=NPRRET                                  @HF86150 08345500
  1693.          B     NPRAGAIN                                        @SC86165 08346000
  1694. NPRTCT   LTR   7,7           Test for quoting                  @SC86165 08346500
  1695.          BZ    NPRNOCTL      Not enabled                       @HF86150 08347000
  1696.          MVI   NPR8B,0       Clear the 8th bit flag            @SC91180 08347500
  1697.          CLM   7,2,0(8)      8th-bit quote?                    @SC91180 08348000
  1698.          BNE   NPRNO8B       No, ok                            @SC91180 08348500
  1699.          MVI   NPR8B,128     Yes, set flag                     @SC91180 08349000
  1700.          LA    8,1(,8)       Next byte is what counts          @SC91180 08349500
  1701.          CR    8,5                                             @SC91180 08350000
  1702.          BNL   NPRRD         Ran out of data, ignore the quote @SC91180 08350500
  1703. NPRNO8B  DS    0H                                              @SC91180 08351000
  1704.          CLM   7,1,0(8)      Is it a quote character?          @HF86150 08351500
  1705.          BNE   NPRNOCT0      No, copy it                       @SC91180 08352000
  1706.          LA    8,1(8)        Check next                        @HF86150 08352500
  1707.          CR    8,5                                             @HF86150 08353000
  1708.          BNL   NPRRD         Ran out of data, ignore the quote @HF86150 08353500
  1709.          CLM   7,2,0(8)      If 8th-bit quote character,       @SC91180 08354000
  1710.          BE    NPRNOCT0       it was quoted, so use it.        @SC91180 08354500
  1711.          CLM   7,1,0(8)      If repeat of quote character      @HF86150 08355000
  1712.          BE    NPRNOCT0       it was quoted, so use it.        @SC91180 08355500
  1713.          NI    0(8),X'1F'    Make control character            @HF86150 08356000
  1714. NPRNOCT0 OC    0(,8),NPR8B   Get proper 8th bit                @SC91180 08356500
  1715. NPRNOCTL MVC   0(1,9),0(8)   Copy the char                     @HF86150 08357000
  1716.          LA    9,1(9)        Incr for it                       @HF86150 08357500
  1717.          LA    8,1(8)        Incr RBUF pointer                 @HF86150 08358000
  1718.          BCT   6,NPRNXT      Get next character if any room    @SC86295 08358500
  1719. *                                                                       08359000
  1720. NPRGOOD  SR    15,15                                           @HF86150 08359500
  1721.          S     8,RBUF        Convert to index                  @SC86165 08360000
  1722.          ST    8,RBUFP       Save it                           @SC86165 08360500
  1723. NPRRET   SR    4,6           Get DATA length                   @SC86295 08361000
  1724.          ST    4,SNDPKL      Save it                           @HF86150 08361500
  1725.          RET                                                   @HF86150 08362000
  1726.          LOCALS ,                                              @SC86295 08362500
  1727. NPR8B    DS    X             8th bit flag                      @SC91180 08363000
  1728. NPREAD   EXIT                                                  @HF86150 08363500
  1729.          TITLE 'DECODE Routine - decode pkts from DATA to WBUF'         08364000
  1730. * Exit: ERRNUM left unchanged unless there is an error.                 08364500
  1731. DECODE   ENTER                                                          08365000
  1732.          ICM   5,B'1111',DATL        Data length to decode              08365500
  1733.          BNP   DECNULL       No data to decode                 @SC91247 08366000
  1734.          TM    FL1,EOF                                                  08366500
  1735.          BO    DECNULL               Ignore if ctl-z caused EOF         08367000
  1736.          L     1,WBUF                Point to output buffer             08367500
  1737.          L     9,WBUFL               Number of chars in it              08368000
  1738.          AR    1,9                   Point to next spot to fill         08368500
  1739.          L     8,ARDATA      Data to be decoded                @SC86190 08369000
  1740.          AR    5,8           Point one past the last char               08369500
  1741. DECLOOP  LA    3,1           Repeat count                      @SC86316 08370000
  1742.          CLI   RPTQ,0                                                   08370500
  1743.          BE    DECEBQ                Not doing repeats                  08371000
  1744.          CLC   RPTQ,0(8)                                                08371500
  1745.          BNE   DECEBQ                Not the repeat quote               08372000
  1746.          UNCHR 3,1(8)        Get number of repeats             @SC86316 08372500
  1747.          LA    8,2(8)                skip to char to decode             08373000
  1748. DECEBQ   MVI   CUR,0                 No 8th bit yet                     08373500
  1749.          CLI   EBQ,0                                                    08374000
  1750.          BE    DECCTL                Not doing 8bit quoting             08374500
  1751.          CLC   EBQ,0(8)                                                 08375000
  1752.          BNE   DECCTL                Not the 8bit quote                 08375500
  1753.          LA    8,1(8)                point to char to decode            08376000
  1754.          MVI   CUR,128               8th bit seen                       08376500
  1755. DECCTL   CLC   RCTLQ,0(8)                                               08377000
  1756.          BNE   DECCHR                not the ctl quote                  08377500
  1757.          LA    8,1(8)                point to char to decode            08378000
  1758.          MVC   TMPC,0(8)                                       @SC90270 08378500
  1759.          NI    TMPC,127      Look at low 7 bits                @SC90270 08379000
  1760.          CLI   TMPC,63                                         @SC90270 08379500
  1761.          BL    DECCHR                skip if not in ctl range           08380000
  1762.          CLI   TMPC,95                                         @SC90270 08380500
  1763.          BH    DECCHR                skip if not in ctl range           08381000
  1764.          CTL   4,0(8),0(8)           Ctl it                             08381500
  1765. DECCHR   OC    0(1,8),CUR            put in the parity                  08382000
  1766.          TM    LCKCAPA,X'20' Locking shift enabled?            @SC91275 08382500
  1767.          BZ    DECCH2        No, just do the byte              @SC91275 08383000
  1768.          CLI   DECESCP,DLE   Escape pending?                   @SC91275 08383500
  1769.          BE    DECCH2        Yes, just do the byte             @SC91275 08384000
  1770.          CLI   0(8),SO       No, see if special coming         @SC91275 08384500
  1771.          BL    DECCH2        No                                @SC91275 08385000
  1772.          CLI   0(8),DLE                                        @SC91275 08385500
  1773.          BH    DECCH2        No                                @SC91275 08386000
  1774.          MVC   DECESCP,0(8)  Save special indicator            @SC91275 08386500
  1775.          BE    DECINCIN      Escape: ignore and suppress repeat@SC91275 08387000
  1776.          XI    0(8),X'0F'    SO->1, SI->0                      @SC91275 08387500
  1777.          IC    14,0(,8)      Convert to new state byte         @SC91275 08388000
  1778.          SLL   14,7                                            @SC91275 08388500
  1779.          STC   14,LCKOLD     Save it                           @SC91275 08389000
  1780.          B     DECINCIN      Nothing further on this byte      @SC91275 08389500
  1781. DECCH2   MVI   DECESCP,0     Not an escape                     @SC91275 08390000
  1782.          XC    0(1,8),LCKOLD Put to current state              @SC91275 08390500
  1783.          MVC   CUR,0(8)              move it here also                  08391000
  1784. DECRLOOP TM    FL1,NAME                                                 08391500
  1785.          BO    DECPUT                skip if not writing to disk        08392000
  1786.          LTR   7,9           Started yet?                      @SC86316 08392500
  1787.          BZ    DECTFUL       No                                @SC86151 08393000
  1788.          C     9,RDWLEN                                        @SC86151 08393500
  1789.          BNE   DECTFUL                                         @SC86151 08394000
  1790.          L     6,WBUF        Just finished RDW                 @SC86316 08394500
  1791.          SR    14,14                                           @SC86151 08395000
  1792.          ICM   14,3,0(6)     Get expected length               @SC86316 08395500
  1793.          C     9,F2          Short?                            @SC86262 08396000
  1794.          BE    DECVLEN       Yes, we got it                    @SC86262 08396500
  1795.          TR    0(5,6),ATOED  No, must be 5-byte ASCII prefix   @SC89301 08397000
  1796.          BAL   14,GETNUM     Read length field                 @SC86316 08397500
  1797.           B    DECDLBAD      Bad                               @SC91247 08398000
  1798.          LR    14,0                                            @SC86316 08398500
  1799. DECVLEN  DS    0H                                              @SC86262 08399000
  1800.          AR    14,9               + RDW length                 @SC86151 08399500
  1801.          ST    14,MAXOUT     Reset byte limit                  @SC86151 08400000
  1802. DECTFUL  C     9,MAXOUT      Max write buffer size reached?    @SC86151 08400500
  1803.          BL    DECMORE       No, keep appending                @SC88120 08401000
  1804.          KCALL OUTBUF,(9),E=RTRN1 Yes, write buffer            @SC88120 08401500
  1805.          SR    9,9           Reset count and output pointer    @SC88120 08402000
  1806.          L     1,WBUF                                          @SC88120 08402500
  1807.          TM    FL1,BINF                                        @SC88120 08403000
  1808.          BO    DECPUT        Binary always folds, no problem   @SC88120 08403500
  1809.          CLI   CUR,CR        Exactly full just in time?        @SC88120 08404000
  1810.          BE    DECIGN        Yes, don't create empty line      @SC88120 08404500
  1811.          LA    0,1           Other, this is called folding     @SC88120 08405000
  1812.          A     0,RECFLD                                        @SC88120 08405500
  1813.          ST    0,RECFLD                                        @SC88120 08406000
  1814.          B     DECPUT        Ok, now copy the new character    @SC88120 08406500
  1815. DECMORE  TM    FL1,BINF                                                 08407000
  1816.          BO    DECPUT                No special test in binary mode     08407500
  1817.          CLI   CUR,CR                                                   08408000
  1818.          BE    DECWRT                A cr means end of record           08408500
  1819.          CLI   CUR,ALF                                         @SC89301 08409000
  1820.          BNE   DECTAB                Not an LF                          08409500
  1821.          CLI   PREV,CR                                                  08410000
  1822.          BE    DECIGN                A cr/lf together = ignre the LF    08410500
  1823. DECWRT   KCALL OUTBUF,(9),E=RTRN1 Write buffer                 @SC88120 08411000
  1824.          SR    9,9                   Reset length to resume decoding    08411500
  1825.          L     1,WBUF                Reset pointer also                 08412000
  1826.          B     DECIGN                                                   08412500
  1827. *                                                                       08413000
  1828. DECTAB   TM    FL2,TABS                                                 08413500
  1829.          BZ    DECCTLZ               Skip if not expanding tabs         08414000
  1830.          CLI   CUR,AHT                                         @SC89301 08414500
  1831.          BNE   DECCTLZ               Not a tab                          08415000
  1832.          LR    0,1           Save output ptr                   @SC86355 08415500
  1833.          LH    2,TABCNT      Get count of tabs that are set    @TS86100 08416000
  1834.          LTR   2,2           Any?                              @SC86355 08416500
  1835.          BZ    DECTL8        No, use every 8 cols              @SC86355 08417000
  1836.          LA    7,TABTBL      Yes, point to table of tabs       @TS86100 08417500
  1837.          SR    1,1                                             @TS86100 08418000
  1838. DECTLP   IC    1,0(7)        Get tab column from table         @TS86100 08418500
  1839.          BCTR  1,0           Adjust for displacement compare   @TS86100 08419000
  1840.          CR    1,9           Where is this tab compared to buf @TS86100 08419500
  1841.          BH    DECTLX        Above buffer position             @TS86100 08420000
  1842.          LA    7,1(7)        Point to next tab position        @TS86100 08420500
  1843.          BCT   2,DECTLP      Continue with next tab            @TS86100 08421000
  1844. DECTL8   DS    0H                                              @SC86355 08421500
  1845.          LA    1,8(9)        Buffer pointer + 8                @SC86355 08422000
  1846.          SRL   1,3                                             @SC86355 08422500
  1847.          SLL   1,3           Round up to multiple of 8         @SC86355 08423000
  1848. DECTLX   C     1,MAXLRC                                        @SC86355 08423500
  1849.          BL    *+8                                             @SC86355 08424000
  1850.          L     1,MAXLRC      Don't go past end of buffer       @SC86355 08424500
  1851.          SR    1,9           Number of blanks to add           @SC86355 08425000
  1852.          AR    9,1           Advance the count                 @SC86355 08425500
  1853.          LA    15,ABL                                          @SC86355 08426000
  1854.          SLL   15,24         Set for ASCII blank fill          @SC86355 08426500
  1855.          MVCL  0,14          Jump to tab stop                  @SC86355 08427000
  1856.          LR    1,0           Restore output ptr                @SC86355 08427500
  1857.          B     DECIGN                skip to the end of this            08428000
  1858. *                                                                       08428500
  1859. DECCTLZ  TM    FL2,EOFZ                                                 08429000
  1860.          BZ    DECPUT                Skip if EOF is off                 08429500
  1861.          CLI   CUR,ASUB                                        @SC89301 08430000
  1862.          BNE   DECPUT                Skip if not a ctl-z                08430500
  1863.          OI    FL1,EOF               Fake an end-of-file                08431000
  1864.          B     DECEOF                all done                           08431500
  1865. *                                                                       08432000
  1866. DECPUT   C     9,F64KP       Still within disk buffer?         @SC90338 08432500
  1867.          BNL   *+10          No, don't copy                    @SC86355 08433000
  1868.          MVC   0(1,1),0(8)   Yes, put the data in buffer       @SC86355 08433500
  1869.          LA    9,1(9)                Increment count                    08434000
  1870.          LA    1,1(1)                Increment pointer                  08434500
  1871. DECIGN   MVC   PREV,CUR              copy the decoded char              08435000
  1872.          BCT   3,DECRLOOP    Repeat it repeat count times      @SC86316 08435500
  1873. DECINCIN LA    8,1(,8)       Bump input data ptr               @SC91275 08436000
  1874.          CR    8,5                   Did we reach end of DATA?          08436500
  1875.          BL    DECLOOP               No, More data left to decode       08437000
  1876. DECEOF   ST    9,WBUFL               Save buffer length                 08437500
  1877. DECNULL  B     RTRN0         Good return code                  @SC86295 08438000
  1878. *                                                                       08438500
  1879. DECDLBAD MVI   ERRNUM,ERRBPC Bad length field for D-binary     @SC91247 08439000
  1880.          B     RTRN1                                           @SC91247 08439500
  1881.          LOCALS ,                                              @SC86295 08440000
  1882. CUR      DS    C             Char being decoded                @SC86295 08440500
  1883. TMPC     DS    C             Low 7 bits of char                @SC90270 08441000
  1884. DECODE   EXIT                                                           08441500
  1885.          TITLE 'ERPACK Routine - send error packet with errnum'         08442000
  1886. ERPACK   ENTER                                                          08442500
  1887.          CLI   ERRNUM,ERRABO                                   @SC86295 08443000
  1888.          BE    RTRN0         Skip it if the micro died         @SC86295 08443500
  1889.          CLOSF SIMPTR        In case we were replaying this    @SC91312 08444000
  1890.          MVI   STYPE,AE              Error packet                       08444500
  1891.          MVC   SEQ,RSN               Synch packet numbers               08445000
  1892.          SR    5,5                                                      08445500
  1893.          IC    5,ERRNUM              Get right message number           08446000
  1894.          SLL   5,2           Pointer offset = ERRNUM * 4       @SC86156 08446500
  1895.          A     5,=A(ERRTAB)  Pointer address                   @SC89215 08447000
  1896.          L     3,0(5)        Msg ptr                           @SC86156 08447500
  1897.          SR    4,4                                             @SC86156 08448000
  1898.          IC    4,0(5)        Msg length                        @SC86156 08448500
  1899.          TM    FL2,PROTO                                       @SC87300 08449000
  1900.          BZ    RTRN0         Skip packet if never started      @SC87300 08449500
  1901.          TM    FL3,ZPRO                                        @SC92064 08450000
  1902.          BO    *+12          Must stop, even if server mode    @SC92064 08450500
  1903.          TM    FL2,SRV       Server will read another command  @SC87343 08451000
  1904.          BO    *+12           so don't zap write/read flag     @SC90173 08451500
  1905.           MVI  WRRD,0        No read ncessary for Err pkt      @SC87300 08452000
  1906.           MVI  AEAFLG,X'80'  ditto                             @SC90173 08452500
  1907.          L     1,RBUF                                                   08453000
  1908.          MVC   0(50,1),0(3)  Put data in RBUF (and some extra) @SC86156 08453500
  1909.          CLI   ERRNUM,ERRTRC Cancelled?                        @SC91172 08454000
  1910.          BNE   ERPCODE       No, message is complete           @SC91172 08454500
  1911.          SR    9,9                                             @SC91172 08455000
  1912.          CLI   REASON,STACNN Within table?                     @SC91172 08455500
  1913.          BH    *+8           No, must be new                   @SC91172 08456000
  1914.           IC   9,REASON      Ok, get the complaint code        @SC91172 08456500
  1915.          SLL   9,3           Index into table                  @SC91172 08457000
  1916.          A     9,=A(STACNTB)                                   @SC91172 08457500
  1917.          LA    3,0(4,1)      Offset to end of message          @SC91172 08458000
  1918.          MVI   0(3),C' '     Leave a space                     @SC91172 08458500
  1919.          MVC   1(8,3),0(9)   Get type of cancellation          @SC91172 08459000
  1920.          LA    4,9(,4)       Lengthen message                  @SC91172 08459500
  1921. ERPCODE  ST    4,RBUFL       Save length to encode             @SC91172 08460000
  1922.          TR    0(50,1),ETOAD ASCII it                          @SC89301 08460500
  1923.          LA    8,F0          Point to null list                @SC89072 08461000
  1924.          BAL   9,ENCODEN                                       @SC86295 08461500
  1925.          KCALL SPACK         Send error packet                 @SC86135 08462000
  1926.          RET                                                            08462500
  1927.          LOCALS ,                                              @SC86295 08463000
  1928. ERPACK   EXIT                                                           08463500
  1929.          TITLE 'SPACK Routine - sends DATA buffer'                      08464000
  1930. SPACK    ENTER                                                          08464500
  1931.          SR    3,3                   Zero out IC register               08465000
  1932.          L     8,AASPKT      SNDPKT address                    @SC86295 08465500
  1933. SPKNX3   LA    8,3(8)        Remove LX1, LX2, HCHECK from hdr  @SC86295 08466000
  1934.          L     9,DATL                Data size                          08466500
  1935.          IC    3,BCTU                CHK len                            08467000
  1936.          LA    9,2(3,9)              Data, CHK, SEQ, TYP lengths        08467500
  1937.          LA    1,3(9)        Plus SOH, LEN, EOL lengths        @SC86202 08468000
  1938.          C     9,AKMAX       Check packet length byte          @SC86202 08468500
  1939.          BNH   SPKNXDL1      No extended data len              @SC86202 08469000
  1940.          LA    1,3(1)        Plus LX1,LX2,HCHECK for ext. hdr  @SC86202 08469500
  1941.          SR    9,9           Set 'Type 0' extended hdr         @SC86202 08470000
  1942.          SH    8,SPKNX3+2    Remove LX1, LX2, HCHECK from hdr  @SC86295 08470500
  1943. SPKNXDL1 ST    1,SNDPKL      SNDPKT length                     @SC86202 08471000
  1944.          ST    8,ASPKT       Ptr to buffer                     @SC86295 08471500
  1945.          MVC   0(1,8),SMARK  Add mark to packet                @SC86295 08472000
  1946.          TOCHR 9,,1(8)       Add it to packet                  @SC86295 08472500
  1947.          TOCHR 4,SEQ,2(8)    Get packet number                 @SC86295 08473000
  1948.          AR    9,4                   And add to checksum                08473500
  1949.          IC    3,STYPE               Type                               08474000
  1950.          STC   3,3(8)        Store in buffer                   @SC86295 08474500
  1951.          AR    9,3                   Add to checksum                    08475000
  1952.          CLI   1(8),ABL      Chk 'Type 0' extended hdr         @SC86295 08475500
  1953.          BNE   SPKNXDL3      No extended data len              @TB86196 08476000
  1954.          L     7,DATL        Data size                         @TB86196 08476500
  1955.          IC    3,BCTU        CHK len                           @TB86196 08477000
  1956.          AR    7,3           Sum = extended length             @TB86196 08477500
  1957.          SR    6,6                                             @TB86196 08478000
  1958.          D     6,XLFCT       Get two parts                     @TB86196 08478500
  1959.          TOCHR 7,,4(8)       Add LENX1 to packet               @SC86295 08479000
  1960.          AR    9,7           And add to checksum               @TB86196 08479500
  1961.          TOCHR 6,,5(8)       Add LENX2 to packet               @SC86295 08480000
  1962.          AR    9,6           And add to checksum               @TB86196 08480500
  1963.          LR    6,9           Chksum thru LENX2 byte            @TB86196 08481000
  1964.          SRL   6,6           High 2 bits of total              @TB86196 08481500
  1965.          N     6,F3          Get just 2 bits                   @SC86295 08482000
  1966.          AR    6,9           Get type-1 check value            @TB86196 08482500
  1967.          N     6,MOD64                                         @TB86196 08483000
  1968.          TOCHR 6,,6(8)       Make printable                    @SC86295 08483500
  1969.          AR    9,6           And add to checksum               @TB86196 08484000
  1970. SPKNXDL3 DS    0H                                              @TB86196 08484500
  1971.          L     8,ASDATA                                        @SC86295 08485000
  1972.          BCTR  8,0           Ptr one before data               @SC86295 08485500
  1973.          ICM   6,B'1111',DATL        Data length                        08486000
  1974.          BZ    SPKCHK                Go if no data                      08486500
  1975.          LR    5,6                                             @SC86135 08487000
  1976. SPKCHAR  IC    3,0(5,8)      Pick up char                      @SC86295 08487500
  1977.          AR    9,3                   Add to checksum                    08488000
  1978.          BCT   5,SPKCHAR     Yes, there's more data            @SC86135 08488500
  1979. SPKCHK   LA    6,1(6,8)      Point to where chksum goes        @SC86295 08489000
  1980.          LR    7,9                   Need copy of chksum                08489500
  1981.          CLI   BCTU,2                                                   08490000
  1982.          BE    SPKCHK2               Go if 2 char chksum                08490500
  1983.          BH    SPKCHK3               Go if 3 char CRC                   08491000
  1984.          SRL   9,6                   High 2 bits of total               08491500
  1985.          N     9,F3          Get just 2 bits                   @SC86295 08492000
  1986.          AR    7,9                   Add the two values                 08492500
  1987.          B     SPKCHK1               Go add chksum to data              08493000
  1988. *                                                                       08493500
  1989. SPKCHK3  L     5,ASPKT                                         @SC86190 08494000
  1990.          LA    5,1(5)        Where checksum starts             @SC86190 08494500
  1991.          KCALL CRCCLC        Calculate the CRC                          08495000
  1992.          LR    7,15                  Keep in here                       08495500
  1993.          SRL   15,12                 High 4 bits of high byte           08496000
  1994.          A     15,BCTOFF     0/1                               @SC92085 08496500
  1995.          TOCHR 15,,0(6)              Make char printable                08497000
  1996.          LA    6,1(6)                Bump output pointer                08497500
  1997. SPKCHK2  LR    15,7                  total                              08498000
  1998.          SRL   15,6          Next 6 bits of total              @SC86295 08498500
  1999.          N     15,MOD64      Get just 6 bits                   @SC86295 08499000
  2000.          A     15,BCTOFF     0/1                               @SC92085 08499500
  2001.          TOCHR 15,,0(6)              Make char printable                08500000
  2002.          LA    6,1(6)                Bump pointer                       08500500
  2003. SPKCHK1  N     7,MOD64               Get low order 6 bits               08501000
  2004.          A     7,BCTOFF      0/1                               @SC92085 08501500
  2005.          TOCHR 7,,0(6)               Make printable                     08502000
  2006. SPKEOL   MVC   1(2,6),S1EOL  Add micro's EOL char + handshake  @SC87274 08502500
  2007.          KCALL SIO           Write the SNDPKT                  @SC86135 08503000
  2008.          RET   ,             Return with SIO's rc              @SC86295 08503500
  2009.          LOCALS ,                                              @SC86295 08504000
  2010. SPACK    EXIT                                                           08504500
  2011.          TITLE 'RPACK Routine - Reads data into DATA buffer'            08505000
  2012. * ERRNUM set if error found, unchanged otherwise               @SC89219 08505500
  2013. RPACK    ENTER                                                          08506000
  2014.          MVI   RPKERN,ERRTIE Error if RIO fails                @SC90289 08506500
  2015. RPKRED   KCALL RIO,E=RPKNAK                                    @SC90106 08507000
  2016.          L     7,RCVPKL              Length of data read                08507500
  2017.          LM    14,15,TINTOT  Update recv count                 @SC86295 08508000
  2018.          ALR   15,7                                            @SC86295 08508500
  2019.          BC    12,*+8                                          @SC88092 08509000
  2020.          AL    14,F1                                           @SC86295 08509500
  2021.          STM   14,15,TINTOT  Save new count                    @SC86295 08510000
  2022.          L     8,APKT        Point to PKT                      @SC86190 08510500
  2023.          C     7,F2          Watch for XON-XOFF pairs          @SC90106 08511000
  2024.          BNE   *+14                                            @SC90106 08511500
  2025.           CLC  0(2,8),=AL1(XON,XOFF)                           @SC90106 08512000
  2026.           BE   RPKRED        Ignore pure flow-control "packet" @SC90106 08512500
  2027.          MVI   RTYPE,AT      In case of time-out               @SC87012 08513000
  2028.          C     7,F1          Time-out signal is ASCII T        @SC87012 08513500
  2029.          BNE   RPKSET                                          @SC90106 08514000
  2030.          CLI   0(8),XOFF                                       @SC90106 08514500
  2031.          BE    RPKRED        Spurious flow-control "packet"    @SC90106 08515000
  2032.          CLI   0(8),AT                                         @SC87012 08515500
  2033.          BE    RTRN          Yes, timed out                    @SC87012 08516000
  2034. RPKSET   DS    0H                                              @SC90106 08516500
  2035.          AR    7,8           Point past last char                       08517000
  2036.          MVI   RPKERN,ERRSOH No start-of-packet found          @SC89219 08517500
  2037.          MVC   RMARKDT,RMARK Copy packet character             @SC93173 08518000
  2038.          CLI   RMARKDT,ABL   Is it a control?                  @SC93173 08518500
  2039.          BL    *+8                                             @SC93173 08519000
  2040.           MVI  RMARKDT,0     Yes, don't check for it in data   @SC93173 08519500
  2041. RPKBEG   SR    3,3                   Use this for IC's                  08520000
  2042.          L     14,ARPKT      Point to recv buffer              @SC89065 08520500
  2043. RPKLOOP  CLC   RMARK,0(8)                                               08521000
  2044.          LA    8,1(8)        Try next character                @SC86135 08521500
  2045.          BE    RPKSOH                Go if a Control-A                  08522000
  2046.          CR    8,7                   Are we within the received pkt?    08522500
  2047.          BL    RPKLOOP               Yes, keep on looking for SOH       08523000
  2048.          B     RPKERR                                          @SC89219 08523500
  2049. *                                                                       08524000
  2050. RPKSOH   LA    9,4(14)       Skip over usual header            @SC86295 08524500
  2051.          MVC   1(3,14),0(8)  Copy usual header to RCVPKT       @SC86295 08525000
  2052.          MVI   RPKERN,ERRBPC SOH found - cksm may be bad       @SC89219 08525500
  2053.          UNCHR 3,0(8)                Length                             08526000
  2054.          BM    RPKBEG        Invalid length, try again         @SC86153 08526500
  2055.          LA    5,ABL(3)              Chksum accumulator                 08527000
  2056.          LR    4,3                   Keep length to compute DATA len    08527500
  2057.          LA    15,0(3,8)             pkt len + beg                      08528000
  2058.          CR    15,7                  Is it within received pkt?         08528500
  2059.          BNL   RPKBEG                too long, look for another SOH     08529000
  2060.          IC    3,2(8)        Pick up packet type               @SC86153 08529500
  2061.          STC   3,RTYPE       Save value here                   @SC86153 08530000
  2062.          NI    RTYPE,X'7F'   Assure conventional ASCII char    @SC88074 08530500
  2063.          AR    5,3           Add to checksum                   @SC86153 08531000
  2064.          BCTR  4,0                   -1 for Seq #                       08531500
  2065.          BCTR  4,0                   -1 for Type                        08532000
  2066.          UNCHR 3,1(8)        Pick up packet number             @SC86153 08532500
  2067.          BM    RPKBEG        Invalid char                      @SC86153 08533000
  2068.          LA    5,ABL(3,5)            Add to checksum                    08533500
  2069.          STC   3,RSN         Received packet number            @SC86135 08534000
  2070.          LA    8,3(8)        Go to putative data               @SC86153 08534500
  2071.          CLI   1(14),ABL     Is this an extended pkt?          @SC86295 08535000
  2072.          BNE   RPKEXT2       No                                @TB86196 08535500
  2073.          LA    15,3(8)       Past LENX1,LENX2,HCHECK           @TB86196 08536000
  2074.          CR    15,7          Is it within rcvd pkt?            @TB86196 08536500
  2075.          BNL   RPKBEG        Too long, try for another SOH     @TB86196 08537000
  2076.          MVC   4(3,14),0(8)  Copy extended pkt hdr             @SC86295 08537500
  2077.          UNCHR 1,0(8)        Pick up LENX1 byte                @TB86196 08538000
  2078.          LA    5,ABL(1,5)    Add to check                      @SC86202 08538500
  2079.          MH    1,XLFCT+2     High digit of size                @SC86202 08539000
  2080.          UNCHR 3,1(8)        Pick up LENX2 byte                @TB86196 08539500
  2081.          LA    5,ABL(3,5)    Add to chksum                     @SC86202 08540000
  2082.          AR    1,3           Total extended pkt size           @TB86196 08540500
  2083.          UNCHR 3,2(8)        Pick up HCHECK byte               @TB86196 08541000
  2084.          LR    6,5           Keep chksum copy here             @TB86196 08541500
  2085.          SRL   6,6           High 2 bits of total              @TB86196 08542000
  2086.          N     6,F3          Get just 2 bits                   @SC86295 08542500
  2087.          AR    6,5           Add the two values                @TB86196 08543000
  2088.          N     6,MOD64       Get low order 6 bits              @TB86196 08543500
  2089.          CR    6,3           Chk computed vs received          @TB86196 08544000
  2090.          BNE   RPKBEG        Err if chksums mismatch           @SC89219 08544500
  2091.          LA    5,ABL(3,5)    Add HCHECK to chksum              @SC86202 08545000
  2092.          LA    8,3(8)        Update input+output ptrs          @SC86202 08545500
  2093.          LA    9,3(9)        Past LX1,LX2,HCHECK               @SC86202 08546000
  2094.          LR    4,1           Save length of data+check         @SC86202 08546500
  2095.          AR    1,8           Expected end of packet            @SC86202 08547000
  2096.          CR    1,7           Is it within pkt?                 @SC86202 08547500
  2097.          BH    RPKBEG        Too long, chk for SOH             @SC86202 08548000
  2098. RPKEXT2  DS    0H                                              @SC86202 08548500
  2099.          IC    3,BCTU        Chksum length                     @SC86202 08549000
  2100.          SR    4,3           Minus chksum length               @SC86202 08549500
  2101.          BM    RPKBEG        Can't have negative data length   @SC86202 08550000
  2102.          ST    4,DATL        Save data length                  @SC86202 08550500
  2103.          ST    9,ARDATA      Save ptr                          @SC86202 08551000
  2104.          LTR   4,4           Any data received?                @SC89219 08551500
  2105.          BZ    RPKCHK                Nope                               08552000
  2106. RPKCHAR  IC    3,0(8)                Get next data char                 08552500
  2107.          STC   3,0(9)                Move it to DATA                    08553000
  2108.          AR    5,3                   Add to checksum                    08553500
  2109.          CLC   RMARKDT,0(8)  Packet char? (disabled if FULL)   @SC93173 08554000
  2110.          BE    RPKBEG        Yes, must be error, start over    @SC93173 08554500
  2111.          LA    8,1(8)                Bump input buffer pointer          08555000
  2112.          LA    9,1(9)                Bump output buffer pointer         08555500
  2113.          BCT   4,RPKCHAR             Decrement amount of input          08556000
  2114. RPKCHK   UNCHR 3,0(8)                Get checksum                       08556500
  2115.          S     3,BCTOFF      0/1                               @SC92085 08557000
  2116.          LR    6,9           CRC calc ends here                @SC86135 08557500
  2117.          LR    4,5                   Keep chksum copy here              08558000
  2118.          CLI   BCTU,2                                                   08558500
  2119.          BE    RPKCHK2               Go if using 2 char chksum          08559000
  2120.          BH    RPKCHK3               Three character CRC                08559500
  2121.          SRL   5,6                   High 2 bits of total               08560000
  2122.          N     5,F3          Get just 2 bits                   @SC86295 08560500
  2123.          AR    4,5                   Add the two values                 08561000
  2124.          B     RPKCHK1               compare it                         08561500
  2125. *                                                                       08562000
  2126. RPKCHK3  LA    5,1(14)       Start of data for CRC             @SC86295 08562500
  2127.          KCALL CRCCLC        Calculate the CRC                          08563000
  2128.          LR    4,15                  Keep computed value here also      08563500
  2129.          SRL   15,12                 High 4 bits of high byte           08564000
  2130.          CR    15,3                  compare computed and received      08564500
  2131.          BNE   RPKBEG        Skip if chksums don't match       @SC89219 08565000
  2132.          LA    8,1(,8)       Ok so far, bump input pointer     @SC90285 08565500
  2133.          UNCHR 3,0(8)                Get next char of checksum          08566000
  2134.          S     3,BCTOFF      0/1                               @SC92085 08566500
  2135. RPKCHK2  LR    15,4                  Get back the CRC                   08567000
  2136.          SRL   15,6          Next 6 bits of total              @SC86295 08567500
  2137.          N     15,MOD64      Get just 6 bits                   @SC86295 08568000
  2138.          CR    15,3                  compare computed and received      08568500
  2139.          BNE   RPKBEG        Skip if chksums don't match       @SC89219 08569000
  2140.          LA    8,1(,8)       Ok so far, bump input pointer     @SC90285 08569500
  2141.          UNCHR 3,0(8)                Get checksum                       08570000
  2142.          S     3,BCTOFF      0/1                               @SC92085 08570500
  2143. RPKCHK1  N     4,MOD64               Get low order 6 bits               08571000
  2144.          CR    4,3                   Compare computed and received      08571500
  2145.          BE    RPKRET                skip if chksums match              08572000
  2146.          TM    FL1,TSTF                                        @SC86295 08572500
  2147.          BO    RPKRET        Just testing, anything goes       @SC86295 08573000
  2148.          CR    8,7                                             @BS86001 08573500
  2149.          BL    RPKBEG        More stuff, see if it's a packet  @BS86001 08574000
  2150. RPKERR   DS    0H                                              @SC89219 08574500
  2151.          LA    8,STOPBUF                                       @SC88074 08575000
  2152.          L     7,RCVPKL                                        @SC88074 08575500
  2153.          AR    7,8           Ptr to packet end in work area    @SC88074 08576000
  2154.          CLC   =X'114040',0(8)  SBA sequence prepended?        @SC91256 08576500
  2155.          BNE   *+8           No, normal                        @SC91256 08577000
  2156.           A    8,F3          Yes, ignore it                    @SC91256 08577500
  2157.          CLC   RMARK,0(8)                                      @SC88074 08578000
  2158.          BE    RPKNAK        Assume bad packet if SOH present  @SC88074 08578500
  2159.          BCTR  7,0                                             @SC88074 08579000
  2160.          IC    0,0(,7)       Look at last character            @SC91032 08579500
  2161.          N     0,LOBIT       (but only 7 bits)                 @SC91032 08580000
  2162.          CLM   0,1,REOL      Is it an EOL?                     @SC91032 08580500
  2163.          BNE   *+6                                             @SC88074 08581000
  2164.           BCTR 7,0           Don't count closing EOL           @SC88074 08581500
  2165.          CLC   =C'STOP',0(8)                                   @SC91032 08582000
  2166.          BE    RPKSTUP       Seems to be EBCDIC already (3270) @SC91032 08582500
  2167.          CLC   =C'stop',0(8)                                   @SC91032 08583000
  2168.          BE    RPKSTUP       Seems to be EBCDIC already (3270) @SC91032 08583500
  2169.          TR    STOPBUF,ATOED                                   @SC89301 08584000
  2170. RPKSTUP  DS    0H                                              @SC91032 08584500
  2171.          TR    STOPBUF,UPCASE                                  @SC88074 08585000
  2172.          CLI   0(8),C'S'                                       @SC88074 08585500
  2173.          BE    *+8                                             @SC88074 08586000
  2174.           LA   8,1(8)        Allow one extra character in front@SC88074 08586500
  2175.          S     7,F3          Back len(STOP) - 1                @SC88074 08587000
  2176.          CR    7,8                                             @SC88074 08587500
  2177.          BNE   RPKNAK        Doesn't match exactly             @SC88074 08588000
  2178.          CLC   =C'STOP',0(8)                                   @SC88074 08588500
  2179.          BE    RPKSTP        Exact match                       @SC88074 08589000
  2180. RPKNAK   MVI   RTYPE,AQ              Return a Q pkt                     08589500
  2181. RPKRET   RET                                                            08590000
  2182. *                                                              @SC88074 08590500
  2183. RPKSTP   OI    FL3,ZPRO      Indicate stopping protocol mode   @SC88074 08591000
  2184.          MVI   ERRNUM,ERRTRC Transfer cancelled, if any        @SC88074 08591500
  2185.          MVI   REASON,0      Reason is "unknown"               @SC92031 08592000
  2186.          MVI   RTYPE,X'FF'   Special packet type for quitting  @SC88074 08592500
  2187.          RET                                                   @SC88074 08593000
  2188.          LOCALS ,                                              @SC86295 08593500
  2189. RMARKDT  DS    C             Packet char or NULL for scanning  @SC93173 08594000
  2190. RPACK    EXIT                                                           08594500
  2191.          TITLE 'CRCCLC Routine - calculates CRC'                        08595000
  2192. * Calculate the CRC and return it in R15.  Expects R5 to point to the   08595500
  2193. * start of the data on which the CRC is calculated, and R6 to the       08596000
  2194. * char after the last one.                                              08596500
  2195. *                                                                       08597000
  2196. CRCCLC   ENTER                                                          08597500
  2197.          SR    15,15                 Initial CRC value is zero          08598000
  2198. CRCLUP   IC    4,0(5)        Get the next character            @SC86295 08598500
  2199.          XR    4,15          XOR char and CRC low byte         @SC86295 08599000
  2200.          LR    7,4                   same as above                      08599500
  2201.          SRL   7,4                   High 4 bits of low byte            08600000
  2202.          N     4,F                   Low 4 bits of low byte             08600500
  2203.          N     7,F           High 4 bits of low byte           @SC86295 08601000
  2204.          ALR   4,4                   Double to get index into table     08601500
  2205.          LH    4,CRCTAB2(4)          CRC for low 4 bits                 08602000
  2206.          ALR   7,7                   Double to get another index        08602500
  2207.          LH    7,CRCTAB1(7)          CRC for high 4 bits                08603000
  2208.          XR    4,7                   XOR the two                        08603500
  2209.          SRL   15,8                  Shift prev CRC 8 bits to right     08604000
  2210.          XR    15,4                  XOR current char's CRC into it     08604500
  2211.          N     15,=XL4'FFFF' Drop negative stuff               @SC86295 08605000
  2212.          LA    5,1(5)                Bump input pointer                 08605500
  2213.          CR    5,6                   Did we reach the end?              08606000
  2214.          BL    CRCLUP                Nope, loop for whole pkt           08606500
  2215. CRCRET   RET                                                            08607000
  2216. * Table to use for CRC calculation                                      08607500
  2217. CRCTAB1  HTBL  00,00,10,81,21,02,31,83,42,04,52,85,63,06,73,87 @SC89268 08608000
  2218.          HTBL  84,08,94,89,A5,0A,B5,8B,C6,0C,D6,8D,E7,0E,F7,8F @SC89268 08608500
  2219. *                                                                       08609000
  2220. CRCTAB2  HTBL  00,00,11,89,23,12,32,9B,46,24,57,AD,65,36,74,BF @SC89268 08609500
  2221.          HTBL  8C,48,9D,C1,AF,5A,BE,D3,CA,6C,DB,E5,E9,7E,F8,F7 @SC89268 08610000
  2222. *                                                                       08610500
  2223.          LOCALS ,                                              @SC86295 08611000
  2224. CRCCLC   EXIT                                                           08611500
  2225.          TITLE 'RIO Routine - Read packet into RCVPKT'                  08612000
  2226. RIO      ENTER                                                          08612500
  2227.          MVI   SIORIO,C'R'   Set type                          @SC86316 08613000
  2228.          L     7,APKT        Ptr to data                       @SC86316 08613500
  2229.          L     15,RIOC       Previous read count               @SC86295 08614000
  2230.          MVI   RIOC,X'80'    Nothing left in read buffer       @SC86295 08614500
  2231. RIOSM0   ICM   0,15,SIMPTR   See if replaying...               @SC91312 08615000
  2232.          BNZ   RIOSIM        Read from canned file             @SC91312 08615500
  2233.          BAL   14,TTYCHK                                       @SC92030 08616000
  2234.           B    RIOTTY        Go if not transparent             @SC92030 08616500
  2235.          SR    4,4           Don't translate for STOP test     @SC91032 08617000
  2236.          LA    5,OFF80       Turn off all X'80' bits           @SC86316 08617500
  2237.          TM    RPRTY,DAT8    Unless 8-bit line                 @SC88288 08618000
  2238.          BZ    *+6           Not 8-bit                         @SC86316 08618500
  2239.          SR    5,5           Yes, use all bits                 @SC86316 08619000
  2240.          LTR   15,15         Any previous?                     @SC86295 08619500
  2241.          BNM   RIOCOM        Yes, use it                       @SC86295 08620000
  2242.          LA    0,4           Write                             @SC86295 08620500
  2243.          KCALL SCRNIO,S1XOPL,E=(RIOER,M) Send a prompt         @SC86295 08621000
  2244. RIOS1R   DS    0H                                              @SC87215 08621500
  2245.          LA    0,5           Read                              @SC86295 08622000
  2246.          KCALL SCRNIO,RIOPTRS,E=(RIOER,M) perform read         @SC90173 08622500
  2247.          BP    RIOCOM                                          @SC86355 08623000
  2248. RIOER    MVI   ERRNUM,ERRTIE Terminal I/O error                @SC86156 08623500
  2249.          B     RTRN1         Error, return to caller           @SC86295 08624000
  2250. *                                                                       08624500
  2251. RIOSIM   L     5,RIOPTRS+4                                     @SC91312 08625000
  2252.          READF SIMPTR,BUFFER=(7),BSIZE=(5),E=RIOSMX            @SC91312 08625500
  2253.          LR    15,0          Save length                       @SC91312 08626000
  2254.          SR    5,5           Assume no translation             @SC91312 08626500
  2255.          CLC   =C'S:',0(7)                                     @SC91312 08627000
  2256.          BE    RIOSIM                                          @SC91312 08627500
  2257.          CLC   =C'R:',0(7)                                     @SC91312 08628000
  2258.          BNE   *+8                                             @SC91312 08628500
  2259.           L    5,AEPTRS+4    It's in EBCDIC, translate it      @SC92352 08629000
  2260.          LR    4,5                                             @SC91312 08629500
  2261.          B     RIOCOM                                          @SC91312 08630000
  2262. *                                                                       08630500
  2263. RIOERR   CLI   WRRD,0        Expecting a reply?                @SC91281 08631000
  2264.          BNE   RIOER         Yes, report the error             @SC91281 08631500
  2265.          B     SIOGOOD       No, ignore it                     @SC91281 08632000
  2266. *                                                                       08632500
  2267. RIOTTY   L     5,AEPTRS+4    Translate to ASCII (ETOA/TETOA)   @SC92352 08633000
  2268.          CLI   TRMTP,C'F'    Full-screen?                      @SC92030 08633500
  2269.          BE    RIOTTY1       Yes, avoid override table         @SC92030 08634000
  2270.          ICM   6,15,KSYSETOA Possible overriding table         @SC88302 08634500
  2271.          BZ    *+6                                             @SC88302 08635000
  2272.           LR   5,6           Use it instead                    @SC88302 08635500
  2273. RIOTTY1  DS    0H                                              @SC92030 08636000
  2274.          LR    4,5           Use same translation for STOP     @SC91032 08636500
  2275.          LTR   15,15         Any previous data?                @SC86295 08637000
  2276.          BNM   RIOCOM        Yes, use it                       @SC86295 08637500
  2277.          LA    0,5           No, read some now                 @SC86295 08638000
  2278.          KCALL TERMIO,RIOPTRS,E=(RIOER,M) perform read         @SC90173 08638500
  2279. RIOCOM   LR    6,15          Copy byte count                   @SC86295 08639000
  2280.          ST    6,RCVPKL      Save                                       08639500
  2281.          MVC   STOPBUF,0(7)  Copy to work area, in case STOP   @SC91032 08640000
  2282.          LTR   4,4           Any translation for STOP test?    @SC91032 08640500
  2283.          BZ    *+10          Don't translate it                @SC91032 08641000
  2284.           TR   STOPBUF,0(4)  Do the translate                  @SC91032 08641500
  2285.          BAL   9,RIORAW      Log raw data                      @SC86316 08642000
  2286.          LR    2,7                                             @SC86316 08642500
  2287.          LR    3,6           Length                            @SC86202 08643000
  2288.          LTR   15,5          Copy table ptr                    @SC86316 08643500
  2289.          BZ    *+8           Don't translate after all         @SC86316 08644000
  2290.          BAL   14,TRANSLAT   Do the translate                  @SC86202 08644500
  2291.          BAL   9,RIOLOG      Write to log                      @SC86190 08645000
  2292.          B     RTRN0                                           @SC86295 08645500
  2293. *  Write record to log buffer, R7->data, R6=length             @SC87286 08646000
  2294. *  Clobbers R0,R1,R2,R3,R8,R14,R15, return to (R9)             @SC87286 08646500
  2295. RIORAW   SR    3,3           Write raw data                    @SC86316 08647000
  2296.          B     RIOLG1                                          @SC86316 08647500
  2297. RIOLOG   L     3,AEPTRS      Write data in EBCDIC (ATOE/TATOE) @SC92352 08648000
  2298. RIOLG1   SR    8,8           Assume raw not wanted             @SC88168 08648500
  2299.          TM    DBGFLG,DBGRW                                    @SC88168 08649000
  2300.          BO    *+8                                             @SC88168 08649500
  2301.          L     8,AEPTRS      Raw wanted                        @SC92352 08650000
  2302.          CR    3,8           Correct type (raw/EBCDIC)?        @SC88168 08650500
  2303.          BNER  9             No, skip this one                 @SC86316 08651000
  2304.          TM    FL1,DEBUG                                       @SC86316 08651500
  2305.          BZR   9             Skip if no debugging              @SC86190 08652000
  2306.          LA    8,2(6)        Two extra for R:, etc.            @SC87286 08652500
  2307.          L     2,LOGBUF      LOG buffer                        @SC86316 08653000
  2308.          MVC   0(1,2),SIORIO Indicate log type                 @SC86316 08653500
  2309.          LA    2,2(2)        Skip over prefix                  @SC86190 08654000
  2310.          LR    0,2           Buffer ptr                        @SC86190 08654500
  2311.          LR    1,8           Data length                       @SC86316 08655000
  2312.          LR    14,7          Data ptr                          @SC86316 08655500
  2313.          LR    15,8                                            @SC86316 08656000
  2314.          MVCL  0,14          Copy to log buffer                @SC86316 08656500
  2315.          LTR   15,3          Check if translation needed       @SC86316 08657000
  2316.          BZ    *+10          No                                @SC86316 08657500
  2317.          LR    3,8           Data length                       @SC86316 08658000
  2318.          BAL   14,TRANSLAT   Do the translate                  @SC86202 08658500
  2319.          WRITF LOGPTR,BSIZE=(8),E=RIOLQU                       @SC87034 08659000
  2320.          TM    DBGFLG,DBGSV  SAVE requested?                   @SC88168 08659500
  2321.          BZR   9             No, skip closing log file         @SC88168 08660000
  2322.          SAVEF LOGPTR        Update disk directory             @SC88168 08660500
  2323.          BR    9             Done                              @SC86190 08661000
  2324. RIOLQU   CLOSF LOGPTR        Turn off DEBUG, it fails          @SC86355 08661500
  2325.          NI    FL1,255-DEBUG                                   @SC86355 08662000
  2326.          BR    9                                               @SC86355 08662500
  2327. *                                                                       08663000
  2328. RIOSMX   CLOSF SIMPTR        Turn off replay -- it failed      @SC91312 08663500
  2329.          B     RIOSM0        Try again for real                @SC91312 08664000
  2330.          TITLE 'SIO Routine - Send packet in SNDPKT'                    08664500
  2331. SIO      ENTER ALT                                             @SC86190 08665000
  2332.          MVI   SIORIO,C'S'   Set type                          @SC86316 08665500
  2333.          MVI   RTYPE,0       Clear previous received packet    @SC88074 08666000
  2334.          MVI   RIOC,X'80'    Set no read count                 @SC86295 08666500
  2335.          L     6,SNDPKL              Length of SNDPKT to be sent        08667000
  2336.          TM    FL4,NPS       Non-protocol?                     @SC86239 08667500
  2337.          BO    SIOPLEN       Yes, no handshake at all          @LP87272 08668000
  2338.          CLI   WRRD,0        Only writing?                     @LP87272 08668500
  2339. *        BE    SIOPLEN       Yes, handshake done next Read     @LP87272 08669000
  2340.          CLI   S1HND,0       Handshake desired at all?         @SC87275 08669500
  2341.          BE    SIOPLEN       No, skip it                       @SC87275 08670000
  2342.          LA    6,1(6)        Allow for handshake character     @LP87272 08670500
  2343. SIOPLEN  DS    0H                                              @SC86239 08671000
  2344.          L     7,ASPKT       Ptr to send data                  @SC86316 08671500
  2345.          BAL   9,RIOLOG      Write to log                      @SC86190 08672000
  2346.          L     2,SIOPTRS     Final output buffer               @SC90173 08672500
  2347.          LR    1,2           Save start                        @SC86154 08673000
  2348.          SR    3,3                                             @SC86154 08673500
  2349.          TM    FL4,NPS       Non-protocol?                     @SC86191 08674000
  2350.          BO    *+8           Yes, skip padding                 @SC86191 08674500
  2351.          IC    3,SPADN       Pad count                         @SC86154 08675000
  2352.          LA    15,7(3,6)     Length of pad+data                @SC92030 08675500
  2353.          STCM  15,3,AEABUFL  Set length of OEM data struct fld @SC90173 08676000
  2354.          LM    4,5,WRCMD     Adr,len of I/O command stuff      @SC90173 08676500
  2355.          AR    3,5           Total padding + Series/1          @SC86154 08677000
  2356.          LA    9,0(5,2)      Save start of ASCII stuff         @SC88288 08677500
  2357.          ICM   5,8,SPADC     Get padding character             @SC86154 08678000
  2358.          MVCL  2,4           Copy to buffer with padding       @SC86154 08678500
  2359.          LR    3,6           Packet length                     @SC86154 08679000
  2360.          LR    5,6                                             @SC86154 08679500
  2361.          LR    4,7           Ptr to packet                     @SC86316 08680000
  2362.          MVCL  2,4           Copy packet to buffer             @SC86154 08680500
  2363.          LR    3,2           Copy end of transmission          @SC90173 08681000
  2364.          SR    2,1           Total length                      @SC90173 08681500
  2365.          ST    2,SIOPTRS+4   Store len in CCW                  @SC90173 08682000
  2366.          LR    2,9           Start of ASCII stuff              @SC88288 08682500
  2367.          SR    3,2           Length                            @SC88288 08683000
  2368.          BAL   14,TTYCHK                                       @SC92030 08683500
  2369.           B    SIOTTY        Go if not transparent             @SC92030 08684000
  2370.          LA    15,ON80       Set high bits                     @SC88288 08684500
  2371.          TM    SPRTY,DAT8    Unless 8-bit line                 @SC88288 08685000
  2372.          BO    *+8           Yes, 8-bit downloading            @SC88288 08685500
  2373.           BAL  14,TRANSLAT                                     @SC88288 08686000
  2374.          L     4,=A(SCRNIO)  I/O routine for fullscreen        @SC89215 08686500
  2375. SIOGO    LM    7,8,SIOPTRS                                     @SC90173 08687000
  2376.          LM    14,15,TOUTOT  Update send count                 @SC88006 08687500
  2377.          ALR   15,8                                            @SC88006 08688000
  2378.          BC    12,*+8                                          @SC88092 08688500
  2379.          AL    14,F1                                           @SC88006 08689000
  2380.          STM   14,15,TOUTOT  Save new count                    @SC88006 08689500
  2381.          LR    6,8           Set up for log routine            @SC88168 08690000
  2382.          BAL   9,RIORAW      Log it                            @SC86316 08690500
  2383.          NI    FL5,255-NAK0  Something sent now                @SC90037 08691000
  2384.          ICM   0,15,SIMPTR                                     @SC91312 08691500
  2385.          BNZ   RTRN0         Replaying, suppress packet I/O    @SC91312 08692000
  2386.          LA    0,4           Write                             @SC86295 08692500
  2387.          KCALL (4),SIOPTRS,E=(RIOER,M)                         @SC90173 08693000
  2388.          CLI   TRMTP,C'S'    S/1?                              @SC90173 08693500
  2389.          BE    *+12                                            @SC90173 08694000
  2390.           CLI  WRRD,0        Only writing?                     @SC90173 08694500
  2391.           BE   SIOGOOD       Yes, expect no answer             @SC90173 08695000
  2392.          LA    0,5                                             @SC86295 08695500
  2393.          KCALL (4),RIOPTRS,E=(RIOER,M)  Read it now            @SC90173 08696000
  2394.          CLI   WRRD,0        Write/read?                       @SC86301 08696500
  2395.          BE    SIOGOOD       No, ignore bare status            @SC86301 08697000
  2396.          LTR   15,15                                           @TB87009 08697500
  2397.          BP    SIOCOM                                          @TB87009 08698000
  2398.          CLI   TRMTP,C'S'    S/1?                              @SC90173 08698500
  2399.          BNE   SIOCOM        No problem                        @SC90173 08699000
  2400. * If only 3 bytes (AID and cursor) come in, VTAM has caused    @TB87009 08699500
  2401. * the S/1 to discard its transparent data. Fill the screen and @TB87009 08700000
  2402. * read it back in protocol conversion mode to cause VTAM       @TB87009 08700500
  2403. * to put up a longer READ MODIFIED CCW at its next read.       @TB87009 08701000
  2404.          LA    0,6           Message (Leave Transparent Mode)  @TB87009 08701500
  2405.          KCALL SCRNIO,SIORTPL,E=(SIORTY,M)                     @TB87009 08702000
  2406.          LA    0,5                                             @TB87009 08702500
  2407.          KCALL SCRNIO,RIOPTRS,E=(RIOER,M) Rdmod to prime VTAM. @SC90173 08703000
  2408.          L     14,RIOPTRS    Input buffer                      @SC91039 08703500
  2409.          CLC   SIOMSGT,3(14) Is it what we just wrote?         @SC91039 08704000
  2410.          BNE   SIOCOM        No, maybe it's real               @SC91039 08704500
  2411. SIORTY   SR    15,15         No data actually seen.            @TB87009 08705000
  2412. SIOCOM   DS    0H                                              @TB87009 08705500
  2413.          ST    15,RIOC               save residual byte count           08706000
  2414. SIOGOOD  DS    0H                                              @SC88100 08706500
  2415.          B     RTRN0                                           @SC86295 08707000
  2416. *                                                                       08707500
  2417. SIOTTY   DS    0H                                              @SC90173 08708000
  2418.          CLI   TRMTP,C'F'    Full-screen?                      @SC92030 08708500
  2419.          BE    SIOTTY1       Yes, avoid override table         @SC92030 08709000
  2420.          ICM   15,15,KSYSATOE Possible overriding table        @SC88302 08709500
  2421.          BNZ   SIOTRNT                                         @SC88302 08710000
  2422. SIOTTY1  DS    0H                                              @SC92030 08710500
  2423.          L     15,AEPTRS     Send in EBCDIC (ATOE/TATOE)       @SC92352 08711000
  2424. SIOTRNT  DS    0H                                              @SC88302 08711500
  2425.          BAL   14,TRANSLAT   Do the translate                  @SC86202 08712000
  2426.          L     4,=A(TERMIO)  I/O routine for TTY               @SC89215 08712500
  2427.          B     SIOGO         Now do it                         @SC87275 08713000
  2428. *                                                              @TB87009 08713500
  2429. SIORTPL  DC    A(SIOMSGXX,SIOMSL)                              @TB87009 08714000
  2430. * Greetings for ERROR mode                                     @TB87009 08714500
  2431. SIOMSGXX DC    &S1CMD,AL1(SBA),X'4040'                         @SC90264 08715000
  2432. SIOMSGT  DC    C'&VTAMERR'                                     @TB87009 08715500
  2433.          DC    AL1(RTA),X'4040',C' '  Blanks to end of screen  @SC88139 08716000
  2434. SIOMSL   EQU   *-SIOMSGXX                                      @TB87009 08716500
  2435. * For setting high bits...                                     @SC88288 08717000
  2436. ON80     DC    X'808182838485868788898A8B8C8D8E8F'             @SC88288 08717500
  2437.          DC    X'909192939495969798999A9B9C9D9E9F'             @SC88288 08718000
  2438.          DC    X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'             @SC88288 08718500
  2439.          DC    X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'             @SC88288 08719000
  2440.          DC    X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'             @SC88288 08719500
  2441.          DC    X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'             @SC88288 08720000
  2442.          DC    X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'             @SC88288 08720500
  2443.          DC    X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'             @SC88288 08721000
  2444.          DC    X'808182838485868788898A8B8C8D8E8F'             @SC88288 08721500
  2445.          DC    X'909192939495969798999A9B9C9D9E9F'             @SC88288 08722000
  2446.          DC    X'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'             @SC88288 08722500
  2447.          DC    X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'             @SC88288 08723000
  2448.          DC    X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'             @SC88288 08723500
  2449.          DC    X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'             @SC88288 08724000
  2450.          DC    X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'             @SC88288 08724500
  2451.          DC    X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'             @SC88288 08725000
  2452.          LOCALS ,                                              @SC86295 08725500
  2453. SIORIO   DS    C             Operation code                    @SC86316 08726000
  2454. SIO      EXIT                                                           08726500
  2455.          TITLE 'INTINI Routine - Initialize console for protocol'       08727000
  2456. * If R1 is 0, reset the traps unless in Server mode.                    08727500
  2457. * If R1 is positive, set up console traps for protocol:                 08728000
  2458. *  1 for SERVER, 2 for SEND, 3 for RECEIVE, 4 for short msg    @SC86184 08728500
  2459. * R15 = 0 on return if ok                                               08729000
  2460. *                                                                       08729500
  2461. INTINI   ENTER                                                          08730000
  2462.          TM    FL2,SRV                                                  08730500
  2463.          BO    INTINIR               Return if server running           08731000
  2464.          LTR   3,1           Call type: 0 or 1-5               @HF86232 08731500
  2465.          BZ    INTINICL              If R1 is 0 clear traps             08732000
  2466.          MVI   WRRD,5        Reset w/r flag                    @SC91352 08732500
  2467.          MVI   AEAFLG,0      ditto for AEA                     @SC91352 08733000
  2468.          CLI   TRMTP,C'N'    Controller = NONE?                @SC90173 08733500
  2469.          BE    INTINERR      If so, give up right away         @SC90173 08734000
  2470.          CLI   TRMTP,C'F'    Full-screen non-transparent?      @SC92030 08734500
  2471.          BNE   *+12          No, we're ok                      @SC92030 08735000
  2472.           CLI  SMARK,ABL     Yes, see if printable SOP         @SC92030 08735500
  2473.           BL   INTINBAD      No, give up right away            @SC92030 08736000
  2474.          OI    FL2,PROTO     Line open for transfer            @SC86295 08736500
  2475.          MVI   RTYPE,AN      No packet received yet            @SC89263 08737000
  2476.          ICM   5,15,LCLDLY   No delay?                         @HF86232 08737500
  2477.          BNZ   INTINIDL                                        @HF86232 08738000
  2478.          LA    1,5           Yes, use no message               @HF86232 08738500
  2479. INTINIDL C     1,F5          No delay or non-protocol send?    @HF86232 08739000
  2480.          BE    INTINIMS      Yes                               @HF86232 08739500
  2481.          BCT   5,INTINIMS    Short delay?                      @HF86232 08740000
  2482.          LA    1,4           Yes, use short message anyway     @SC86184 08740500
  2483. INTINIMS SLL   1,3           8-byte indexing                   @HF86232 08741000
  2484.          LA    5,INTCCWSR-8(1)  Get ptr to correct CCW         @SC86184 08741500
  2485.          MVC   SVHND,S1HND   Save handshake character          @SC87343 08742000
  2486.          KCALL SETMSG,2,E=INTINERR Prepare line for transfer   @SC87300 08742500
  2487.          LA    0,2                                             @SC87309 08743000
  2488.          SR    0,3                                             @SC87309 08743500
  2489.          LPR   0,0           Get ABS(code-2)                   @SC87309 08744000
  2490.          BCT   0,*+8         Test for Serve or Rec codes (1,3) @SC87309 08744500
  2491.          OI    FL5,NAK0      Send NAK during retry, if any     @SC90037 08745000
  2492.          MVI   RIOC,X'80'    Clr any prev byte count           @SC86295 08745500
  2493.          LA    6,S1DATA      Series/1 stuff                    @SC90173 08746000
  2494.          LA    7,S1ORDL      Length of Series/1 stuff          @SC90173 08746500
  2495.          LA    8,3           Expect AID + cursor adr           @SC90173 08747000
  2496.          CLI   TRMTP,C'S'                                      @SC90173 08747500
  2497.          BE    INTSSIOC                                        @SC90173 08748000
  2498.          LA    6,GRDATA      Graphics stuff                    @SC90173 08748500
  2499.          LA    7,GRDL                                          @SC90173 08749000
  2500.          CLI   TRMTP,C'G'                                      @SC90173 08749500
  2501.          BE    INTSSIOC                                        @SC90173 08750000
  2502.          LA    6,AEADAT      AEA stuff                         @SC90173 08750500
  2503.          LA    7,AEAL                                          @SC90173 08751000
  2504.          LA    8,16          Expect AID + WSF stuff            @SC90173 08751500
  2505.          CLI   TRMTP,C'A'                                      @SC90173 08752000
  2506.          BE    INTSSIOC                                        @SC90173 08752500
  2507.          SR    7,7           Nothing for TTY-mode              @SC90173 08753000
  2508.          SR    8,8                                             @SC90173 08753500
  2509.          CLI   TRMTP,C'F'                                      @SC92030 08754000
  2510.          BNE   INTSSIOC                                        @SC92030 08754500
  2511.          LA    8,FSRDOF      Depends on system                 @SC92030 08755000
  2512. INTSSIOC STM   6,8,WRCMD     Save ptrs for fullscreen I/O cmds @SC90173 08755500
  2513.          A     8,RIOPTRS     Get ptr to start of data          @SC90173 08756000
  2514.          ST    8,APKT                                          @SC90173 08756500
  2515.          BAL   14,TTYCHK                                       @SC92030 08757000
  2516.           B    INTINITY      Go if TTY                         @SC92030 08757500
  2517.          LA    0,1           Open screen                       @SC86295 08758000
  2518.          KCALL SCRNIO                                          @SC86295 08758500
  2519.          LA    0,6           Simple write                      @SC86316 08759000
  2520.          KCALL SCRNIO,(5),E=(INTINIR,M)  Message               @SC86295 08759500
  2521.          C     3,F2          Was this SEND?                    @SC86184 08760000
  2522.          BE    INTINIR               SEND does sleep anyway             08760500
  2523.          ICM   0,15,LCLDLY   See if speed wanted               @SC87253 08761000
  2524.          BZ    INTINIP       Yes, no greetings anyway          @SC87309 08761500
  2525.          LA    0,1           Wait 1 sec                        @SC86295 08762000
  2526.          KCALL SUPFNC,9      This seems essential              @SC86295 08762500
  2527. INTINIP  DS    0H                                              @SC90173 08763000
  2528.          B     INTINIR                                                  08763500
  2529. *                                                                       08764000
  2530. INTINITY L     1,0(5)        Text address from ccw             @SC86184 08764500
  2531.          LH    4,6(5)        Get total length                  @SC86184 08765000
  2532.          LA    3,INTPRL(1)   Skip over WCC and SBA             @SC86184 08765500
  2533.          SH    4,*-2          and deduct that from length      @SC86184 08766000
  2534.          SR    0,0                                             @SC92030 08766500
  2535.          KCALL SCRNIO        Clear screen if FULLSCREEN        @SC92030 08767000
  2536.          LA    6,80                                            @SC92161 08767500
  2537. INTINIT1 CR    4,6                                             @SC92161 08768000
  2538.          BNH   INTINIT2      Just one line left                @SC92161 08768500
  2539.          WTEXT (3),(6)       Write out one line                @SC92161 08769000
  2540.          AR    3,6           Point to next line                @SC92161 08769500
  2541.          SR    4,6           Adjust length remaining           @SC92161 08770000
  2542.          B     INTINIT1                                        @SC92161 08770500
  2543. INTINIT2 WTEXT (3),(4)                                         @SC86184 08771000
  2544.          WTEXT =X'24',1      SNA Inhibit Presentation          @2L90270 08771500
  2545.          LA    0,1                                             @SC86295 08772000
  2546.          KCALL TERMIO        Open line                         @SC86295 08772500
  2547.          B     INTINIR                                                  08773000
  2548. *                                                                       08773500
  2549. INTINICL NI    FL3,255-ZPRO  Now stopping protocol mode        @SC88074 08774000
  2550.          TM    FL2,PROTO     Was line open?                    @SC88074 08774500
  2551.          BZ    INTINIR       No                                @SC86295 08775000
  2552.          CLI   TRMTP,C'A'    Special treatment of AEA here     @SC91352 08775500
  2553.          BNE   INTINICM      Not needed                        @SC91352 08776000
  2554.          CLI   AEAFLG,X'80'  Transparency suppressed yet?      @SC91352 08776500
  2555.          BE    INTINICM      Yes, all set                      @SC91352 08777000
  2556.          MVI   AEAFLG,X'80'  No, must do it now                @SC91352 08777500
  2557.          MVI   WRRD,0        (just for completeness)           @SC91352 08778000
  2558.          MVI   WRCMD+7,AEADOL Set up plist for WSF             @SC91352 08778500
  2559.          LA    0,4           Write                             @SC91352 08779000
  2560.          KCALL SCRNIO,WRCMD  Send just the D/O field           @SC91352 08779500
  2561. INTINICM DS    0H                                              @SC91352 08780000
  2562.          LA    0,2                                             @SC86295 08780500
  2563.          L     15,=A(SCRNIO)                                   @SC89215 08781000
  2564.          BAL   14,TTYCHK                                       @SC92030 08781500
  2565.           L    15,=A(TERMIO) TTY mode                          @SC92030 08782000
  2566. INTINIK  KCALL (15)          Release line                      @SC87300 08782500
  2567.          KCALL SETMSG,3                                        @SC86316 08783000
  2568.          MVC   S1HND,SVHND   Restore handshake character       @SC87343 08783500
  2569.          NI    FL2,255-PROTO End protocol mode                 @SC88035 08784000
  2570.          CLI   TRMTP,C'T'                                      @2L90270 08784500
  2571.          BE    *+12          Go if TTY                         @2L90270 08785000
  2572.           CLI  TRMTP,C'V'                                      @2L90270 08785500
  2573.           BNE  INTINIR       Go if VTAM TTY                    @2L90270 08786000
  2574.          WTEXT =X'14',1      SNA Enable Presentation           @2L90270 08786500
  2575. INTINIR  B     RTRN0                                           @SC87300 08787000
  2576. *                                                                       08787500
  2577. INTINBAD WTEXT '&UNPRSOP'                                      @SC92030 08788000
  2578. INTINERR NI    FL2,255-PROTO Turn off protocol mode            @SC87300 08788500
  2579.          MVI   ERRNUM,ERRCOM Bad comm line                     @SC87300 08789000
  2580.          B     RTRN1                                           @SC87300 08789500
  2581. *                                                                       08790000
  2582.          DS    0D                                                       08790500
  2583. INTCCWSR DC    A(INTMSGSR,INTPRL+80+80+80)                     @SC92161 08791000
  2584. INTCCWSN DC    A(INTMSGSN,INTPRL+80+80+80)                     @SC92161 08791500
  2585. INTCCWRC DC    A(INTMSGRC,INTPRL+80+80+80)                     @SC92161 08792000
  2586. INTCCWQU DC    A(INTMSGQU,INTQL)                               @SC86295 08792500
  2587. INTCCWNL DC    A(INTMSGQU,INTPRL+1)    Send the blank, too     @SC92072 08793000
  2588. * Short greetings                                              @SC86184 08793500
  2589. INTMSGQU DC    &S1CMD,AL1(SBA),X'4040'                         @SC90264 08794000
  2590. INTPRL   EQU   *-INTMSGQU    Length of prefix                  @SC86295 08794500
  2591. INTMSGQ2 DC    C' Kermit-&KSYS....'                            @SC92072 08795000
  2592. INTQL    EQU   *-INTMSGQU                                      @SC86184 08795500
  2593. * Greetings for RECEIVE mode                                            08796000
  2594. INTMSGRC DC    &S1CMD,AL1(SBA),X'4040'                         @SC90264 08796500
  2595.          DC    CL80'Kermit-&KSYS &READYR'                      @SC92300 08797000
  2596.          DC    CL80'&PLSESCP.&TOSEND'                          @SC92300 08797500
  2597.  DC CL80'KERMIT READY TO RECEIVE...'                           @SC92161 08798000
  2598. * Greetings for SEND mode                                               08798500
  2599. INTMSGSN DC    &S1CMD,AL1(SBA),X'4040'                         @SC90264 08799000
  2600.          DC    CL80'Kermit-&KSYS &READYS'                      @SC92300 08799500
  2601.          DC    CL80'&PLSESCP.&TORECV'                          @SC92300 08800000
  2602.  DC CL80'KERMIT READY TO SEND...'                              @SC92161 08800500
  2603. * Greetings for SERVER mode                                             08801000
  2604. INTMSGSR DC    &S1CMD,AL1(SBA),X'4040'                         @SC90264 08801500
  2605.          DC    CL80'Kermit-&KSYS &READYSR &PLSESCP..'          @SC92300 08802000
  2606.          DC    CL80'&ENDSRV &AAAABYE &ZZZZOR &AAAAFIN..'       @SC92300 08802500
  2607.  DC CL80'KERMIT READY TO SERVE...'                             @SC92161 08803000
  2608. *                                                                       08803500
  2609.          LOCALS ,                                              @SC86295 08804000
  2610. INTINI   EXIT                                                           08804500
  2611.          TITLE 'INBUF Routine - read next disk record into WBUF'        08805000
  2612. * Exit: R15=0 if ok, -1 if EOF, 1 if read error (ERRNUM set)            08805500
  2613. INBUF    ENTER                                                          08806000
  2614.          WEAKX KJETOA                                          @SC91325 08806500
  2615.          TM    FL1,EOF                                                  08807000
  2616.          BO    RTRNM1        Go if hit eof already             @SC86295 08807500
  2617.          SR    15,15         In case reading from memory       @SC86158 08808000
  2618.          ST    15,RBUFP      Clear read buffer pointer         @SC86158 08808500
  2619.          ST    15,RBUFL      Clear read buffer length          @SC86158 08809000
  2620.          L     9,RBUF        Read into this buffer             @SC86158 08809500
  2621.          TM    FL4,SFM       Source is memory?                 @SC86158 08810000
  2622.          BZ    IBFDSK        No, read disk                     @SC86158 08810500
  2623.          LM    4,5,TXTPTR    Yes, copy to buffer               @SC86158 08811000
  2624.          CR    4,5           Any left?                         @SC86158 08811500
  2625.          BNL   IBFEOF        No, quit                          @SC86158 08812000
  2626.          XC    CMD,CMD                                         @SC86158 08812500
  2627.          MVI   CMD+X'15',1   Set up TRT                        @SC86158 08813000
  2628.          MVC   0(256,9),0(4) Copy one line or so               @SC86158 08813500
  2629.          LA    1,256(4)      In case no NL                     @SC86158 08814000
  2630.          TRT   0(256,4),CMD  Scan for NL                       @SC86158 08814500
  2631.          CR    1,5           No X'15'?                         @SC86158 08815000
  2632.          BNH   *+6           OK                                @SC86158 08815500
  2633.          LR    1,5           Limit is end of data              @SC86158 08816000
  2634.          SR    1,4           Length of line                    @SC86158 08816500
  2635.          LA    4,1(1,4)                                        @SC86158 08817000
  2636.          ST    4,TXTPTR      Update ptr                        @SC86158 08817500
  2637.          LR    0,1           Save length                       @SC86158 08818000
  2638.          B     IBFXLAT       Go change to ASCII                @SC86158 08818500
  2639. IBFDSK   DS    0H                                              @SC86158 08819000
  2640.          ICM   1,15,FLNOPTS  Get record counter                @SC89218 08819500
  2641.          AL    1,F1                                            @SC89218 08820000
  2642.          STCM  1,15,FLNOPTS  Update record counter             @SC89218 08820500
  2643.          CLM   1,15,FLNOPTS+4 Passed end?                      @SC89218 08821000
  2644.          BH    IBFEOF        Yes, quit now                     @SC89218 08821500
  2645.          ICM   2,15,RDWLEN   Special format?                   @SC86151 08822000
  2646.          AR    9,2           Space over record descriptor      @SC86151 08822500
  2647.          READF FILPTR,BUFFER=(9),E=IBFERR                      @SC87034 08823000
  2648.          LM    14,15,DSKTOT  Update disk count                 @SC86295 08823500
  2649.          ALR   15,0                                            @SC86295 08824000
  2650.          BC    12,*+8                                          @SC88092 08824500
  2651.          AL    14,F1                                           @SC86295 08825000
  2652.          STM   14,15,DSKTOT  Save new count                    @SC86295 08825500
  2653.          LTR   2,2           Special format?                   @SC86151 08826000
  2654.          BZ    IBFNRM        No                                @SC86151 08826500
  2655.          SR    9,2           Back up to start of buffer        @SC86151 08827000
  2656.          STCM  0,3,0(9)      Store length                      @SC86151 08827500
  2657.          C     2,F2          Short?                            @SC86262 08828000
  2658.          BE    IBFVLEN       Yes                               @SC86262 08828500
  2659.          CVD   0,TMPDW       No, use 5-byte ASCII              @SC86262 08829000
  2660.          OI    TMPDW+7,15                                      @SC86262 08829500
  2661.          UNPK  0(5,9),TMPDW                                    @SC86262 08830000
  2662.          TR    0(5,9),ETOAD                                    @SC89301 08830500
  2663. IBFVLEN  DS    0H                                              @SC86262 08831000
  2664.          AR    0,2                                             @SC86151 08831500
  2665.          B     IBFLEN        Must be binary                    @SC86151 08832000
  2666. IBFNRM   DS    0H                                              @SC86151 08832500
  2667.          TM    FL1,BINF                                                 08833000
  2668.          BO    IBFLEN                No trans for binary file           08833500
  2669.          ICM   1,15,RMARG    Text file: check margins          @SC87253 08834000
  2670.          BZ    IBFCKLM       No right margin specified         @SC87253 08834500
  2671.          CR    0,1                                             @SC87253 08835000
  2672.          BNH   IBFCKLM       Record is shorter than margin     @SC87253 08835500
  2673.          LR    0,1           Truncate record at margin         @SC87253 08836000
  2674. IBFCKLM  L     1,LMARG                                         @SC87253 08836500
  2675.          S     1,F1                                            @SC87253 08837000
  2676.          BNP   IBFXLAT       No left margin, or start in col 1 @SC87253 08837500
  2677.          TM    FLNFLGS,FLNCC                                   @SC91116 08838000
  2678.          BO    IBFXLAT       Can't use left margin if CC       @SC91116 08838500
  2679.          SR    0,1           See if record is long enough      @SC87253 08839000
  2680.          BNP   IBFEMPT       Too short, make empty record      @SC87253 08839500
  2681.          LR    2,9           Ptr to record                     @SC87253 08840000
  2682.          LR    3,0           Shortened length                  @SC87253 08840500
  2683.          LA    4,0(1,2)                                        @SC87253 08841000
  2684.          LR    5,3                                             @SC87253 08841500
  2685.          MVCL  2,4           Eliminate stuff before margin     @SC87253 08842000
  2686. IBFXLAT  LA    15,ETOA       Change to ASCII                   @SC86202 08842500
  2687.          MVC   IBFC1+1(1),0(9) Save column 1 as EBCDIC         @SC91116 08843000
  2688.          LR    2,9           Address                           @SC86202 08843500
  2689.          LR    3,0           Length                            @SC86202 08844000
  2690.          CLC   =CL(LALF)'&JAPNEUC',TRNALF                      @SC91325 08844500
  2691.          BNE   IBFXLA1       Normal translation                @SC91325 08845000
  2692.          ICM   14,15,=A(KJETOA) See if 2-byte Kanji present    @SC91325 08845500
  2693.          BZ    IBFXLA1       No, that could be a disaster      @SC91325 08846000
  2694.          KCALL (14),E=(IBFTRNX,M) Yes, call the routine        @SC91325 08846500
  2695.          LR    0,15          Get new length of buffer          @SC91325 08847000
  2696.          B     IBFXLA2       Done translating                  @SC91325 08847500
  2697. IBFXLA1  DS    0H                                              @SC91325 08848000
  2698.          BAL   14,TRANSLAT   Do the translate                  @SC86202 08848500
  2699. IBFXLA2  DS    0H                                              @SC91325 08849000
  2700.          AR    9,0           Point one past last char                   08849500
  2701.          C     0,F1                                            @SC88340 08850000
  2702.          BE    IBFTRUNC      Record of 1 blank always converted@SC88340 08850500
  2703.          CLI   FRECF,C'F'                                      @SC88050 08851000
  2704.          BE    IBFTRUNC      Always trim if fixed length       @SC88349 08851500
  2705.          CLC   RMARG,F0                                        @SC88349 08852000
  2706.          BE    IBFTRUZ       Don't trim if no fixed rt. margin @SC88349 08852500
  2707. IBFTRUNC BCTR  9,0                   Back up one                        08853000
  2708.          CLI   0(9),ABL                                                 08853500
  2709.          BNE   IBFLCHAR              Found non-blank                    08854000
  2710.          BCT   0,IBFTRUNC            FIND LAST CHAR                     08854500
  2711. IBFEMPT  SR    0,0           Record is empty                   @SC87253 08855000
  2712. IBFTRUZ  BCTR  9,0           Point to last char of record      @SC88050 08855500
  2713. IBFLCHAR MVI   1(9),CR       Add CR                            @SC86135 08856000
  2714.          A     0,F1          Count up for CR                   @SC91116 08856500
  2715.          TM    FLNFLGS,FLNCC                                   @SC91116 08857000
  2716.          BO    IBFCC         Save LF for later                 @SC91116 08857500
  2717.          MVI   2(9),ALF      Add LF                            @SC86135 08858000
  2718.          A     0,F1          Count up for LF                   @SC91116 08858500
  2719. IBFLEN   ST    0,RBUFL               LRECL or LRECL + 2 (FOR CRLF)      08859000
  2720.          B     RTRN0                                                    08859500
  2721. *                                                                       08860000
  2722. IBFCC    L     1,RBUF        Start of buffer                   @SC91116 08860500
  2723.          LH    2,IBFC1                                         @SC91116 08861000
  2724.          IC    2,IBFCCTB(2)  Determine proper format character @SC91116 08861500
  2725.          CLI   CARCTL,0      Just beginning file?              @SC91116 08862000
  2726.          BE    *+8           Yes, suppress initial FF or LF    @SC91116 08862500
  2727.           STC  2,CARCTL      No, remember what to insert       @SC91116 08863000
  2728.          MVI   0(1),ALF      Usually substitute plain LF       @SC91116 08863500
  2729.          CLM   2,1,*+9                                         @SC91116 08864000
  2730.          BNE   *+8                                             @SC91116 08864500
  2731.           MVI  0(1),AFF      Page requires FF                  @SC91116 08865000
  2732.          B     IBFLEN                                          @SC91116 08865500
  2733. *                                                                       08866000
  2734. IBFEOF   OI    FL1,EOF                                                  08866500
  2735.          B     RTRNM1                                          @SC86295 08867000
  2736. *                                                                       08867500
  2737. IBFTRNX  L     1,FILPTR      Ptr to disk FAB                   @SC91325 08868000
  2738.          MVC   FABCOMM-FABD(8,1),=CL8'Xlate'                   @SC91325 08868500
  2739.          LA    15,999        Weird error code                  @SC91325 08869000
  2740. IBFERR   C     15,F12                EOF code?                          08869500
  2741.          BE    IBFEOF                Yes                                08870000
  2742.          ERRF  ,             Disk read error, analyze it       @SC87338 08870500
  2743.          CLOSF FILPTR        Close file                        @SC86295 08871000
  2744.          B     RTRN1                                           @SC86295 08871500
  2745. *                                                                       08872000
  2746. * Table of codes for combined ASA and machine carriage ctrl    @SC91116 08872500
  2747. * 0-3 => advance "n" lines, 12 => form feed                    @SC91116 08873000
  2748. IBFCCTB  DC    AL1(1,0),(X'13'-X'02')AL1(1),AL1(2)             @SC91116 08873500
  2749.          DC    (X'1B'-X'14')AL1(1),AL1(3)                      @SC91116 08874000
  2750.          DC    (X'4E'-X'1C')AL1(1),AL1(0)   '+'                @SC91116 08874500
  2751.          DC    (X'60'-X'4F')AL1(1),AL1(3)   '-'                @SC91116 08875000
  2752.          DC    (X'8B'-X'61')AL1(1),AL1(AFF)                    @SC91116 08875500
  2753.          DC    (C'0'-X'8C')AL1(1),AL1(2,AFF),14AL1(1)  '0,1'   @SC91116 08876000
  2754.          LOCALS ,                                              @SC86295 08876500
  2755. IBFC1    DS    H             Index into CCTB                   @SC91116 08877000
  2756. INBUF    EXIT                                                           08877500
  2757.          TITLE 'OUTBUF Routine - write WBUF to a disk file'             08878000
  2758. * Entry: R1=length of buffer (which starts where WBUF points)           08878500
  2759. * Exit: R15=0 if ok, other if error (ERRNUM set)                        08879000
  2760. OUTBUF   ENTER                                                          08879500
  2761.          WEAKX KJATOE                                          @SC91325 08880000
  2762.          LR    9,1           Save buffer length                @SC88120 08880500
  2763.          L     6,FSIZE       Use to hold lrecl                 @SC88120 08881000
  2764.          L     7,WBUF                Address of buffer                  08881500
  2765.          ICM   2,15,RDWLEN                                     @SC86151 08882000
  2766.          BZ    OBFNRM                                          @SC86151 08882500
  2767.          SR    1,1           Special format                    @SC86151 08883000
  2768.          ICM   1,3,0(7)      Get true record length            @SC86151 08883500
  2769.          C     2,F2          Short?                            @SC86262 08884000
  2770.          BE    OBFVLEN       Yes                               @SC86262 08884500
  2771.          PACK  TMPDW,0(5,7)  No, must be 5-byte ASCII          @SC86262 08885000
  2772.          OI    TMPDW+7,15    Get + sign                        @SC86262 08885500
  2773.          CVB   1,TMPDW       Convert back to binary            @SC86262 08886000
  2774. OBFVLEN  DS    0H                                              @SC86262 08886500
  2775.          AR    7,2           Skip over descriptor              @SC86151 08887000
  2776.          SR    9,2           Correct length                    @SC86151 08887500
  2777.          LA    15,15         Suitable disk error               @SC86151 08888000
  2778.          CR    1,9           Match?                            @SC86151 08888500
  2779.          BE    OBFLEN        Ok, do it                         @SC88053 08889000
  2780.          L     1,FILPTR      Ptr to disk FAB                   @SC88053 08889500
  2781.          MVC   FABCOMM-FABD(8,1),=CL8'Binary'                  @SC88053 08890000
  2782.          B     OBFERR        No, give up                       @SC88053 08890500
  2783. OBFNRM   DS    0H                                              @SC86151 08891000
  2784.          TM    FL1,BINF                                                 08891500
  2785.          BO    OBFLEN                Go if binary data file             08892000
  2786.          LTR   9,9                   Any data to write?                 08892500
  2787.          BNZ   OBFTR                 Yes, there's data                  08893000
  2788.          MVI   0(7),ABL              Make first char a space            08893500
  2789.          LA    9,1                   Length of one                      08894000
  2790. OBFTR    LA    15,ATOE       Change to EBCDIC                  @SC86202 08894500
  2791.          LR    2,7                                             @SC86202 08895000
  2792.          LR    3,9           Length                            @SC86202 08895500
  2793.          CLC   =CL(LALF)'&JAPNEUC',TRNALF                      @SC91325 08896000
  2794.          BNE   OBFXLA1       Normal translation                @SC91325 08896500
  2795.          ICM   14,15,=A(KJATOE) See if 2-byte Kanji present    @SC91325 08897000
  2796.          BZ    OBFXLA1       No, that could be a disaster      @SC91325 08897500
  2797.          KCALL (14),E=(OBFTRNX,M) Yes, call the routine        @SC91325 08898000
  2798.          LR    9,15          Get new length of buffer          @SC91325 08898500
  2799.          B     OBFLEN        Done translating                  @SC91325 08899000
  2800. OBFXLA1  DS    0H                                              @SC91325 08899500
  2801.          BAL   14,TRANSLAT   Do the translate                  @SC86202 08900000
  2802. OBFLEN   CR    9,6           Compare data len. to trunc len.   @SC88120 08900500
  2803.          BE    OBFWRT        Go if lrecl exactly               @SC87268 08901000
  2804.          BH    OBFTRNC       Go if must truncate               @SC87268 08901500
  2805.          CLI   FRECF,C'F'                                      @SC88120 08902000
  2806.          BNE   OBFWRT        Go if variable format             @SC88120 08902500
  2807.          LR    1,6                   Else, get lrecl size               08903000
  2808.          SR    1,9                   Pad with this many spaces          08903500
  2809.          LA    0,0(9,7)              Where to start padding             08904000
  2810.          SR    15,15                                           @SC86295 08904500
  2811.          TM    FL1,BINF                                        @SC86295 08905000
  2812.          BO    *+8                                             @SC86295 08905500
  2813.          ICM   15,8,BLANK    Pad with spaces                   @SC86295 08906000
  2814.          MVCL  0,14                  Do it                              08906500
  2815.          B     OBFLRECL      And note new length               @SC87268 08907000
  2816. OBFTRNC  LA    0,1                                             @SC87268 08907500
  2817.          A     0,RECTRC                                        @SC87268 08908000
  2818.          ST    0,RECTRC      Increment count of truncations    @SC87268 08908500
  2819.          CLI   TRNCFL,C'H'   Do we halt here?                  @SC88120 08909000
  2820.          BNE   OBFLRECL      Truncation allowed, ok            @SC88120 08909500
  2821.          MVI   ERRNUM,ERRRTR Mark error and stop               @SC88120 08910000
  2822.          B     RTRN1                                           @SC88120 08910500
  2823. OBFLRECL LR    9,6                   Length has to be this size         08911000
  2824. OBFWRT   LM    14,15,DSKTOT  Update disk count                 @SC86295 08911500
  2825.          ALR   15,9                                            @SC86295 08912000
  2826.          BC    12,*+8                                          @SC88092 08912500
  2827.          AL    14,F1                                           @SC86295 08913000
  2828.          STM   14,15,DSKTOT  Save new count                    @SC86295 08913500
  2829.          WRITF FILPTR,BUFFER=(7),BSIZE=(9)                     @SC87034 08914000
  2830.          LTR   15,15                 Any disk write errors?             08914500
  2831.          BZ    OBFRET                Nope, all OK                       08915000
  2832.          MVI   ERRNUM,ERRFUL Maybe disk is full                @SC86345 08915500
  2833.          CLM   15,1,ERRNUM   Is it?                            @SC86345 08916000
  2834.          BE    OBFRET        Yes, too bad                      @SC86345 08916500
  2835. OBFERR   ERRF  ,             General write error, analyze it   @SC87338 08917000
  2836. OBFRET   RET                                                            08917500
  2837. OBFTRNX  L     1,FILPTR      Ptr to disk FAB                   @SC91325 08918000
  2838.          MVC   FABCOMM-FABD(8,1),=CL8'Xlate'                   @SC91325 08918500
  2839.          LA    15,999        Weird error code                  @SC91325 08919000
  2840.          B     OBFERR        Give up                           @SC91325 08919500
  2841.          LOCALS ,                                              @SC86295 08920000
  2842. OUTBUF   EXIT                                                           08920500
  2843.          TITLE 'FOPSTR Routine - test string for file options'          08921000
  2844. * Entry: R1->Address of option field, R6->string, R7=length - 1         08921500
  2845. * Exit: R15=0 + R6,R7 fixed if ok, R15=1 if error (msg ptrs set up)     08922000
  2846. FOPSTR   ENTER ,                                               @SC89218 08922500
  2847.          LR    5,1           Save ptr to options               @SC89218 08923000
  2848.          NI    FL2,255-FOPTS Clear option flag                 @SC89218 08923500
  2849.          MVC   0(8,5),=F'0,-1' Default values                  @SC89218 08924000
  2850.          MVI   8(5),0        Default flags                     @SC91116 08924500
  2851.          LA    9,0(7,6)      Point to last character           @SC89218 08925000
  2852.          LR    1,9                                             @SC89218 08925500
  2853.          EX    7,FOPTRT      Scan for option starter           @SC89218 08926000
  2854.          BZ    RTRN0         Not found, no action              @SC89218 08926500
  2855.          OI    FL2,FOPTS     Yes, note the fact                @SC89218 08927000
  2856.          PTEXT '&MISSOPS'  Just in case                        @SC89249 08927500
  2857.          CR    1,9           Anything after the starter?       @SC89218 08928000
  2858.          BE    FOPERR        No, too bad                       @SC89218 08928500
  2859.          PTEXT '&BADDELF'    In case                           @SC89249 08929000
  2860.          CLI   0(9),FBRK2    Check ending                      @SC89218 08929500
  2861.          BNE   FOPERR        Wrong one                         @SC89218 08930000
  2862.          LR    0,1                                             @SC89218 08930500
  2863.          SR    0,6           Length of stuff before options    @SC89218 08931000
  2864.          BCTR  0,0           Length - 1                        @SC89218 08931500
  2865.          LA    6,1(,1)       Ptr to option string              @SC89218 08932000
  2866.          RETREG (7,0)        Return length-1 as fixed R7       @SC89218 08932500
  2867. *          Set up loop over line numbers                       @SC89218 08933000
  2868.          LA    1,2                                             @SC89218 08933500
  2869.          LR    2,5           Ptr to option fields              @SC89218 08934000
  2870.          LA    8,C'-'        Delimiter after 1st number        @SC89218 08934500
  2871. *                                                                       08935000
  2872. FOPNLP   LA    7,1(,9)       End of string                     @SC89218 08935500
  2873.          SR    7,6           Length remaining                  @SC89218 08936000
  2874.          CH    7,*+10                                          @SC89218 08936500
  2875.          BNH   *+8                                             @SC89218 08937000
  2876.          LA    7,15          Max allowed by GETNUM             @SC89218 08937500
  2877.          LR    15,6          Save start of string              @SC89218 08938000
  2878.          BAL   14,GETNUM     1st, returns R15->end of digits   @SC89218 08938500
  2879.          LR    7,15                                            @SC89218 08939000
  2880.          SR    7,6           Length of numeric string          @SC89218 08939500
  2881.          BAL   14,GETNUM     2nd, returns number and skips     @SC89218 08940000
  2882.           SR   0,0           Omitted, use -1                   @SC89218 08940500
  2883.           BCTR 0,0                                             @SC89218 08941000
  2884.          LA    6,1(,15)      Ptr to rest of string             @SC89218 08941500
  2885.          STCM  0,15,0(2)     Save result in option field       @SC89218 08942000
  2886.          CLI   0(15),FBRK2   Reached end?                      @SC89218 08942500
  2887.          BE    FOPNLQ        Yes, quit scanning                @SC89218 08943000
  2888.          CLI   0(15),C'_'    Reached end of range limits?      @SC89218 08943500
  2889.          BE    FOPNLQ        Yes, quit scanning                @SC89218 08944000
  2890.          PTEXT '&BADDELM'                                      @SC89249 08944500
  2891.          CLM   8,1,0(15)     Delimiter for this number?        @SC89218 08945000
  2892.          BNE   FOPERR        None of these, syntax error       @SC89218 08945500
  2893.          LA    2,4(,2)       Advance output ptr                @SC89218 08946000
  2894.          LA    8,C'_'        Change delimiter                  @SC89218 08946500
  2895.          BCT   1,FOPNLP      Get next number                   @SC89218 08947000
  2896. FOPNLQ   ICM   1,15,0(5)     Check starting line number        @SC89218 08947500
  2897.          S     1,F1          Convert to number to skip         @SC89218 08948000
  2898.          BNM   *+6                                             @SC89218 08948500
  2899.           SR   1,1           No skipping                       @SC89218 08949000
  2900.          STCM  1,15,0(5)                                       @SC89218 08949500
  2901.          PTEXT '&BADRNGE'                                      @SC89249 08950000
  2902.          CLM   1,15,4(5)     Check range for order             @SC89218 08950500
  2903.          BNL   FOPERR        Upper limit smaller!              @SC89218 08951000
  2904.          CR    6,9           Any more option text?             @SC89218 08951500
  2905.          BNL   RTRN0         No, all done                      @SC89218 08952000
  2906. *          Other options                                       @SC89218 08952500
  2907. *                                                                       08953000
  2908.          CLC   =C'CC',0(6)                                     @SC91116 08953500
  2909.          BE    FOPCC                                           @SC91116 08954000
  2910.          CLC   =C'cc',0(6)                                     @SC91116 08954500
  2911.          BE    FOPCC                                           @SC91116 08955000
  2912. *          Fall through if option not defined                  @SC89218 08955500
  2913.          PTEXT '&BADOPTS'                                      @SC89249 08956000
  2914. FOPERR   RETREG 3,4          Return msg ptrs as R3, R4         @SC89218 08956500
  2915.          MVI   ERRNUM,ERROPT Error with option(s)              @SC89249 08957000
  2916.          B     RTRN1                                           @SC89218 08957500
  2917. *                                                                       08958000
  2918. FOPCC    OI    FLNFLGS-FLNOPTS(5),FLNCC  Set flag for CC       @SC91116 08958500
  2919.          B     RTRN0                                           @SC91116 08959000
  2920. *                                                                       08959500
  2921. FOPTRT   TRT   0(,6),FOPBRK  Scan for initial character        @SC89218 08960000
  2922. FOPBRK   DC    256X'00'                                        @SC89218 08960500
  2923.          ORG   FOPBRK+FBRK1                                    @SC89218 08961000
  2924.          DC    X'01'                                           @SC89218 08961500
  2925.          ORG   ,                                               @SC89218 08962000
  2926.          LOCALS ,                                              @SC89218 08962500
  2927.          EXIT  ,                                               @SC89218 08963000
  2928.          TITLE 'KHDMP Routine - dump storage to log file'               08963500
  2929. * Dump area to log                                                      08964000
  2930. * Entry: R1->area, R0=length, R2-> 8-byte title for area                08964500
  2931. * Exit: R15=0 if ok                                                     08965000
  2932. KHDMP    ENTER ,                                               @SC91008 08965500
  2933.          AIF   ('&KTRACE' EQ 'NO').KHDZ1                       @SC91008 08966000
  2934.          TM    FL1,DEBUG+TSTF Special logging in effect?       @SC91008 08966500
  2935.          BNO   RTRN0         No, that's all                    @SC91008 08967000
  2936.          LA    5,15          Round up to mult of 16            @SC91008 08967500
  2937.          ALR   5,0           From length                       @SC91008 08968000
  2938.          SRA   5,4           Convert to count of lines         @SC91008 08968500
  2939.          BNP   RTRN0         Nothing there                     @SC91008 08969000
  2940.          LR    4,1           Save ptr to area                  @SC91008 08969500
  2941.          L     6,LOGBUF      Ptr to buffer                     @SC91008 08970000
  2942.          MVI   0(6),C'*'     Set log label                     @SC91008 08970500
  2943.          MVC   2(8,6),0(2)   Copy title                        @SC91008 08971000
  2944.          WRITF LOGPTR,BSIZE=10                                 @SC91008 08971500
  2945.          MVC   4*9+2(3,6),=C'  *'  Set off character version   @SC91008 08972000
  2946.          MVI   4*9+2+3+16(6),C'*'                              @SC91008 08972500
  2947. KHDLP1   LA    3,2(,6)       Start of data area                @SC91008 08973000
  2948.          LA    1,4           Words to dump per line            @SC91008 08973500
  2949.          MVC   4*9+2+3(16,6),0(4)   Copy string                @SC91008 08974000
  2950.          TR    4*9+2+3(16,6),KHDPRT and make printable         @SC91008 08974500
  2951.          MVI   0(3),C' '     Add for readability               @SC91008 08975000
  2952. KHDLP2   UNPK  1(9,3),0(5,4) Unpack into buffer                @SC91008 08975500
  2953.          TR    1(8,3),TRHEX  Convert to printable hex          @SC91008 08976000
  2954.          MVI   9(3),C' '     Blank out garbage                 @SC91008 08976500
  2955.          LA    3,9(,3)       Advance text ptr                  @SC91008 08977000
  2956.          LA    4,4(,4)       and data source                   @SC91008 08977500
  2957.          BCT   1,KHDLP2      Loop over line of 16              @SC91008 08978000
  2958.          LA    3,4*9+2+3+16+1 Length of data                   @SC91008 08978500
  2959.          WRITF LOGPTR,BSIZE=(3)                                @SC91008 08979000
  2960.          BCT   5,KHDLP1      Loop over lines                   @SC91008 08979500
  2961.          TM    DBGFLG,DBGSV  SAVE requested?                   @SC91008 08980000
  2962.          BZ    RTRN0         No, skip closing log file         @SC91008 08980500
  2963.          SAVEF LOGPTR        Update disk directory             @SC91008 08981000
  2964. .KHDZ1   ANOP                                                  @SC91008 08981500
  2965.          B     RTRN0                                           @SC91008 08982000
  2966. *                                                                       08982500
  2967.          AIF   ('&KTRACE' EQ 'NO').KHDZ2                       @SC91008 08983000
  2968. KHDPRT   DC    64C'.',192AL1(*-KHDPRT)                         @SC91008 08983500
  2969. .KHDZ2   ANOP                                                  @SC91008 08984000
  2970.          LOCALS ,                                              @SC91008 08984500
  2971.          EXIT  ,                                               @SC91008 08985000
  2972.          END   KERMIT                                                   08985500
  2973.