*COPY                                                 IK0COM            01800000
         TITLE 'COMMON - Kermit-370 common routines/data areas'         01801000
COMMON   CSECT                                                          01802000
* Translat - translates data.  On entry R2->buffer, R3=length  @SC86202 01803000
*   R14 = return address, R15->translate table                 @SC86202 01804000
*   R1-R3 are destroyed, R15 is set to 0                       @SC86202 01805000
TRANSLAT LTR   3,3           Anything to do?                   @SC86202 01806000
         BNP   TRANSRET      No, quit                          @SC86202 01807000
         ALR   2,3           End of source                     @SC86202 01808000
TRLOOP   LR    1,2                                             @SC86202 01809000
         SR    1,3           Ptr to remaining bytes            @SC86202 01810000
         BCTR  3,0           Count for EX                      @SC86202 01811000
         EX    3,TREX        Translate the input segment       @SC86202 01812000
         N     3,=F'-256'    Remove count done                 @SC86202 01813000
         BNZ   TRLOOP        Loop thru source                  @SC86202 01814000
TRANSRET SR    15,15         Done, set RC=0                    @SC86202 01815000
         BR    14                                              @SC86202 01816000
TREX     TR    0(,1),0(15)                                     @SC86202 01817000
*                                                                       01818000
* Subroutine to test for undelimited v-binary format           @SC86151 01819000
RDWSET   XC    RDWLEN,RDWLEN Usual format                      @SC86151 01820000
         LA    0,5           Header length of 5 for D-binary   @SC86262 01821000
         CLI   TYPFIL,C'D'   Is it?                            @SC86262 01822000
         BE    RDWSOK        Yes, use it                       @SC86262 01823000
         LA    0,2           Header length of 2 for V-binary   @SC86262 01824000
         CLI   TYPFIL,C'V'   Test for special type             @SC86151 01825000
         BNER  14            Not V-binary                      @SC86151 01826000
RDWSOK   DS    0H                                              @SC86262 01827000
         ST    0,MAXOUT      Init for decoding                 @SC86151 01828000
         ST    0,RDWLEN                                        @SC86151 01829000
         BR    14                                              @SC86151 01830000
*                                                                       01831000
* Subroutine to increment pkt sequence number                           01832000
INCRSEQ  IC    3,SEQ                                           @SC86135 01833000
         LA    3,1(3)                                                   01834000
         N     3,MOD64                                                  01835000
         STC   3,SEQ                                           @SC86135 01836000
         LA    3,1                                             @SC86295 01837000
         AL    3,PAKCNT                                        @SC86295 01838000
         ST    3,PAKCNT      Update packet count               @SC86295 01839000
         BR    14                                                       01840000
*                                                                       01841000
* Subroutines to interpret RPACK data                                   01842000
INPUTSPK SR    3,3           Clear counter                     @SC86276 01843000
         KCALL SPACK,E=INPUTRTY                                @SC86276 01844000
INPUT    SR    3,3                   Clear loop counter                 01845000
INPUTLUP KCALL RPACK         Read data                                  01846000
INPUTINR MVI   ERRNUM,ERRIPT Assume bad packet type            @SC86158 01847000
         IC    4,RTYPE       Test byte                         @SC86158 01848000
         BAL   2,CLKP        Look up in list                   @SC86158 01849000
* Standard packet types for special treatment                  @SC86158 01850000
INPUTST  DC    AL1(AE),AL3(INPUTERR) Error packet              @SC86158 01851000
         DC    AL1(AN),AL3(INPUTNAK) NAK packet                @SC86158 01852000
         DC    AL1(AQ),AL3(INPUTQAB) RPACK error               @SC86158 01853000
         DC    AL1(AT),AL3(INPUTTIM) Time out                  @SC86355 01854000
         DC    AL1(00),AL3(INPUTCNT) OK so far                 @SC86158 01855000
*                                                                       01856000
INPUTCNT DS    0H                                              @SC86158 01857000
         CLC   SEQ,RSN                                                  01858000
         BNE   INPUTMIS              Go if pkt num mismatch             01859000
INPUTQRT LR    2,8                   Get next-state table address       01860000
         LR    14,9          For in-line return                @SC86295 01861000
         B     CLKP          Look up in expected list          @SC86158 01862000
*                                                                       01863000
INPUTMIS MVI   ERRNUM,ERRMIS Missing pkt                       @SC86156 01864000
         B     INPUTRTY              Retry                              01865000
*                                                                       01866000
INPUTQAB CLI   STYPE,AB                                                 01867000
         BNE   INPUTRTY              Retry if not a BRK pkt             01868000
         MVI   RTYPE,AY              Fake an ACK                        01869000
         IC    4,RTYPE                                         @SC86158 01870000
         B     INPUTQRT              And go handle the ACK              01871000
*                                                                       01872000
INPUTTIM MVI   ERRNUM,ERRTIM Timed out                         @SC86355 01873000
         B     INPUTRTY                                        @SC86355 01874000
INPUTNAK MVI   ERRNUM,ERRNAK Micro NAK'ed                      @SC86156 01875000
INPUTRTY BAL   2,SENDRTY     Resend to the limit               @SC86276 01876000
         B     INPUTLUP              And interpret response             01877000
*                                                                       01878000
INPUTERR MVI   ERRNUM,ERRABO Micro aborted                     @SC86156 01879000
         LR    2,9           Save return                       @SC86295 01880000
         BAL   9,DECODEN     Decode error message              @SC86295 01881000
         LR    9,2                                             @SC86295 01882000
         L     0,WBUF        Ptr to decoded message            @BS86090 01883000
         L     1,WBUFL                                         @BS86090 01884000
         L     14,EMSGP      Ptr to msg buffer                 @BS86090 01885000
         LA    15,LEMSG                                        @BS86090 01886000
         CR    1,15                                            @BS86090 01887000
         BNH   *+6                                             @BS86090 01888000
         LR    1,15          Truncate msg                      @BS86090 01889000
         ST    1,EMSGL       Save effective length             @BS86090 01890000
         MVCL  14,0          Save in buffer                    @BS86090 01891000
         L     1,EMSGP                                         @BS86090 01892000
         TR    0(LEMSG,1),ATOE Convert to EBCDIC               @BS86090 01893000
INPUTABR SR    4,4           Look for end of table             @SC86158 01894000
         B     INPUTQRT                                        @SC86158 01895000
*                                                                       01896000
* CLKP - Subroutine to dispatch to routine from table lookup   @SC86158 01897000
*  R2->table, R4=char, R14->return if null entry in table      @SC86158 01898000
*  Each entry has AL1(char),AL3(adr), last char=00             @SC86158 01899000
CLKNXT   LA    2,4(2)        Next state                        @SC86158 01900000
CLKP     CLM   4,1,0(2)      Match?                            @SC86158 01901000
         BE    CLKF          Yes, go do it                     @SC86158 01902000
         CLI   0(2),0                                                   01903000
         BNE   CLKNXT        Not at the end yet                @SC86158 01904000
CLKF     ICM   2,7,1(2)      Pick routine address              @SC86158 01905000
         BNZR  2             Go to that routine if any         @SC86295 01906000
         BR    14            Or fall down to caller            @SC86158 01907000
*                                                                       01908000
* Retry sending same packet until success or abort             @SC86276 01909000
SENDRTY  LA    3,1(3)        Increment retry counter           @SC86276 01910000
         CL    3,LIMTRY      Did we retry enough?              @SC86276 01911000
         BNL   INPUTABR      Yes, abort if limit reached       @SC86276 01912000
         LA    15,1                                            @SC86276 01913000
         AL    15,RTRCNT                                       @SC86276 01914000
         ST    15,RTRCNT     Update retry count                @SC86276 01915000
         TM    FL1,NAK0                                        @SC86276 01916000
         BO    SENDNAK       Haven't sent anything yet         @SC86276 01917000
         KCALL SIO,E=SENDRTY Resend the same packet            @SC86276 01918000
         BR    2             Success, return                   @SC86276 01919000
*                                                                       01920000
* Subroutine to send a NAK                                              01921000
SENDNAK  MVI   STYPE,AN              A NAK pkt                          01922000
         XC    DATL,DATL             no data                            01923000
         B     SENDPK        Send the packet                   @SC86276 01924000
*                                                                       01925000
* Subroutine to send an ACK                                             01926000
SENDACK  XC    DATL,DATL             no data length                     01927000
SENDACKL MVI   STYPE,AY              an ACK pkt                         01928000
         SR    3,3           Clear counter                     @SC86276 01929000
SENDPK   KCALL SPACK,E=SENDRTY Send the packet                 @SC86276 01930000
         BR    2                     return                             01931000
*                                                                       01932000
* Set up command to foreign server. Trade parms if necessary            01933000
IPKSET   KCALL INTINI,4,E=INPUTABR Initialize for sending      @SC87300 01934000
         TM    FL3,PXCH                                        @SC86155 01935000
         BO    IPKFIN                                          @SC86155 01936000
         MVI   SEQ,0                                           @SC86155 01937000
         MVC   LIMTRY,MAXTNT Limit for INIT retries            @SC86345 01938000
         KCALL RPARSET                                         @SC86155 01939000
         KCALL RPAR          Our I packet to send              @SC86155 01940000
         ICM   8,8,STYPE     Save packet type                  @SC86295 01941000
         MVI   STYPE,AI      Packet type = initialize          @SC86155 01942000
         BAL   9,INPUTSPK    Send RPAR and interpret response  @SC86295 01943000
         STCM  8,8,STYPE     Restore packet type               @SC86295 01944000
         KCALL SPAR          Interpret reply to our I packet   @SC86155 01945000
IPKFIN   MVI   SEQ,0         Reset packet number               @SC86155 01946000
         MVC   LIMTRY,MAXTRY Nominal retry limit               @SC86295 01947000
         B     8(8)          Skip over 2-entry table           @SC86295 01948000
*                                                                       01949000
* Subroutine to skip over white-space                                   01950000
WSP      LM    6,7,LEN               Length and address of input        01951000
         LTR   6,6                   Any more data left to scan?        01952000
         BNPR  9             Nope, fail                        @SC86135 01953000
WSPLUP   CLI   0(7),C' '                                       @SC86115 01954000
         BE    WSPNXT                Skip a blank                       01955000
         CLI   0(7),NL                                                  01956000
         BNE   WSPEND                Skip a new-line char               01957000
WSPNXT   LA    7,1(7)                next char                          01958000
         BCT   6,WSPLUP              decrement length                   01959000
         BR    9                                                        01960000
*                                                                       01961000
WSPEND   STM   6,7,LEN               Save new non-white spot            01962000
         B     4(9)                  Skip return                        01963000
*                                                                       01964000
* Subroutine to get next token from commands                            01965000
TOK      LM    6,7,LEN               Length and address of input        01966000
         LTR   6,6                   Any more data to tokenize?         01967000
         BNPR  9             No, error return                  @SC86135 01968000
*                                                                       01969000
TOKLUP   CLI   0(7),C' '                                       @SC86115 01970000
         BE    TOKSKP                Found a blank terminator           01971000
         CLI   0(7),NL                                                  01972000
         BE    TOKSKP                Found a new-line terminator        01973000
         CLI   0(7),C','                                       @SC86115 01974000
         BNE   TOKNXT                Not a comma                        01975000
         C     7,ADR                 Is comma the first char?           01976000
         BNE   TOKSKP                No, must be a token itself         01977000
TOKNXT   LA    7,1(7)                Next char                          01978000
         BCT   6,TOKLUP              decrement remaining length         01979000
TOKSKP   BCTR  6,0                   remaining length of input          01980000
         ST    6,LEN                 Save it for next time              01981000
         LA    6,1(7)        Next spot to scan                 @SC86224 01982000
         S     7,ADR                 Length of token                    01983000
         ST    6,ADR         Next spot to scan                 @SC86224 01984000
         SR    6,7                                             @SC86224 01985000
         BCTR  6,0           Address of token                  @SC86224 01986000
         BCTR  7,0                   Token length - 1                   01987000
         B     4(9)                  Skip return                        01988000
*                                                                       01989000
* Subroutine to skip white-space and pick next token                    01990000
WSPTOK   BAL   9,WSP                                                    01991000
          B    0(14)         Ran off the end                   @SC86135 01992000
         BAL   9,TOK                                                    01993000
          B    0(14)         No more tokens                    @SC86135 01994000
         B     4(14)                 Skip return                        01995000
*                                                                       01996000
* Interpret decimal number from string at (R6) of length=(R7)           01997000
*   Clobber R4,R7,R15.  Return value in R0 and skips if ok.             01998000
GETNUM   LR    4,7           Copy length                       @SC86316 01999000
         C     4,F           Length must be <16                @SC87012 02000000
         BHR   14                                              @SC87012 02001000
         BCTR  7,0           Change for EX                     @SC86316 02002000
         LR    15,6          Don't lose pointer to input       @SC86316 02003000
GETNUML  CLI   0(15),C'0'                                      @SC86316 02004000
         BLR   14            Go if not numeric                 @SC86316 02005000
         CLI   0(15),C'9'                                      @SC86316 02006000
         BHR   14            Go if not numeric                 @SC86316 02007000
         LA    15,1(15)      Bump input pointer                @SC86316 02008000
         BCT   4,GETNUML     Go if more                        @SC86316 02009000
         EX    7,GETNUMPK    Pack the input                    @SC86316 02010000
         CVB   0,TMPDW       Convert to binary                 @SC86316 02011000
         B     4(14)         Return and skip                   @SC86316 02012000
GETNUMPK PACK  TMPDW,0(,6)                                     @SC86316 02013000
*                                                                       02014000
* Test for Ascii char range of 33-62 and 96-126, skip on return if ok   02015000
*  Character must be in low byte of R4                                  02016000
CHKQR    CLM   4,1,SPACE+3                                     @SC86120 02017000
         BNHR  14            Cannot use control char or blank  @SC86120 02018000
         CLM   4,1,MOD64+3                                     @SC86120 02019000
         BL    4(14)         OK, 33-62                         @SC86120 02020000
         CLM   4,1,LOCASE+96                                   @SC86295 02021000
         BLR   14                                              @SC86120 02022000
         CLM   4,1,LOCASE+127                                  @SC86295 02023000
         BNLR  14                                              @SC86120 02024000
         B     4(14)         OK, 96-126                        @SC86120 02025000
*                                                                       02026000
* Subroutine to scan a parse table built by KW macro                    02027000
SCAN     CLI   0(6),C'?'                                       @SC86115 02028000
         BE    HELPKW                                                   02029000
         MVC   OPRND,0(6)    Copy token for lookup             @SC87034 02030000
         TR    OPRND,UPCASE  And convert to upper case         @SC87034 02031000
         SR    15,15                                                    02032000
SCANLUP  CLI   0(1),255                                        @SC87117 02033000
         BE    4(14)         Return to caller if end           @SC87117 02034000
         CLI   3(1),255      Branch to other list?             @SC87117 02035000
         BNE   *+12          No                                @SC87117 02036000
         ICM   1,7,0(1)      Yes, get ptr to new list          @SC87117 02037000
         B     SCANLUP       And resume search                 @SC87117 02038000
         CLM   7,1,4(1)      Compare token length vs min abbr           02039000
         BL    SCANNO                Go if < min                        02040000
         CLM   7,B'0001',3(1)        Compare token and kw lengths       02041000
         BH    SCANNO                Go if length of token > kw's       02042000
         EX    7,SCANCLC                                                02043000
         BE    SCANYES                                                  02044000
SCANNO   IC    15,3(1)               KW length - 1                      02045000
         LA    1,6(15,1)             add 3+1+1+1 to it                  02046000
         B     SCANLUP       Continue checking                          02047000
*                                                                       02048000
SCANYES  CLM   7,8,F0        Flagged just to find entry?       @SC86355 02049000
         BNER  14            Yes, got it                       @SC86355 02050000
         TR    0(1,6),UPCASE Upcase 1st letter, just in case   @SC87034 02051000
         ICM   14,7,0(1)     No, get handler address           @SC86355 02052000
         BR    14                                                       02053000
*                                                                       02054000
SCANCLC  CLC   5(,1),OPRND   Compare token to KW               @SC87034 02055000
*                                                                       02056000
* Utility routine to set up linkage                                     02057000
SUBENT   LR    12,15         CSECT addressibility              @SC86295 02058000
         L     15,STKPTR     Current end of stack              @SC86295 02059000
         AR    0,15          Our needs                         @SC86295 02060000
         C     0,STKLIM      Does it fit?                      @SC86295 02061000
         BH    SUBDIE        No, (that's incredible)           @SC86295 02062000
         ST    0,STKPTR      New end                           @SC86295 02063000
         ST    13,4(15)      Link subroutines                  @SC86295 02064000
         ST    15,8(13)                                        @SC86295 02065000
         LR    13,15                                           @SC86295 02066000
         LR    1,0           End of local variables            @SC87012 02067000
         LA    0,72(15)      Start=end of save area            @SC87012 02068000
         SR    1,0                                             @SC87012 02069000
         BNP   *+8           No locals                         @SC87012 02070000
         SR    15,15                                           @SC87012 02071000
         MVCL  0,14          Zero-fill all locals              @SC87012 02072000
         L     15,4(13)                                        @SC87012 02073000
         LM    0,1,20(15)    Restore R0,R1                     @SC87012 02074000
         BR    14            Go                                @SC86295 02075000
SUBDIE   LM    14,12,12(13)                                    @SC86295 02076000
         LA    15,1                                            @SC87012 02077000
         LCR   15,15         Set return code = -1              @SC87012 02078000
         BR    14            Go                                @SC86295 02079000
*                                                                       02080000
* Common exit code                                                      02081000
RETSNRC  MVI   BCTU,1        Reset chksum at end of transfer   @SC86295 02082000
         KCALL INTINI,0      Close line for transfer           @SC86295 02083000
         KCALL SUPFNC,10     Get time                          @SC86295 02084000
         S     15,SECTOT     Take elapsed time                 @SC86295 02085000
         BNM   *+8           Ok, no wrap                       @SC86345 02086000
         A     15,=F'1759218604'  Wraps by 2**44/10000         @SC86345 02087000
         ST    15,CSECTOT    Save elapsed time in csec         @SC86345 02088000
         SR    14,14                                           @SC86295 02089000
         LA    0,100                                           @SC86295 02090000
         DR    14,0          Convert to sec                    @SC86295 02091000
         AR    14,14         Check remainder                   @SC86295 02092000
         CR    14,0                                            @SC86295 02093000
         BL    *+8                                             @SC86295 02094000
         A     15,F1         Round up                          @SC86295 02095000
         ST    15,SECTOT                                       @SC86295 02096000
         B     RTRN0                                           @SC86295 02097000
RTRNUM   BAL   14,LDERR      Fetch error code                  @SC87117 02098000
         B     RTRN                                            @SC87117 02099000
RTRN2    LA    15,2          Indicate error                    @SC86295 02100000
         B     RTRN                                            @SC86295 02101000
RTRNM1   SR    15,15         Error = -1                        @SC86295 02102000
         BCTR  15,0                                            @SC86295 02103000
         B     RTRN                                            @SC86295 02104000
RTRN0    SR    15,15         No errors                         @SC86295 02105000
         B     RTRN                                            @SC86295 02106000
SUBERR   WTEXT (3),(4)       Print prepared message            @SC86295 02107000
RTRN1    LA    15,1          Indicate error                    @SC86295 02108000
RTRN     ST    13,STKPTR     Free the storage                  @SC86295 02109000
         L     13,4(13)      Unlink                            @SC86295 02110000
         L     14,12(13)     Restore registers                 @SC86295 02111000
         LM    0,12,20(13)                                     @SC86295 02112000
         LTR   15,15         Test return code                  @SC86295 02113000
         BR    14                                              @SC86295 02114000
*                                                                       02115000
* Subroutine to fetch error code (but 0 if no transfers yet)            02116000
LDERR    SR    15,15                                                    02117000
         CLI   ERRNUM,ERRNFT No file transfer isn't an error   @HF86157 02118000
         BER   14                                              @HF86157 02119000
         IC    15,ERRNUM     Return status code                @HF86157 02120000
         BR    14                                              @HF86157 02121000
*                                                                       02122000
* Subroutine to decode without disk-write                               02123000
DECODEN  NI    FL1,255-EOF           No EOF yet                         02124000
         XC    WBUFL,WBUFL           No data in WBUF yet                02125000
         OI    FL1,NAME              No disk-writes                     02126000
         KCALL DECODE        Decode data into WBUF             @SC86135 02127000
         NI    FL1,255-NAME          Turn this off                      02128000
         BR    9                                               @SC86295 02129000
*                                                                       02130000
* Subroutine to encode without disk-read                                02131000
ENCODEN  XC    RBUFP,RBUFP           Start encoding at beg of RBUF      02132000
         OI    FL1,NAME              Indicate not to do disk reads      02133000
         KCALL ENCODE        Encode it into DATA               @SC86135 02134000
         NI    FL1,255-NAME          Turn this off                      02135000
         BR    9                                               @SC86295 02136000
*                                                                       02137000
* Subroutine to display the contents of the KW tables                   02138000
HELPKW   SR    7,7                   token length holder                02139000
         LA    2,16          Tab width for display             @SC86295 02140000
         LA    3,CMD+79      Display buffer limit offset       @SC86295 02141000
         LR    4,1                   KW table address                   02142000
         WTEXT 'One of the following:'                                  02143000
HELPNL   LA    1,CMD+1       Display buffer offset             @SC86295 02144000
         MVI   CMD,C' '      Start blanking it                 @SC86115 02145000
         MVC   CMD+1(79),CMD         blank 80 chars                     02146000
HELPNT   CLI   0(4),255                                                 02147000
         BE    HELPEND               return if end of tokens            02148000
         CLI   3(4),255      Branch to other list?             @SC87117 02149000
         BNE   *+12          No                                @SC87117 02150000
         ICM   4,7,0(4)      Yes, get ptr to new list          @SC87117 02151000
         B     HELPNT        And resume scan                   @SC87117 02152000
         IC    7,3(4)                length-1 of current token          02153000
         IC    15,4(4)               min abbreviation length - 1        02154000
         EX    7,HELPMVC             move it to display buffer          02155000
         LA    4,6(4,7)              skip to next token in KW table     02156000
         MVI   15(1),C' '    Move a blank separator            @SC86115 02157000
         TR    0(15,1),LOCASE Make everthing lower case        @SC86295 02158000
         EX    15,TRUPCAS    Upper case the minimum            @SC86295 02159000
         BXLE  1,2,HELPNT    Loop if more room on line         @SC86295 02160000
         WTEXT CMD,80                display one line of tokens         02161000
         B     HELPNL                and continue with next line        02162000
*                                                                       02163000
HELPEND  LA    0,CMD+1                                         @SC86295 02164000
         CR    6,0           Is there anything accumulated?    @SC86295 02165000
         BER   14            No, display buffer empty          @SC86135 02166000
         WTEXT CMD,80                                                   02167000
BR14     BR    14                                                       02168000
*                                                                       02169000
HELPMVC  MVC   0(,1),5(4)    Copy KW                           @SC86295 02170000
*                                                                       02171000
* Subroutine to compress a file specification                  @HF86223 02172000
PAKFIL   LA    1,PREFIX      Start with prefix                 @HF86223 02173000
         L     7,RBUF        Put FN here for encode            @SC86155 02174000
         BAL   14,PAKFOR                                       @SC86295 02175000
         LA    0,FFENC                                         @SC86295 02176000
         KCALL FSPEC,FILNAM  Copy name with possible override  @SC86295 02177000
         LR    7,15          New output ptr                    @SC86295 02178000
         LA    1,SUFFIX      Finish with suffix                @SC86224 02179000
         BAL   14,PAKFOR                                       @SC86295 02180000
         S     7,RBUF        Length of buffer                  @SC86155 02181000
         ST    7,RBUFL                                         @SC86155 02182000
         BR    9                                               @HF86223 02183000
*                                                                       02184000
* Subroutine to append characters to the filespec              @HF86223 02185000
PAKFOR   SR    2,2           Number of characters to append    @HF86223 02186000
         ICM   2,1,0(1)      Probably none                     @HF86223 02187000
         BZR   14                                              @SC86295 02188000
         BCTR  2,0           Copy into buffer                  @HF86223 02189000
         EX    2,PAKRMV                                        @HF86223 02190000
         EX    2,PAKRTR      And ASCII it                      @HF86223 02191000
         LA    7,1(2,7)      New end of string                 @HF86223 02192000
         BR    14                                              @SC86295 02193000
*                                                                       02194000
PAKRMV   MVC   0(0,7),1(1)                                     @HF86223 02195000
PAKRTR   TR    0(0,7),ETOA                                     @HF86223 02196000
*                                                                       02197000
* Routines to add decimal and string arguments to a buffer     @SC86209 02198000
* Input: R15->insert point, R4=dec. value, R2->return          @SC86209 02199000
EDDEC    CVD   4,TMPDW       Get packed decimal                @SC86209 02200000
         MVC   0(10,15),=X'40202020202020202120'               @SC86209 02201000
         LA    9,10(15)      End of possible string            @SC86209 02202000
         LA    1,9(15)       Last possible start of signif.    @SC86209 02203000
         EDMK  0(10,15),TMPDW+3                                @SC86209 02204000
         LTR   4,4           Check sign                        @SC86209 02205000
         BNM   EDDPOS                                          @SC86209 02206000
         BCTR  1,0           Back up and insert minus          @SC86209 02207000
         MVI   0(1),C'-'                                       @SC86209 02208000
EDDPOS   LR    8,1           Start                             @SC86209 02209000
         SR    9,8           Length                            @SC86209 02210000
*   R8->argument string, R9=length                             @SC86209 02211000
EDCHAR   EX    9,EDCHRMV     Copy string to buffer (1 extra)   @HF86223 02212000
         AR    15,9          Update output ptr                 @SC86209 02213000
         BR    2                                               @SC86295 02214000
EDCHRMV  MVC   0(0,15),0(8)  Copy string to buffer             @HF86223 02215000
*                                                                       02216000
* Enter here with R7->position in CMD, R1->filespec. Return to (R2).    02217000
STAFSP   LA    0,FFDSP                                         @SC86295 02218000
         KCALL FSPEC         Copy name for display             @SC86295 02219000
STAPM15  LR    0,15          Output ptr                        @BS86090 02220000
STAPMSG  LA    1,CMD         Start of string                   @SC86295 02221000
         SR    0,1           Get length                        @SC86295 02222000
         WTEXT (1),(0)                                         @SC86295 02223000
         BR    2                                               @SC86295 02224000
*                                                                       02225000
TRATOE   TR    0(,1),ATOE                                      @SC86158 02226000
TRUPCAS  TR    0(,1),UPCASE  Upcase                            @SC86158 02227000
*                                                                       02228000
* Return optimum packet size (in R15) based on previous transfer, or 0  02229000
*  Uses R2,R3,R4,R5,R14.  Returns via R9.                               02230000
OPTPKT   SR    15,15         Indicate no good                  @SC86345 02231000
         ICM   4,15,RTRCNT   Get error count                   @SC86345 02232000
         BZR   9             None, give up                     @SC86345 02233000
         LM    2,3,TINTOT    Get byte count                    @SC86345 02234000
         AL    3,TOUTOT+4                                      @SC86345 02235000
         BNO   *+8                                             @SC86345 02236000
         AL    2,F1                                            @SC86345 02237000
         AL    2,TOUTOT                                        @SC86345 02238000
         SLDL  2,1                                             @SC86345 02239000
         CR    2,4           Avoid overflow                    @SC86345 02240000
         BL    OPTL1         Ok                                @SC86345 02241000
         L     3,=XL4'2D414' No, use max.                      @SC86345 02242000
         B     SQRX                                            @SC86345 02243000
OPTL1    SRDL  2,1                                             @SC86345 02244000
         DR    2,4           Compute mean bytes/error          @SC86345 02245000
         SR    2,2                                             @SC86345 02246000
         SLDL  2,4           x 16                              @SC86345 02247000
*  Compute sq rt of value in (2,3), return in 15.  Uses 2,3,4,5,14.     02248000
SQRT     LR    14,2          Copy for sqrt                     @SC86345 02249000
         LR    15,3                                            @SC86345 02250000
         LA    4,31          Count bits                        @SC86345 02251000
SQRL1    CL    2,=XL4'10000000'                                @SC86345 02252000
         BNL   SQRL2         Justified now                     @SC86345 02253000
         SLDL  2,2           Keep shifting                     @SC86345 02254000
         BCT   4,SQRL1                                         @SC86345 02255000
SQRL2    LCR   4,4                                             @SC86345 02256000
         AL    2,=XL4'10000000'  1st guess at sqrt             @SC86345 02257000
         SRDL  2,62(4)       Shift back                        @SC86345 02258000
         LTR   3,3                                             @SC86345 02259000
         BNP   SQRX          Too small anyway                  @SC86345 02260000
         LA    2,3                                             @SC86345 02261000
SQRL3    LR    4,14                                            @SC86345 02262000
         LR    5,15                                            @SC86345 02263000
         DR    4,3           Get next guess                    @SC86345 02264000
         AR    3,5                                             @SC86345 02265000
         SRA   3,1                                             @SC86345 02266000
         BCT   2,SQRL3                                         @SC86345 02267000
SQRX     LR    15,3                                            @SC86345 02268000
         BR    9                                               @SC86345 02269000
*                                                                       02270000
* Main command loop implementation of TAKE files                        02271000
         USING SERVERSV,13   Uses locals of caller, e.g. SERVER@SC86295 02272000
LOOPS    STM   0,1,RETADR    Initialize for main loop          @SC86295 02273000
         BR    14                                              @SC86295 02274000
*                                                                       02275000
LUPERK   BCT   15,LUPBAD     Go if bad operand: try on system  @SC86171 02276000
         MVI   ERRNUM,ERRKCE Kermit command error                       02277000
         OI    FL5,CMERR     Note error                        @SC86295 02278000
         B     LOOP                                            @SC86295 02279000
LOOP0    CLI   ERRNUM,ERRKCE Stale error?                      @SC86295 02280000
         BNE   LOOP          No, keep old error code           @SC86295 02281000
         MVI   ERRNUM,ERRNOE Clear old error condition         @SC86295 02282000
         B     LOOP                                            @SC86295 02283000
LUPFNF   MVI   ERRNUM,ERRFNF File not found                    @SC86295 02284000
         B     LUPWRTE                                         @SC86239 02285000
LUPINV   MVI   ERRNUM,ERRKCE Invalid command                   @SC86239 02286000
LUPWRTE  OI    FL5,CMERR     Note error                        @SC86171 02287000
LUPWRT   WTEXT (3),(4)                                         @SC86355 02288000
*                                                                       02289000
LOOP     MVC   OLDERR,ERRNUM                                   @SC86171 02290000
         ICM   2,15,TAKLEV   Get current TAKE level            @SC86295 02291000
         BZ    LUPEX                                           @SC86295 02292000
         BCTR  2,0                                             @SC86295 02293000
         SLA   2,2           Get offset into table             @SC86295 02294000
         LA    2,TAKTAB(2)   Point into TAKE file table        @SC86295 02295000
         TM    FL5,CMERR+TKHLT                                 @SC86239 02296000
         BO    LUPREX        Quit reading on error             @SC86239 02297000
         NI    FL5,255-CMERR-TKMSG Clear error flag            @SC86239 02298000
         READF 0(2),E=LUPRER                                   @SC87034 02299000
         LA    1,CMD         Ptr to buffer, R0 = length        @SC86171 02300000
         B     LUPPRS        Go parse                                   02301000
*                                                                       02302000
LUPRER   C     15,F12        EOF code?                                  02303000
         BE    LUPCLO        Yes, close the file                        02304000
         ERRF  ,             Analyze the error                 @SC87338 02305000
LUPREX   OI    FL5,CMERR     Note error                        @SC86171 02306000
         TM    FL5,TKMSG     Already issued message?           @SC86239 02307000
         BO    LUPCLO        Don't overdo it                   @SC86239 02308000
         WTEXT 'Error reading TAKE file'                       @SC86239 02309000
         OI    FL5,TKMSG                                       @SC86239 02310000
LUPCLO   CLOSF (2)           Close the file                    @SC86135 02311000
         L     2,TAKLEV      Get TAKE level                             02312000
         BCTR  2,0           And decrement it                           02313000
         ST    2,TAKLEV                                                 02314000
         B     LOOP                                                     02315000
*                                                                       02316000
LUPEX    NI    FL5,255-CMERR-TKMSG Clear error flag            @SC86239 02317000
         L     14,RETADR                                       @SC86295 02318000
         BR    14                                                       02319000
*                                                                       02320000
LUPPRS   DS    0H                                              @SC87034 02321000
         STM   0,1,SCANPTR   Save for parser                   @SC86171 02322000
         LTR   2,2                                             @SC86171 02323000
         BZ    LUPTOK        Not from TAKE                     @SC86171 02324000
         TM    FL2,ECHO                                        @SC86171 02325000
         BNO   LUPTOK        Not echoing                       @SC86171 02326000
         WTEXT (1),(0)       Echo to terminal                  @SC86171 02327000
LUPTOK   MVC   SCANSV,SCANPTR Save for system                  @SC86295 02328000
         NTOKN N=LOOP                                                   02329000
         CLI   0(6),C'*'                                       @SC86115 02330000
         BE    LOOP          Go if comment                              02331000
         L     1,CMDPTR                                        @SC86295 02332000
         SCAN  (1),LOOP                                        @SC86295 02333000
LUPBAD   PTEXT 'Invalid Kermit command'                                 02334000
         TM    FL2,PASS                                        @SC86295 02335000
         BZ    LUPINV        Don't try as system cmd           @SC86295 02336000
         MVC   SCANPTR,SCANSV Restore string ptrs              @SC86295 02337000
         OI    FL4,UCMD                                        @SC86295 02338000
         KCALL SUPFNC,3,E=(LOOP,NM) And execute it             @SC86295 02339000
         B     LUPINV                                          @SC86295 02340000
*                                                                       02341000
LUPSET   KCALL SET,E=LUPERK  Call SET routine                  @SC86295 02342000
         B     LOOP0                                           @SC86295 02343000
*                                                                       02344000
LUPSHO   KCALL SHOW,E=LUPERK Call SHOW routine                 @SC86295 02345000
         B     LOOP0                                           @SC86295 02346000
*                                                                       02347000
LUPCWD   KCALL CWDSET,E=LUPERK                                 @SC86295 02348000
         B     LOOP0                                           @SC86295 02349000
*                                                                       02350000
LUPGIV   KCALL GIVTAB,E=LUPERK                                 @SC87117 02351000
         B     LOOP0                                           @SC87117 02352000
*                                                                       02353000
LUPTAK   BAL   9,LUPTINS     Look for file                     @SC86295 02354000
           B   LUPFNF        Not found                         @SC86295 02355000
         MVI   ERRNUM,ERRNOE No error                          @SC86295 02356000
         B     LOOP          OK                                @SC86295 02357000
*                                                                       02358000
LUPTIN   STM   1,2,SCANPTR   Set up scan                       @SC86295 02359000
LUPTINS  SR    0,0           Flags for TAKE parsing            @SC86295 02360000
         KCALL FSPEC,FILNAM  Get filespec                      @SC86295 02361000
         BAL   14,LUPCKFN                                      @SC86295 02362000
         LR    3,9           Save return                       @SC86295 02363000
         BAL   14,LUPCNF     Check for illegal extras          @SC86295 02364000
         LR    9,3                                             @SC86295 02365000
         PTEXT 'Past maximum nesting level for TAKE command'            02366000
         L     5,TAKLEV      Current TAKE level                @SC86295 02367000
         LA    14,TAKMAX                                       @SC86295 02368000
         CR    5,14                                            @SC86295 02369000
         BNL   LUPINV                                          @SC86239 02370000
         SLA   5,2           Offset into table                 @SC86295 02371000
         LA    5,TAKTAB(5)   Point into table of TAKE files    @SC86295 02372000
         PTEXT 'File not found' In case of error                        02373000
         MVI   ERRNUM,ERRFNF In case of error                  @SC86171 02374000
         OPENF I,FILNAM,TAKFDB,0(5),E=0(9)                     @SC86295 02375000
         PTEXT 'TAKE file loop'                                @SC86239 02376000
         USING FDBD,1                                          @SC86295 02377000
         TM    FDBFLGS,FDBACTV Check for file active already   @SC86295 02378000
         DROP  1                                               @HF86232 02379000
         BZ    LUPTIOK                                         @SC86295 02380000
         CLOSF (5)                                             @SC86295 02381000
         BR    9                                               @SC86295 02382000
LUPTIOK  L     3,TAKLEV      Get current take level                     02383000
         LA    3,1(3)        And increment                              02384000
         ST    3,TAKLEV                                                 02385000
         B     4(9)                                            @SC86295 02386000
*                                                                       02387000
LUPCKFN  LTR   15,15                                           @SC86295 02388000
         BZR   14            No problem, R15=0                 @SC86295 02389000
         BCT   15,LUPINV     Error, R15>1                      @SC86295 02390000
         B     LUPWRTE       Help requested, R15=1             @SC86295 02391000
*                                                                       02392000
LUPSTA   BAL   14,LUPCNF     Check for illegal extras          @SC86295 02393000
         MVC   ERRNUM,OLDERR Restore from last command         @SC86158 02394000
         KCALL STATUS        Write error message               @SC86156 02395000
         B     LOOP0                                           @SC86295 02396000
*                                                                       02397000
LUPSPA   KCALL DSPACE                                          @SC86164 02398000
         B     LOOP0                                           @SC86295 02399000
*                                                                       02400000
LUPDMP   KCALL DUMP,E=LUPERK Dump translation table            @SC86156 02401000
         B     LOOP0                                           @SC86295 02402000
*                                                                       02403000
LUPHSTI  DS    0H                                              @SC86295 02404000
         AIF   ('&TYPCMD' EQ 'TYPE').TYPOK                     @SC86295 02405000
         MVC   0(,6),=CL16'&TYPCMD' Use right name             @SC86295 02406000
         EX    7,*-6                                           @SC86295 02407000
.TYPOK   A     7,LEN         Add remaining to token length              02408000
         LA    5,2(7)        Plus one for separator            @SC86171 02409000
         STM   5,6,SCANPTR   Reset for tokenizer               @SC86171 02410000
LUPHST   PTEXT 'Specify a &KSYS command to issue'              @SC86295 02411000
         FTOKN H=LUPWRTE,N=LUPINV Point to command             @SC86239 02412000
         LA    1,3           Execute host command              @SC86316 02413000
LUPSYS   OI    FL4,UCMD      User command, check for EXEC's    @SC86316 02414000
         PTEXT 'Illegal system command'                        @SC86295 02415000
         KCALL SUPFNC,E=(LUPWRTE,M) Execute it                 @SC86295 02416000
         B     LOOP                                                     02417000
         AIF   ('&KSYS' NE 'CMS').CM1Z                         @SC86355 02418000
*                                                                       02419000
LUPCP    PTEXT 'Specify a CP command to issue'                          02420000
         FTOKN N=LUPINV,H=LUPWRTE                              @SC86295 02421000
         LR    0,7                                             @SC86295 02422000
         LA    1,4                                             @SC86295 02423000
         B     LUPSYS                                          @SC86295 02424000
.CM1Z    ANOP                                                           02425000
*                                                                       02426000
LUPCNF   FTOKN N=0(14),H=LUPCRH                                @SC86295 02427000
         PTEXT 'Extra operand'                                 @SC86295 02428000
         B     LUPINV                                          @SC86295 02429000
LUPCRH   PTEXT 'No operands needed'                            @SC86295 02430000
         B     LUPWRTE                                         @SC86295 02431000
         DROP  13                                                       02432000
XONCHAR  DC    AL1(XON)                                        @SC86121 02433000
GRDATA   DC    X'&S1CMD',X'70'                                 @SC87215 02434000
GRDL     EQU   *-GRDATA                                        @SC87215 02435000
XLFCT    DC    A(KMAXF)      Extended packet size base         @SC86202 02436000
AKMIN    DC    A(KMIN)       Packet min size                   @SC86295 02437000
AMAXWT   DC    A(MAXWT)      Longest terminal write            @SC86295 02438000
AMAXRT   DC    A(MAXRT)      Longest terminal read             @SC86295 02439000
F64KP    DC    A(((&MAXLR+7+5+4)/8)*8) Size of disk buffers    @SC87351 02440000
F0       DC    F'0'                                                     02441000
F1       DC    F'1'                                                     02442000
F2       DC    F'2'                                                     02443000
F3       DC    F'3'                                            @SC86295 02444000
F4       DC    F'4'                                            @SC86295 02445000
F5       DC    F'5'                                                     02446000
F8       DC    F'8'                                                     02447000
F12      DC    F'12'                                                    02448000
F64      DC    F'64'                                                    02449000
BLANK    EQU   F64+3         EBCDIC blank                      @SC86295 02450000
F        DC    F'15'                                                    02451000
MOD64    DC    F'63'                                                    02452000
F256     DC    F'256'                                                   02453000
SPACE    DC    A(ABL)                ASCII SPACE                        02454000
         ADCON CRCCLC,CWDSET,DECODE,DISKIO,DSPACE,DUMP                  02455000
         ADCON ENCODE,ERPACK,ERRTAB,FSPEC,GENCMD,GIVTAB,INBUF           02456000
         ADCON INTINI,KHELP,NPREAD,OUTBUF,RECEIV                        02457000
         ADCON RIO,RPACK,RPAR,RPARSET,SCRNIO,SEND                       02458000
         ADCON SERVER,SET,SETMSG,SHOW                                   02459000
         ADCON SIO,SPACK,SPAR,SPARSET,STATUS,SUPFNC,TERMIO              02460000
         ADCON USNTRF                                                   02461000
LOBIT    DC    X'0000007F'                                              02462000
* Parameter defaults.  Must map directly into DEFPARM etc.              02463000
         KSYSTF ,                                              @SC86295 02464000
         DS    0F --------Init for LOG file                    @SC86295 02465000
         DC    A(0)          Buffer ptr                        @SC86295 02466000
         DC    A(LPKT)       Buffer length                     @SC86295 02467000
         DC    C'V',X'00'    RECFM, FLGS                       @SC86295 02468000
         DC    Y(LPKT)       LRECL                                      02469000
         FDBPAT ,                                              @SC86316 02470000
         DS    0F --------Init for SEND/RECEIVE file           @SC86295 02471000
         DC    A(0)          Addr of FSWRITE buffer            @SC86295 02472000
MAXLRC   DC    F'&MAXLR'     Max lrecl                         @SC86316 02473000
         DC    C'V',X'00'    RECFM,FLGS                        @SC86295 02474000
         DC    H'80'         Lrecl for disk write              @SC86295 02475000
         FDBPAT ,                                              @SC86316 02476000
         DS    0F --------Init for TAKE file (read-only)       @SC86295 02477000
         DC    A(0)          Buffer ptr (CMD)                  @SC86295 02478000
         DC    F'256'        Max buffer size                   @SC86295 02479000
         DC    C'V',X'00'    RECFM, FLGS                       @SC86295 02480000
*                                                                       02481000
IMAXTNT  DC    F'16'         Retry limit during setup          @SC86345 02482000
IMAXTRY  DC    F'5'          Retry limit during transfer       @SC86164 02483000
ILCLDLY  DC    F'10'         Time to wait before sending       @SC86164 02484000
IRPSIZ   DC    A(KMAX)       Max receive size                  @SC86295 02485000
AKMAX    EQU   IRPSIZ,4      Normal packet maximum             @SC86295 02486000
ISPSIZ   DC    A(KDEF)       Max send size                     @SC86295 02487000
IMAXOUT  DC    F'&MAXLR'     Max output buffer                 @SC86268 02488000
ITRMLIN  DC    CL8' '        Current data line                 @SC87166 02489000
ITYPFIL  DC    C'T'          Type of file (T,B,V,D),see BINF   @SC86151 02490000
IDEFPRM  DC    AL1(KDEF+ABL,ABL,ABL,64,CR+ABL,A#,AN,A1,ABL,ABL) SC86149 02491000
         DC    AL1(ABL,ABL,ABL,ABL)  Extended size defaults    @TB86196 02492000
         DC    X'0'          Capabilities of micro      RCAPA  @SC86295 02493000
         DC    X'8'          Capabilities I have        SCAPA  @SC86295 02494000
LONGP    EQU   X'02'         LONGP bit in CAPAS flags          @TB86196 02495000
MORCAPAS EQU   X'01'         More CAPAS bytes exist            @TB86196 02496000
         DC    AL1(CR)       EOL char I need (cr)       REOL   @SC86295 02497000
         DC    AL1(CR)       EOL I'll send              SEOL   @SC86295 02498000
         DC    AL1(SOH)      Incoming pkt start char    RMARK  @SC86295 02499000
         DC    AL1(SOH)      Outbound pkt start char    SMARK  @SC86295 02500000
         DC    AL1(A#)       Micro's ctl-quote char     RCTLQ  @SC86295 02501000
         DC    AL1(A#)       Ctl-quote char we'll use   SCTLQ  @SC86295 02502000
         DC    AL1(AAMP)     Orig 8-bit quote char      EBQC   @SC86295 02503000
         DC    AL1(5)        Time limit - micro to wait RTIMO  @SC86295 02504000
         DC    AL1(0)        Timeout, if we can do it   TIMOUT @SC86295 02505000
         DC    AL1(1)        User requested chk type    BCTC   @SC86295 02506000
         DC    AL1(ATIL)     Original repeat prefix     RPTQC  @SC86295 02507000
         DC    A(0,S1ORDL+2) For sending prompt         S1XOPL @SC87274 02508000
         DC    X'&S1CMD',AL1(SBA),X'5D7F',AL1(SBA),X'0005' ON  @SC87274 02509000
         DC    AL1(CR)       In case micro lost one     S1EOL  @SC87274 02510000
         DC    AL1(XON)      Handshake for micro        S1HND  @SC87274 02511000
MAXBSZ   DC    F'&MAXBS'     Max blksiz                        @SC86268 02512000
BUFSIZ   DC    Y(LPKT)       Length of packet buffers          @SC86190 02513000
*                                                                       02514000
* Constants for COMMON                                                  02515000
         LTORG                                                          02516000
* Translation for conversion to hex notation                   @SC86156 02517000
TRHEX    EQU   *-240                                           @SC86156 02518000
         DC    C'0123456789ABCDEF'                             @SC86156 02519000
* ASCII to EBCDIC translate table                                       02520000
ATOED    DC    X'00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F'       02521000
         DC    X'10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F'       02522000
         DC    X'40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61'       02523000
         DC    X'F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F'       02524000
         DC    X'7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6'       02525000
         DC    X'D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D'       02526000
         DC    X'79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96'       02527000
         DC    X'97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07'       02528000
         DC    X'00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F'       02529000
         DC    X'10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F'       02530000
         DC    X'40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61'       02531000
         DC    X'F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F'       02532000
         DC    X'7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6'       02533000
         DC    X'D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D'       02534000
         DC    X'79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96'       02535000
         DC    X'97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07'       02536000
* EBCDIC to ASCII translate table                                       02537000
ETOAD    DC    X'00,01,02,03,00,09,00,7F,00,00,00,0B,0C,0D,0E,0F'       02538000
         DC    X'10,11,12,13,00,00,08,00,18,19,00,00,1C,1D,1E,1F'       02539000
         DC    X'00,00,00,00,00,0A,17,1B,00,00,00,00,00,05,06,07'       02540000
         DC    X'00,00,16,00,00,00,00,04,00,00,00,00,14,15,00,1A'       02541000
         DC    X'20,00,00,00,00,00,00,00,00,00,5C,2E,3C,28,2B,7C'       02542000
         DC    X'26,00,00,00,00,00,00,00,00,00,21,24,2A,29,3B,5E'       02543000
         DC    X'2D,2F,00,00,00,00,00,00,00,00,7C,2C,25,5F,3E,3F'       02544000
         DC    X'00,00,00,00,00,00,00,00,00,60,3A,23,40,27,3D,22'       02545000
         DC    X'00,61,62,63,64,65,66,67,68,69,00,7B,00,00,00,00'       02546000
         DC    X'00,6A,6B,6C,6D,6E,6F,70,71,72,00,7D,00,00,00,00'       02547000
         DC    X'00,7E,73,74,75,76,77,78,79,7A,00,00,00,5B,00,00'       02548000
         DC    X'00,00,00,00,00,00,00,00,00,00,00,00,00,5D,00,00'       02549000
         DC    X'7B,41,42,43,44,45,46,47,48,49,00,00,00,00,00,00'       02550000
         DC    X'7D,4A,4B,4C,4D,4E,4F,50,51,52,00,00,00,00,00,00'       02551000
         DC    X'5C,00,53,54,55,56,57,58,59,5A,00,00,00,00,00,00'       02552000
         DC    X'30,31,32,33,34,35,36,37,38,39,7C,00,00,00,00,00'       02553000
* Table to remove 8th bit (overlaps LOCASE following)          @SC87253 02554000
OFF80    DC    128AL1(*-OFF80)                                 @SC87253 02555000
* Table to convert EBCDIC text to lower case                            02556000
LOCASE   DC    192AL1(*-LOCASE)                                @SC86209 02557000
         DC    X'C0,81,82,83,84,85,86,87,88,89,CA,CB,CC,CD,CE,CF'       02558000
         DC    X'D0,91,92,93,94,95,96,97,98,99,DA,DB,DC,DD,DE,DF'       02559000
         DC    X'E0,E1,A2,A3,A4,A5,A6,A7,A8,A9,EA,EB,EC,ED,EE,EF'       02560000
         DC    016AL1(*-LOCASE)                                @SC86209 02561000
         TITLE 'Variable storage for Kermit-370'                        02562000
STORAG   DSECT                                                          02563000
* - - - Translate tables (user-settable or program-modified)            02564000
TRTBL    DS    CL256         For finding blanks                @SC86295 02565000
ATOE     DS    CL256         For converting to EBCDIC          @SC86295 02566000
ETOA     DS    CL256         For converting to ASCII           @SC86295 02567000
TATOE    DS    CL256         For converting packets to EBCDIC  @SC87117 02568000
TETOA    DS    CL256         For retrieving input ASCII        @SC87117 02569000
UPCASE   DS    CL256         For upcasing EBCDIC               @SC86295 02570000
*OFF80    DS    CL256         For removing x'80' bits          @SC87253 02571000
* - - - Variables initialized to zeroes                                 02572000
SCANPTR  DS    0D            Len and address of parse buffer            02573000
LEN      DS    F                                                        02574000
ADR      DS    F                                                        02575000
SCANSV   DS    D             Saved len and adr                 @SC86295 02576000
CMD      DS    CL256         Buffer                            @SC86121 02577000
CBUF     DS    A             Address of CP response buffer     @SC86121 02578000
DATL     DS    F             Send packet size                  @SC86121 02579000
FDATE    DS    F             Date of current file              @SC86295 02580000
KBYTES   DS    F             Size of current file              @SC86158 02581000
* Program flags                                                @SC86316 02582000
FL1      DS    X                                               @SC86316 02583000
TSTF     EQU   X'80'         Special option for debugging      @SC86295 02584000
ROVR     EQU   X'40'         Overwrite sent filename                    02585000
REN      EQU   X'20'         Rename incoming file                       02586000
NAK0     EQU   X'10'         Send NAK during Resend                     02587000
NAME     EQU   X'08'         Encoding/decoding a name                   02588000
BINF     EQU   X'04'         Binary data                                02589000
EOF      EQU   X'02'         End-of-file                                02590000
DEBUG    EQU   X'01'         Debug mode ON                              02591000
FL2      DS    X                                               @SC86316 02592000
TABS     EQU   X'40'         Expand tabs                                02593000
EOFZ     EQU   X'20'         Truncate at ^Z for EOF                     02594000
SRV      EQU   X'10'         In SERVER mode                             02595000
PASS     EQU   X'08'         Try 'illegal' cmds on system      @SC86295 02596000
ECHO     EQU   X'04'         Echo TAKE files                   @SC86171 02597000
PROTO    EQU   X'02'         Line ready for transfers          @SC86295 02598000
DAT8     EQU   X'01'         8-bit data line                   @SC86316 02599000
FL3      DS    X                                               @SC86316 02600000
PXCH     EQU   X'20'         Parameters exchanged              @SC86152 02601000
APPN     EQU   X'10'         Append to existing files          @SC86203 02602000
FL4      DS    X                                               @SC86316 02603000
TTAB     EQU   X'80'         Use separate tables for terminal  @SC87117 02604000
SFM      EQU   X'20'         Sending from memory               @SC86158 02605000
TXT      EQU   X'10'         Xmitting text to micro            @SC86158 02606000
NPS      EQU   X'08'         Xmitting without protocol         @SC86165 02607000
UCMD     EQU   X'02'         User command entered              @SC86158 02608000
NMOK     EQU   X'01'         Filename collsion already checked @SC87012 02609000
FL5      DS    X                                               @SC86316 02610000
CMERR    EQU   X'80'         Syntax error on last command      @SC86171 02611000
TKHLT    EQU   X'40'         Quit TAKE file on error           @SC86171 02612000
TIMF     EQU   X'20'         Enable packet-reception timer     @SC86355 02613000
KEEP     EQU   X'10'         Keep incomplete files             @SC86225 02614000
SALL     EQU   X'08'         Search all disks for SEND         @SC86209 02615000
TKMSG    EQU   X'04'         Already issued TAKE error msg     @SC86239 02616000
*                                                                       02617000
SEQ      DS    X             Current pkt number                @SC86135 02618000
RSN      DS    X             Received pkt number               @SC86135 02619000
TRMFLG   DS    X             Flag(s) for terminal I/O          @SC87275 02620000
TRMTP    DS    C             Type of terminal line             @SC87166 02621000
RBUF     DS    A             Addr of FSREAD buffer             @SC86121 02622000
CLEN     DS    A             Length of non-tokenized parm      @SC86121 02623000
NSENT    DS    F             Number of files sent              @SC86121 02624000
TSENT    DS    F             Pointer to sent files table       @SC86121 02625000
IOERC    DS    F             Error count to detect loops       @SC86158 02626000
TXTPTR   DS    2F            Ptrs to start and end of text     @SC86158 02627000
RBUFL    DS    F             Record len (if recfm = V)         @SC86121 02628000
RDWLEN   DS    F             Record descriptor length          @SC86151 02629000
SNDPKL   DS    F             SNDPKT length for I/O             @SC86295 02630000
RCVPKL   DS    F             RCVPKT length after I/O           @SC86295 02631000
APKT     DS    A             Ptr to packet buffer              @SC86190 02632000
ASPKT    DS    A             Ptr to effective send packet      @SC86190 02633000
AASPKT   DS    A             Ptr to send packet                @SC86190 02634000
ASDATA   DS    A             Ptr to data to send               @SC86190 02635000
ARPKT    DS    A             Ptr to receive packet buffer      @SC86190 02636000
ARDATA   DS    A             Ptr to received data              @SC86190 02637000
FILPTR   DS    A             Ticket for FILNAM file I/O        @SC86295 02638000
LOGPTR   DS    A             Ticket for LOG file I/O           @SC86295 02639000
DBGTYP   DS    A             Ptr to translation table          @SC86316 02640000
TOUTOT   DS    2F            I*8 count of bytes sent           @SC86295 02641000
TINTOT   DS    2F            I*8 count of bytes received       @SC86295 02642000
DSKTOT   DS    2F            I*8 count of disk I/O bytes       @SC86295 02643000
PAKCNT   DS    F             Number of packets sent/received   @SC86295 02644000
RTRCNT   DS    F             Number of retries                 @SC86295 02645000
SECTOT   DS    F             Duration of transfer (sec)        @SC86295 02646000
CSECTOT  DS    F             Duration of transfer (csec)       @SC86345 02647000
RECTRC   DS    F             Count of record truncations       @SC87268 02648000
LSTATS   EQU   *-TOUTOT      Size of area to initialize        @SC86295 02649000
PREFIX   DS    X,CL(FORMAXL) Prefix count and buffer           @HF86223 02650000
SUFFIX   DS    X,CL(FORMAXL) Suffix count and buffer           @HF86223 02651000
JFSPEC   DS    X             Length of foreign filespec        @SC86224 02652000
JFNAM    DS    CL47          Filespec                          @SC86224 02653000
FILNAM   DS    CL(LFID)      SEND/REC filename                 @SC86295 02654000
         DS    0F                                              @SC86295 02655000
IFILE    DS    CL(LFID)      Name of file(s) to send           @SC86295 02656000
LIMTRY   DS    F             Max packet retries                         02657000
FREEDW   DS    F             Size of aux. storage              @SC86295 02658000
FREEPTR  DS    A             Ptr to aux. storage               @SC87286 02659000
STKPTR   DS    F             Current stack end                 @SC86295 02660000
STKLIM   DS    F             End of stack storage              @SC86295 02661000
EVCTR    DS    F             Count of files opened             @SC86295 02662000
EMSGP    DS    A             Ptr to micro message              @BS86090 02663000
EMSGL    DS    F             Length of msg                     @BS86090 02664000
LEMSG    EQU   80            Max msg length kept               @SC87338 02665000
LMARG    DS    F             Left margin for SEND (0=>none)    @SC87253 02666000
RMARG    DS    F             Right margin (0=>none)            @SC87253 02667000
RBUFP    DS    F             RBUF pointer                               02668000
WBUFL    DS    F             Data length in WBUF                        02669000
MAXSIZ   DS    2A(KDEF-16)   Max pkt size sent                          02670000
ORGR0    DS    F             Saved R0 at main entry            @SC87253 02671000
ORGR1    DS    F             Saved R1 at main entry            @SC86295 02672000
*  Plists for reading and writing in protocol mode                      02673000
S1WRPL   DS    2F            Address, length of data to send   @SC86295 02674000
S1RDPL   DS    A(0,LPKT+3)   For reading data (max length)     @SC86295 02675000
*                                                                       02676000
TYWRPL   DS    2F            Address, length of data to send   @SC86295 02677000
TYRDPL   DS    A(0,LPKT)     For reading data (max length)     @SC86295 02678000
*                                                                       02679000
RIOC     DS    F             Saved data length from prev read  @SC86295 02680000
PREV     DS    C             Previous char decoded                      02681000
* - - - Variables initialized via block MVC's                           02682000
         KSYSTF ,                                              @SC86295 02683000
* Specifications for LOG file                                  @SC86295 02684000
LOGFDB   DS    0F                                              @SC86295 02685000
LOGBUF   DS    A             Buffer ptr                        @SC86295 02686000
         DS    A(LPKT)       Buffer size                       @SC86295 02687000
         DS    C'V'          RECFM                             @SC86295 02688000
LOGFLGS  DS    X'00'                                           @SC86295 02689000
         DS    Y(LPKT)       LRECL                             @SC86295 02690000
        FDBPAT LOG           Default disk volume, unit, etc.   @SC86316 02691000
* Specifications for SEND/RECEIVE file                         @SC86295 02692000
FILFDB   DS    0F                                              @SC86295 02693000
WBUF     DS    A,F           Adr,length of FSWRITE buffer      @SC86121 02694000
RFM      DS    C'V'          Default recfm for disk write               02695000
FILFLGS  DS    X'00'                                           @SC86295 02696000
LRECL    DS    H'80'         Lrecl for disk write                       02697000
        FDBPAT FIL           Default disk volume, unit, etc.   @SC86316 02698000
* Specifications for TAKE file (read-only)                     @SC86295 02699000
TAKFDB   DS    0F                                              @SC86295 02700000
TAKBUF   DS    A             Buffer ptr (CMD)                  @SC86295 02701000
         DS    F'256'        Max buffer size                   @SC86295 02702000
         DS    C'V'          RECFM                             @SC86295 02703000
         DS    X'00'                                           @SC86295 02704000
*                                                                       02705000
MAXTNT   DS    F'16'         Retry limit during setup          @SC86345 02706000
MAXTRY   DS    F'5'          Retry limit during transfer       @SC86164 02707000
LCLDLY   DS    F'10'         Time to wait before sending       @SC86164 02708000
RPSIZ    DS    A(KMAX)       Max receive size                  @SC86295 02709000
SPSIZ    DS    A(KDEF)       Max send size                     @SC86295 02710000
MAXOUT   DS    F'&MAXLR'     Max output buffer                 @SC86268 02711000
TRMLIN   DS    CL8' '        Current data line                 @SC87166 02712000
TYPFIL   DS    C'T'          Type of file (T,B,V,D),see BINF   @SC86151 02713000
*                                                                       02714000
DEFPARM  DS    AL1(KDEF+ABL,ABL,ABL,64,CR+ABL,A#,AN,A1,ABL,ABL) SC86149 02715000
         DS    AL1(ABL,ABL,ABL,ABL)  Extended size defaults    @TB86196 02716000
RCAPA    DS    X'0'          Capabilities of micro             @SC86149 02717000
SCAPA    DS    X'8'          Capabilities I have (A-packets)   @SC86149 02718000
REOL     DS    AL1(CR)       EOL char I need (cr)                       02719000
SEOL     DS    AL1(CR)       EOL I'll send                              02720000
RMARK    DS    AL1(SOH)      Incoming pkt start char                    02721000
SMARK    DS    AL1(SOH)      Outbound pkt start char                    02722000
RCTLQ    DS    AL1(A#)       Micro's ctl-quote char                     02723000
SCTLQ    DS    AL1(A#)       Ctl-quote char we'll use                   02724000
EBQC     DS    AL1(AAMP)     Orig 8-bit quote char                      02725000
RTIMO    DS    AL1(5)        Time limit - micro to wait for us @SC86164 02726000
TIMOUT   DS    AL1(0)        Timeout, if we can implement it   @SC86164 02727000
BCTC     DS    AL1(1)        User requested chksum length               02728000
RPTQC    DS    AL1(ATIL)     Original repeat prefix                     02729000
S1XOPL   DS    A(0,S1ORDL+2) For sending prompt                @SC87274 02730000
S1XON    DS    X'&S1CMD',AL1(SBA),X'5D7F',AL1(SBA),X'0005'     @SC87274 02731000
S1ORDL   EQU   *-S1XON                                         @SC86295 02732000
S1EOL    DS    AL1(CR)       In case micro lost one            @SC87274 02733000
S1HND    DS    AL1(XON)      Handshake for micro               @SC87274 02734000
LDEFS    EQU   *-DEFS                                          @SC86295 02735000
*                                                                       02736000
S1DATA   DS    XL(S1ORDL)    Write or write/read orders        @SC86295 02737000
WRRD     EQU   *-1           Zap this to 0 for just write      @SC86295 02738000
*                   ... but ONLY if we really won't read again @SC87343 02739000
SVHND    DS    X             Saved value of HANDSHAKE char     @SC87343 02740000
* - - - Initialized to zeroes                                           02741000
RPTQ     DS    X             Repeat prefix                              02742000
EBQ      DS    X             8-bit quoting char (off)                   02743000
BCTU     DS    X             Checksum length in use                     02744000
BCTR     DS    X             Other Kermit's chksum length               02745000
RPADN    DS    X             Receive padding count                      02746000
SPADN    DS    X             Send pad count                    @SC86164 02747000
RPADC    DS    X             Receive pad char                           02748000
SPADC    DS    X             Send pad char                     @SC86164 02749000
TMP      DS    X                                                        02750000
TMPDW    DS    D             Work double word                           02751000
FSIZE    DS    F             Record length                     @SC86203 02752000
FRECF    DS    C             Record format flag                @SC86151 02753000
STYPE    DS    C             Type of packet sent               @SC86295 02754000
RTYPE    DS    C             Type of packet received           @SC86295 02755000
ERRNUM   DS    X             Error number                      @SC86156 02756000
OLDERR   DS    X             Saved error number in loop        @SC86171 02757000
REASON   DS    X             Reason for rejecting A-pkt        @SC86316 02758000
OPRND    DS    CL32          Upcased operand for table lookup  @SC87034 02759000
TCTLQ    DS    X             XECHO control character escape    @SC86165 02760000
TABTBL   DS    XL20          Tab stops                         @SC86355 02761000
TABCNT   DS    H             Current number of tabs            @SC86355 02762000
         KSYSVAR ,           Specific variables                @SC87012 02763000
         DS    0D                                              @SC86295 02764000
STODWDS  EQU   (*-STORAG)/8                                    @SC86295 02765000
         TITLE 'ERRMSG - List of error messages'               @SC86135 02766000
* Table of error messages                                      @SC86156 02767000
         MSGDF NOE,'No errors'                    Err #0       @SC86156 02768000
         MSGDF NFT,'No file transfers yet'        Err #1       @SC86156 02769000
         MSGDF TRC,'Transfer cancelled'           Err #2       @SC86156 02770000
         MSGDF USC,'Invalid server command'       Err #3       @SC86156 02771000
         MSGDF TIE,'Terminal I/O error'           Err #4       @SC86156 02772000
         MSGDF BPC,'Bad packet count or chksum'   Err #5       @SC86156 02773000
         MSGDF IPS,'Invalid packet syntax'        Err #6       @SC86158 02774000
         MSGDF IPT,'Invalid packet type'          Err #7       @SC86156 02775000
         MSGDF MIS,'Lost a packet'                Err #8       @SC86156 02776000
         MSGDF NAK,'Micro sent a NAK'             Err #9       @SC86156 02777000
         MSGDF ABO,'Micro aborted'                Err #10      @SC86156 02778000
         MSGDF FNE,'Invalid file name'            Err #11      @SC86156 02779000
         MSGDF FNF,'File not found'               Err #12      @SC86156 02780000
         MSGDF FUL,'Disk or file is full'         Err #13      @SC86345 02781000
         MSGDF DIE,'Disk I/O error'               Err #14      @SC86345 02782000
         MSGDF MOP,'Missing operand'              Err #15      @SC86158 02783000
         MSGDF SYS,'Illegal system command'       Err #16      @SC86268 02784000
         MSGDF KCE,'Kermit command error'         Err #17      @SC86171 02785000
         MSGDF TIM,'No packet received'           Err #18      @SC86355 02786000
         MSGDF RTR,'Records truncated'            Err #19      @SC87268 02787000
         MSGDF COM,'Bad communication line'       Err #20      @SC87300 02788000
