*COPY                                                 IK0COM            01800000
         CHECKVER IK0COM,4.3                                   @SC90072 01800500
         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
*                                                                       01817060
* Get TOD in R0; clobber R1,R15,TMPDW; return via R14          @SC91172 01817120
ACCTTOD  STCK  TMPDW         Get time in timer units           @SC91172 01817180
         LM    0,1,TMPDW                                       @SC91172 01817240
         SRDL  0,12          Convert to microsec               @SC91172 01817300
         D     0,=F'4000000' 4-sec chunks + remainder          @SC91172 01817360
         LR    15,0          Save remainder                    @SC91172 01817420
         SR    0,0                                             @SC91172 01817480
         SLDL  0,2           Convert back to seconds           @SC91172 01817540
         SRL   15,20         Convert remainder also            @SC91172 01817600
         ALR   1,15          Add back in                       @SC91172 01817660
         BC    12,*+8                                          @SC91172 01817720
          AL   0,F1                                            @SC91172 01817780
         D     0,=F'86400'   Get time of day in seconds        @SC91172 01817840
         BR    14                                              @SC91172 01817900
*                                                                       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
*                                                              @SC92030 01830100
* Test if line mode terminal type: return with skip if not     @SC92030 01830200
TTYCHK   CLI   TRMTP,C'T'                                      @SC92030 01830300
         BER   14            No skip if TTY                    @SC92030 01830400
         CLI   TRMTP,C'F'                                      @SC92030 01830500
         BER   14            Go if full-screen non-transparent @SC92030 01830600
         CLI   TRMTP,C'V'                                      @SC92030 01830700
         BER   14            Go if VTAM TTY                    @SC92030 01830800
         B     4(,14)                                          @SC92030 01830900
*                                                                       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 DS    0H                                              @SC88074 01847000
         IC    4,RTYPE       Test byte                         @SC86158 01848000
         TM    FL3,ZPRO                                        @SC88074 01848200
         BO    INPUTQRT      Must stop pronto                  @SC88074 01848400
         MVI   ERRNUM,ERRIPT Assume bad packet type            @SC88074 01848600
         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 MVC   ERRNUM,RPKERN RPACK error: get code             @SC89219 01867000
         CLI   STYPE,AB                                        @SC88168 01867500
         BNE   INPUTRTY              Retry if not a BRK pkt             01868000
INPUTACK MVI   RTYPE,AY      Fake an ACK                       @SC88092 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
         IC    2,SEQ         Expected packet number            @SC88092 01875100
         LA    2,1(2)                                          @SC88092 01875200
         N     2,MOD64       Get next number                   @SC88092 01875300
         CLM   2,1,RSN       Is that what we got?              @SC88092 01875400
         BE    INPUTACK      Yes, treat as an ACK              @SC88092 01875500
INPUTRTY BAL   2,SENDRTY     Resend to the limit               @SC86276 01876000
         B     INPUTLUP              And interpret response             01877000
*                                                                       01878000
INPUTERR CLI   STYPE,AI      Trying to send I packet?          @SC89263 01879000
         BE    IPKSKP        Ok, other Kermit too stupid       @SC89263 01879300
         MVI   ERRNUM,ERRABO Micro aborted                     @SC89263 01879600
         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),ATOED Convert to EBCDIC              @SC89301 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    FL5,NAK0                                        @SC90037 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     12(8)         Skip over 3-entry table           @SC88074 01948000
IPKSKP   XC    DATL,DATL     Pretend we got an empty ACK       @SC89263 01948300
         BR    9             ... and resume above              @SC89263 01948600
*                                                                       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
         MVI   BRK,C' '      Init break char                   @SC88306 01968500
*                                                                       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
         LTR   6,6           Did we run off the end?           @SC88306 01981200
         BM    *+10          Yes, nothing left                 @SC88306 01981400
          MVC  BRK,0(7)      No, keep the break char for ref.  @SC88306 01981600
         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
*   If R15 changed, it points to first non-numeric character            01999000
GETNUM   LTR   4,7           Copy length                       @SC86316 01999200
         BNPR  14            Nothing, skip it                  @SC89218 01999400
         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
*  R6->word, R7=length-1, R1->table.  Clobbers R14,R15         @SC90239 02027500
*  hi byte of R7 is a flag for just lookup and return          @SC91320 02027600
*  2nd byte of R7 is a code to look up (not word vs name)      @SC91320 02027700
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   KWLEN(1),254                                    @SC90239 02033000
         BH    4(14)         Return to caller if end           @SC88168 02034000
         BL    *+12          Not a branch to new list          @SC88168 02035000
          ICM  1,7,KWADR(1)  Yes, get ptr to new list          @SC90239 02036000
          B    SCANLUP       And resume search                 @SC87117 02037000
         CLM   7,4,F0                                          @SC91320 02037600
         BNE   SCANCODE      Signal for checking the codes     @SC91320 02038200
         CLM   7,1,KWMIN(1)  Compare token length vs min abbr  @SC90239 02039000
         BL    SCANNO                Go if < min                        02040000
         CLM   7,1,KWLEN(1)  Compare token and kw lengths      @SC90239 02041000
         BH    SCANNO                Go if length of token > kw's       02042000
         EX    7,SCANCLC                                                02043000
         BE    SCANYES                                                  02044000
SCANNO   IC    15,KWLEN(,1)  KW length - 1                     @SC90239 02045000
         LA    1,KWNAME+1(15,1)   Space over name to next item @SC90239 02046000
         B     SCANLUP       Continue checking                          02047000
*                                                                       02048000
SCANCODE CLM   7,4,KWCODE(1) The right code?                   @SC91320 02048300
         BNE   SCANNO                                          @SC91320 02048600
SCANYES  CLM   7,8,F0        Flagged just to find entry?       @SC86355 02049000
         BNER  14            Yes, got it                       @SC86355 02050000
         ICM   14,7,KWADR(1) No, get handler address           @SC90239 02052000
         BR    14                                                       02053000
*                                                                       02054000
SCANCLC  CLC   KWNAME(,1),OPRND Compare token to KW            @SC90239 02055000
*                                                                       02056000
* Utility routine to set up linkage                                     02057000
SUBENT   LR    KSUBBASE,15   CSECT addressibility              @SC89268 02058000
         KTRACE SUBENT                                         @LM91008 02058200
         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
         CL    0,STKHI                                         @SC89089 02063200
         BNH   *+8                                             @SC89089 02063400
          ST   0,STKHI       New high limit of stack usage     @SC89089 02063600
         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
         MVC   BCTOFF,F0     (and flag)                        @SC92085 02082200
         ST    0,KAFUNC      Save for KACCT call               @AB89191 02082500
         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
         ICM   15,15,KAEXIT  R15 -> stats exit routine         @AB89191 02096100
         BZ    RTRN0         0 ==> no exit supplied            @AB89191 02096200
         L     0,KAFUNC      R0 = SEND/RECEIVE indicator       @AB89191 02096300
         LA    1,NSENTAC     R1 -> file transfer statistics    @AB89191 02096400
         LA    2,TRMLIN      R2 -> current LINE definition     @AB89191 02096500
         BALR  14,15         Call accounting exit              @AB89191 02096600
         B     RTRN0                                           @SC86295 02097000
         WXTRN KACCT                                           @AB89191 02097200
KAEXIT   DC    AL4(KACCT)    Accounting exit (if supplied)     @AB89191 02097400
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
         KTRACE EXIT                                           @LM91008 02110200
         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
         MVI   LCKOLD,0      Start at normal state             @SC91275 02125300
         MVI   DECESCP,0                                       @SC91275 02125600
         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
         MVI   LCKOLD,0      Start at normal state             @SC91275 02132500
         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
         LTR   15,15         Did it work?                      @SC89072 02135300
         BP    INPUTABR      No, something awful happened      @SC89072 02135600
         BR    9                                               @SC86295 02136000
*                                                                       02137000
* Subroutine to display the contents of the KW tables                   02138000
* R1->table.  Clobbers 1,2,3,4,7,15.  Return via R14           @SC90239 02138500
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 '&ONEFOLL'                                      @SC92300 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   KWLEN(4),254                                    @SC90239 02147000
         BH    HELPEND       Return if end of tokens           @SC88168 02148000
         BL    *+12          Not branch to other list          @SC88168 02149000
          ICM  4,7,KWADR(4)  Yes, get ptr to new list          @SC90239 02150000
          B    HELPNT        And resume scan                   @SC87117 02151000
         IC    7,KWLEN(4)    Length-1 of current token         @SC90239 02152000
         IC    15,KWMIN(,4)  Min abbreviation length - 1       @SC90239 02154000
         EX    7,HELPMVC             move it to display buffer          02155000
         LA    4,KWNAME+1(7,4) Skip to next token in KW table  @SC90239 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),KWNAME(4) Copy KW                         @SC90239 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),ETOAD                                    @SC89301 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
TRUPCAS  TR    0(,1),UPCASE  Upcase                            @SC86158 02227000
*                                                                       02228000
* 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),NONUM,E=LUPRER                             @SC88101 02299000
         LA    1,CMD         Ptr to buffer, R0 = length        @SC86171 02300000
         LR    3,1                                             @SC88006 02300100
         AR    3,0           Get end of buffer                 @SC88006 02300200
         BCTR  3,0                                             @SC88006 02300300
         CLI   0(3),C' '     Find last non-blank               @SC88006 02300400
         BE    *-6                                             @SC88006 02300500
         LA    0,1(3)        One past end of buffer            @SC88006 02300600
         SR    0,1           Get trimmed length                @SC88006 02300700
         BNP   LOOP          Nothing there, ignore it          @SC88006 02300800
         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 '&ERRTAKE'                                      @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
LUPKRM   TM    FL5,KRMONLY   Already seen KERMIT prefix?       @SC90059 02320200
         BO    LUPBAD        Yes, let's not clown around       @SC90059 02320400
         OI    FL5,KRMONLY   Override SYSCMD option for now    @SC90059 02320600
         B     LUPTOK                                          @SC90059 02320800
LUPPRS   DS    0H                                              @SC87034 02321000
         STM   0,1,SCANPTR   Save for parser                   @SC86171 02322000
         NI    FL5,255-KRMONLY Allow possibility of host cmd   @SC90059 02322500
         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 '&KCMDERR'                                      @SC92300 02334000
         TM    FL2,PASS                                        @SC86295 02335000
         BZ    LUPINV        Don't try as system cmd           @SC86295 02336000
         TM    FL5,KRMONLY   KERMIT prefix?                    @SC90059 02336300
         BO    LUPINV        Yes, don't try as system cmd      @SC90059 02336600
         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
*                                                                       02346200
LUPVERS  PTEXT 'Kermit-&KSYS Version &KVRSN..&KEDIT &KTAG (&KDATE.)'    02346400
         B     LUPWRT                                          @SC90339 02346600
*                                                                       02347000
LUPCWD   KCALL CWDSET,E=LUPERK                                 @SC86295 02348000
         B     LOOP0                                           @SC86295 02349000
*                                                                       02350000
LUPHNTS  KCALL HINTS                                           @SC91295 02350200
         B     LOOP0                                           @SC91295 02350400
*                                                                       02350600
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 '&MAXNEST'                                      @SC92300 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 '&NOTFOUN'    In case of error                  @SC92300 02373000
         MVI   ERRNUM,ERRFNF In case of error                  @SC86171 02374000
         OPENF I,FILNAM,TAKFDB,0(5),E=0(9)                     @SC86295 02375000
         PTEXT '&TAKLOOP'                                      @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(2),OLDERR Restore from last command      @SC92210 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
*                                                                       02402200
LUPSIM   KCALL SIMLAT,E=LUPERK Replay file as packet input     @SC91312 02402400
         B     LOOP0                                           @SC91312 02402600
*                                                                       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 '&SYSCMND'                                      @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 '&BADSCMD'                                      @SC86295 02415000
         KCALL SUPFNC,E=(LUPWRTE,M) Execute it                 @SC86295 02416000
         B     LOOP                                                     02417000
         AIF   ('&KSYS' NE 'CMS').CM1Z                         @SC86355 02418000
*                                                                       02419000
LUPCP    PTEXT '&CPCMND'                                       @SC92300 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 '&EXTRAOP'                                      @SC86295 02428000
         B     LUPINV                                          @SC86295 02429000
LUPCRH   PTEXT '&NOOPERS'                                      @SC90179 02430000
         B     LUPWRTE                                         @SC86295 02431000
         DROP  13                                                       02432000
GRDATA   DC    &S1CMD,X'70'                                    @SC90264 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
AMAXRT   DC    A(MAXRT)      Longest terminal read             @SC86295 02439000
AMAXRS   DC    A(MAXRS)      Longest fullscreen read           @SC90277 02439500
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
FLFID1   DC    A(ACTLEN)     Length of items in filespec table @SC91172 02453500
SPACE    DC    A(ABL)                ASCII SPACE                        02454000
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
         FDBPAT ,V,LPKT      Default disk RECFM, etc.          @SC88120 02468000
         DS    0F --------Init for SEND/RECEIVE file           @SC86295 02471000
         DC    A(0)          Addr of FSWRITE buffer            @SC86295 02472000
         DC    F'&MAXLR'     Buffer length                     @SC89215 02473000
         FDBPAT ,V,80        Default disk RECFM, etc.          @SC88120 02474000
         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
         FDBPAT ,V           Default disk RECFM (no LRECL)     @SC88120 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
IBAUD    DC    F'1200'       Assumed baud rate                 @SC88325 02484500
IRPSIZ   DC    A(KMAX)       Max receive size                  @SC86295 02485000
ISPSIZ   DC    A(KDEF)       Max send size                     @SC86295 02487000
IMAXOUT  DC    F'&MAXLR'     Max output buffer                 @SC86268 02488000
* Send mode Rpack interpret input table                        @SC89263 02488100
ISNDST   DC    AL1(AY),AL3(0)        Micro ACK'd               @SC89263 02488200
         DC    XL1'FF',AL3(SNDABR)   Stop                      @SC89263 02488300
         DC    AL1(AN),AL3(INPUTMIS) Repeated trigger packet   @SC89263 02488400
         DC    AL1(00),AL3(SNDABR)   Error routine             @SC89263 02488500
ITRMLIN  DC    CL8' '        Current data line                 @SC87166 02489000
IATFLG   DC    9X'FF'        Attribute-honoring flags          @SC91109 02489500
ITYPFIL  DC    C'T'          Type of file (T,B,V,D),see BINF   @SC86151 02490000
ICLSNFL  DC    C'O'          Collision default is OVERWRITE    @SC90033 02490200
ITRNCFL  DC    C'T'          Truncate by default (vs. F or H)  @SC88120 02490500
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'28'         Capabilities I have        SCAPA  @SC91275 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(120)      Timeout, if we can do it   TIMOSRV@SC90045 02505100
         DC    AL1(0)        Recieve parity is MARK     RPRTY  @SC88288 02505300
         DC    AL1(DAT8)     Send parity is NONE        SPRTY  @SC88288 02505600
         DC    C'1'          User requested chk type    BCTC   @SC92085 02506000
         DC    AL1(ATIL)     Original repeat prefix     RPTQC  @SC86295 02507000
         DC    &AEACMD,AL2(8),X'0F02'  D/O strct fld    AEADAT @SC90173 02508000
         DC    X'0',X'00',AL2(1)  D/O id is 1           AEAFLG @SC90173 02508300
         DC    AL2(7+2),X'0F1F',X'00C000'  Not spanned  AEABUFL@SC90173 02508600
         DC    &S1CMD,AL1(SBA),X'5D7F',AL1(SBA),X'0005' S1DATA @SC90264 02509000
COMMON   CSECT               Resume addressible constants      @SC89215 02511200
MAXLRC   DC    F'&MAXLR'     Max lrecl                         @SC89215 02511400
AKMAX    DC    A(KMAX)       Normal packet maximum             @SC89215 02511600
MAXBSZ   DC    F'&MAXBS'     Max blksiz                        @SC86268 02512000
BUFSIZ   DC    Y(LPKT)       Length of packet buffers          @SC86190 02513000
*                                                                       02514000
IS1EOL   DC    AL1(CR)       In case micro lost one     S1EOL  @SC90173 02514300
         DC    AL1(XON)      Handshake for micro        S1HND  @SC90173 02514600
* 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    HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C89268 02521000
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C89268 02522000
         HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C89268 02523000
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C89268 02524000
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C89268 02525000
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D 5 C89268 02526000
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C89268 02527000
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C89268 02528000
         HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 8 C89268 02529000
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 9 C89268 02530000
         HTBL  40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 A C89268 02531000
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F B C89268 02532000
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 C C89268 02533000
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D D C89268 02534000
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 E C89268 02535000
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 F C89268 02536000
* EBCDIC to ASCII translate table                                       02537000
ETOAD    HTBL  00,01,02,03,00,09,00,7F,00,00,00,0B,0C,0D,0E,0F 0 C89268 02538000
         HTBL  10,11,12,13,00,00,08,00,18,19,00,00,1C,1D,1E,1F 1 C89268 02539000
         HTBL  00,00,00,00,00,0A,17,1B,00,00,00,00,00,05,06,07 2 C89268 02540000
         HTBL  00,00,16,00,00,00,00,04,00,00,00,00,14,15,00,1A 3 C89268 02541000
         HTBL  20,00,00,00,00,00,00,00,00,00,5C,2E,3C,28,2B,7C 4 C89268 02542000
         HTBL  26,00,00,00,00,00,00,00,00,00,21,24,2A,29,3B,5E 5 C89268 02543000
         HTBL  2D,2F,00,00,00,00,00,00,00,00,7C,2C,25,5F,3E,3F 6 C89268 02544000
         HTBL  00,00,00,00,00,00,00,00,00,60,3A,23,40,27,3D,22 7 C89268 02545000
         HTBL  00,61,62,63,64,65,66,67,68,69,00,7B,00,00,00,00 8 C89268 02546000
         HTBL  00,6A,6B,6C,6D,6E,6F,70,71,72,00,7D,00,00,00,00 9 C89268 02547000
         HTBL  00,7E,73,74,75,76,77,78,79,7A,00,00,00,5B,00,00 A C89268 02548000
         HTBL  00,00,00,00,00,00,00,00,00,00,00,00,00,5D,00,00 B C89268 02549000
         HTBL  7B,41,42,43,44,45,46,47,48,49,00,00,00,00,00,00 C C89268 02550000
         HTBL  7D,4A,4B,4C,4D,4E,4F,50,51,52,00,00,00,00,00,00 D C89268 02551000
         HTBL  5C,00,53,54,55,56,57,58,59,5A,00,00,00,00,00,00 E C89268 02552000
         HTBL  30,31,32,33,34,35,36,37,38,39,7C,00,00,00,00,00 F C89268 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    256AL1(*-LOCASE)                                @SC91316 02557000
LOCASE  TBLFIX ABCDEFGHIJKLMNOPQRSTUVWXYZ,                     @SC91316.02558000
               abcdefghijklmnopqrstuvwxyz                      @SC91316 02559000
* Table to convert EBCDIC text to upper case                   @SC89215 02561100
UPCASE   DC    256AL1(*-UPCASE)                                @SC91316 02561200
UPCASE  TBLFIX abcdefghijklmnopqrstuvwxyz,                     @SC91316.02561300
               ABCDEFGHIJKLMNOPQRSTUVWXYZ                      @SC91316 02561400
ETCETERA CSECT                                                 @SC90278 02561620
* A-to-E table based on Hollerith cards                        @SC90278 02561640
ATOEKP   HTBL  00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90278 02561660
         HTBL  10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90278 02561680
         HTBL  40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90278 02561700
         HTBL  F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90278 02561720
         HTBL  7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90278 02561740
         HTBL  D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90278 02561760
         HTBL  79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90278 02561780
         HTBL  97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90278 02561800
         HTBL  20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90278 02561820
         HTBL  30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,E1 9 C90278 02561840
         HTBL  41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 A C90278 02561860
         HTBL  58,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75 B C90278 02561880
         HTBL  76,77,78,80,8A,8B,8C,8D,8E,8F,90,9A,9B,9C,9D,9E C C90278 02561900
         HTBL  9F,A0,AA,AB,AC,AD,AE,AF,B0,B1,B2,B3,B4,B5,B6,B7 D C90278 02561920
         HTBL  B8,B9,BA,BB,BC,BD,BE,BF,CA,CB,CC,CD,CE,CF,DA,DB E C90278 02561940
         HTBL  DC,DD,DE,DF,EA,EB,EC,ED,EE,EF,FA,FB,FC,FD,FE,FF F C90278 02561960
         TITLE 'Variable storage for Kermit-370'                        02562000
&STORDS  DSECT ,                                               @SC89268 02563000
STORAG   EQU   *                                               @SC89268 02563500
         KTRACE STORAG                                         @LM91008 02563600
* - - - 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
* - - - 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
MSNDBUF  DS    A             Adr of filespec buffer            @SC88306 02578300
MSNDPTR  DS    A             Scan ptr for readout              @SC88306 02578600
AEPTRS   DS    2A            Tables to use (normal or "T")     @SC92352 02578800
DATL     DS    F             Send packet size                  @SC86121 02579000
KBYTES   DS    F             Size of current file              @SC86158 02581000
FDATE    DS    XL7           Date/time of current file         @SC88235 02581500
* 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
KEEP     EQU   X'10'         Keep incomplete files             @SC90037 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
FOPTS    EQU   X'80'         Found file options                @SC89218 02592500
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
*--- DAT8 is now used only in RPRTY/SPRTY                      @SC88288 02599500
FL3      DS    X                                               @SC86316 02600000
ZPRO     EQU   X'80'         Stop protocol mode pronto         @SC88074 02600500
SVATT    EQU   X'40'         Preserve attributes of old files  @SC90033 02600700
PXCH     EQU   X'20'         Parameters exchanged              @SC86152 02601000
APPN     EQU   X'10'         Append to existing files          @SC86203 02602000
FCLRF    EQU   X'08'         Skipping two lines on screen      @SC92030 02602500
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
NMCHNG   EQU   X'04'         Filename collsion occurring       @SC90033 02607500
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
NAK0     EQU   X'10'         Send NAK during Resend            @SC90037 02614000
SALL     EQU   X'08'         Search all disks for SEND         @SC86209 02615000
TKMSG    EQU   X'04'         Already issued TAKE error msg     @SC86239 02616000
KRMONLY  EQU   X'02'         Saw KERMIT prefix on subcmd       @SC90059 02616500
*                                                                       02617000
RPKERN   DS    X             Tentative error code from RPACK   @SC89219 02617500
SEQ      DS    X             Current pkt number                @SC86135 02618000
RSN      DS    X             Received pkt number               @SC86135 02619000
CARCTL   DS    X             Code for converting carriage ctl  @SC91116 02619200
BRK      DS    C             Break char for last parsed word   @SC88306 02619500
TRMFLG   DS    X             Flag(s) for terminal I/O          @SC87275 02620000
TRMTP    DS    C             Type of terminal line             @SC87166 02621000
DBGFLG   DS    X             Type of debug log                 @SC88168 02621100
DBGON    EQU   X'80'         Logging on                        @SC88168 02621200
DBGIO    EQU   X'40'         Logging of I/O info (SERIES1)     @SC88168 02621300
DBGRW    EQU   X'20'         Logging raw packets, not EBCDIC   @SC88168 02621400
DBGSV    EQU   X'10'         Log file closed after each entry  @SC88168 02621500
DBGLO    EQU   X'08'         Logging of I/O info w/ long buffer@SC90222 02621600
DBGTI    EQU   X'04'         Logging of TOD before and after   @SC91172 02621800
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
TXTPTR   DS    3F            Ptrs to start and end of text     @SC89268 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
WRCMD    DS    A             Ptr to output packet I/O command  @SC90173 02631300
WRCMDL   DS    2F            Length of commands, input to skip @SC90173 02631600
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
SIMPTR   DS    A             Ticket for replay file I/O        @SC91312 02639100
KHDSAV   DS    5F            Save area for hex dumps           @SC91008 02639200
KAFUNC   DS    F             SEND/RECEIVE indicator            @AB89191 02639500
*--------- Start of data area known to accounting routine      @SC90179 02639700
NSENTAC  DS    F             Number of files sent              @AB89191 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
SSVDSK   DS    2F            Saved disk byte count             @SC88092 02643500
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
RECFLD   DS    F             Count of record foldings          @SC88120 02648200
EMSGL    DS    F             Length of msg                     @BS86090 02648500
TINSV    DS    12F           3 snapshots of progress           @SC88325 02648700
ERRNUM   DS    X             Error number                      @SC92210 02648730
REASON   DS    X             Reason for rejecting A-pkt        @SC92210 02648760
*--------- NSENTAC to here is known to accounting routine      @SC90179 02648800
LSTATS   EQU   *-NSENTAC     Size of area to initialize        @SC90179 02649000
TRANEND  DS    XL4           Ending time of last transfer      @SC91172 02649500
PREFIX   DS    X,CL(FORMAXL) Prefix count and buffer           @HF86223 02650000
SUFFIX   DS    X,CL(FORMAXL) Suffix count and buffer           @HF86223 02651000
FILNAM   DS    CL(LFID)      SEND/REC filename                 @SC86295 02654000
FLNOPTS  DS    2AL4          File options                      @SC89218 02654300
FLNFLGS  DS    X                                               @SC91116 02654400
FLNCC    EQU   X'80'         File with carriage control        @SC91116 02654500
LFOPTS   EQU   *-FLNOPTS     Length of options                 @SC89218 02654600
         DS    0F                                              @SC86295 02655000
IFILE    DS    CL(LFID)      Name of file(s) to send           @SC86295 02656000
IFOPTS   DS    XL(LFOPTS)    File options                      @SC91116 02656200
JFSPEC   DS    X             Length of foreign filespec        @SC86224 02656400
JFNAM    DS    CL95          Filespec                          @SC86224 02656600
         DS    0F            So LFSTF is                   4*N @SC90264 02656700
LFSTF    EQU   *-IFILE       Length of file info               @SC89218 02656800
XFILE    DS    CL(LFID)      Intended name of received file    @SC90033 02656900
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
FREED1   DS    A             Ptr to 1st disk buffer area       @SC90264 02659100
FREED2   DS    A             Ptr to 2nd disk buffer area       @SC90264 02659200
STKLO    DS    A             Start of stack space              @SC89089 02659300
STKHI    DS    A             High extent of stack usage        @SC89089 02659600
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
LEMSG    EQU   80            Max msg length kept           8*N @SC90264 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
SIOPTRS  DS    2F            Address, length of data to send   @SC90173 02674000
RIOPTRS  DS    2F            For reading data (max length)     @SC90173 02675000
*                                                                       02679000
CDESPTR  DS    A(0)                                            @SC90040 02679300
LALF     EQU   14            Length of fields (must be even):  @SC91325 02679600
TRNALF   DS    CL(LALF)'ASCII'                                 @SC91325 02679700
FILALF   DS    CL(LALF)'EBCDIC' Logical char-set               @SC91325 02679800
FILALF2  DS    CL(LALF)'EBCDIC' Actual char-set (if complex)   @SC91325 02679900
RIOC     DS    F             Saved data length from prev read  @SC86295 02680000
PREV     DS    C             Previous char decoded                      02681000
DECESCP  DS    C             Saved DLE prefix, if any          @SC91275 02681200
LCKCAPA  DS    X             Flag x'20' if using locking shift @SC91275 02681400
LCKFRC   DS    X             Flag x'21' if FORCE mode          @SC91275 02681600
LCKOLD   DS    X             Current locking shift state       @SC91275 02681800
* - - - 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
         FDBPAT LOG,V,LPKT   Default disk RECFM, etc.          @SC88120 02689000
* Specifications for SEND/RECEIVE file                         @SC86295 02692000
FILFDB   DS    0F                                              @SC86295 02693000
WBUF     DS    A,F           Adr,length of FSWRITE buffer      @SC86121 02694000
         FDBPAT FIL,V,80     Default disk RECFM, etc.          @SC88120 02696000
* 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
         FDBPAT TAK,V        Default disk RECFM (no LRECL)     @SC88120 02703000
*                                                                       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
BAUD     DS    F'1200'       Assumed baud rate                 @SC88325 02708500
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
* Send mode Rpack interpret input table                        @SC89263 02711100
SNDST    DS    AL1(AY),AL3(0)        Micro ACK'd               @SC89263 02711200
         DS    XL1'FF',AL3(SNDABR)   Stop                      @SC89263 02711300
RTYPPRV  DS    AL1(AN),AL3(INPUTMIS) Repeated trigger packet   @SC89263 02711400
         DS    AL1(00),AL3(SNDABR)   Error routine             @SC89263 02711500
TRMLIN   DS    CL8' '        Current data line                 @SC87166 02712000
ATFLG    DS    X             Attribute-honoring flags          @SC90037 02712040
ATFLNG   EQU   X'80'         Length of file                    @SC90037 02712080
ATFTYP   EQU   X'40'         Type of file                      @SC90037 02712120
ATFDAT   EQU   X'20'         Date of file creation             @SC90037 02712160
ATFCRE   EQU   X'10'         Creator of file                   @SC90037 02712200
ATFACT   EQU   X'08'         Account                           @SC90037 02712240
ATFARE   EQU   X'04'         Area                              @SC90037 02712280
ATFPWD   EQU   X'02'         Password                          @SC90037 02712320
ATFBLK   EQU   X'01'         Blocksize                         @SC90037 02712360
ATFL2    DS    X                                               @SC90037 02712400
ATFACC   EQU   X'80'         Access                            @SC90037 02712440
ATFENC   EQU   X'40'         Encoding                          @SC90037 02712480
ATFDSP   EQU   X'20'         Disposition                       @SC90037 02712520
ATFPRO   EQU   X'18'         Protection                        @SC90037 02712560
ATFORG   EQU   X'04'         Origin                            @SC90037 02712600
ATFFMT   EQU   X'02'         Format                            @SC90037 02712640
ATFSFO   EQU   X'01'         System info                       @SC90037 02712680
ATFL3    DS    X                                               @SC90037 02712720
ATFXLN   EQU   X'80'         Byte count                        @SC90037 02712760
ATFL4    DS    X                                               @SC91109 02712770
ATFEND   EQU   X'01'         End of attributes                 @SC91109 02712780
ATFL5    DS    5X                                              @SC91109 02712790
*                                                                       02712800
TYPFIL   DS    C'T'          Type of file (T,B,V,D),see BINF   @SC86151 02713000
CLSNFL   DS    C'O'          Collision default is OVERWRITE    @SC90033 02713200
TRNCFL   DC    C'T'          Truncate or Fold or Halt          @SC88120 02713500
*                                                                       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
TIMOSRV  DS    AL1(120)      Timeout, if we can implement it   @SC90045 02727100
RPRTY    DS    AL1(0)        Recieve parity is MARK            @SC88288 02727300
SPRTY    DS    AL1(DAT8)     Send parity is NONE               @SC88288 02727600
BCTC     DS    C'1'          User requested chksum length      @SC92085 02728000
RPTQC    DS    AL1(ATIL)     Original repeat prefix                     02729000
AEADAT   DS    &AEACMD,AL2(8),X'0F02'  D/O strct fld           @SC90173 02730000
AEAFLG   DS    X,X'00',AL2(1)     D/O id is 1                  @SC90173 02730600
AEADOL   EQU   *-AEADAT      Length of just D/O field          @SC91352 02730900
AEABUFL  DS    AL2,X'0F1F',X'00C000'  Not spanned              @SC90173 02731200
AEAL     EQU   *-AEADAT                                        @SC90173 02731800
S1DATA   DS    &S1CMD,AL1(SBA),X'5D7F',AL1(SBA),X'0005'        @SC90264 02732400
S1ORDL   EQU   *-S1DATA                                        @SC90173 02733000
WRRD     EQU   *-1           Zap this to 0 for just write      @SC90173 02733600
*                   ... but ONLY if we really won't read again @SC90173 02734200
LDEFS    EQU   *-DEFS                                          @SC86295 02735000
*                                                                       02736000
S1XOPL   DS    2A            For sending prompt                @SC90173 02737000
SCRPRBUF DS    XL(S1ORDL)    Command stream                    @SC90173 02737300
         ORG   SCRPRBUF                                        @SC90173 02737600
         DS    XL(GRDL)                                        @SC90173 02737900
         ORG   SCRPRBUF                                        @SC90173 02738200
         DS    XL(AEAL)                                        @SC90173 02738500
         ORG   ,                                               @SC90173 02738800
TRNSPL   EQU   *-SCRPRBUF    Length of longest command string  @SC90173 02739100
S1EOL    DS    AL1(CR)       In case micro lost one            @SC90173 02739400
S1HND    DS    AL1(XON)      Handshake for micro               @SC90173 02739700
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
BCTOFF   DS    F             Offset in checksum encoding (0/1) @SC92085 02743500
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
CTLTAB   DS    160X          Table of sendable ctl chars       @SC93173 02749500
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
ACCTFLG  DS    X             Flag for transaction log          @SC89218 02755200
ERRLAST  DS    X             Error code on last file xferred   @SC89218 02755400
REALAST  DS    X             Reason code on last file          @SC89218 02755600
OLDERR   DS    XL2           Saved ERRNUM+REASON in loop       @SC90033 02757000
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
STOPBUF  DS    CL8           Work area                         @SC91032 02762500
         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,'&NOERROR'                     Err #0       @SC86156 02768000
         MSGDF NFT,'&NOTRANS'                     Err #1       @SC86156 02768500
         MSGDF TRC,'&TCANCEL'                     Err #2       @SC86156 02769000
         MSGDF USC,'&BADSERV'                     Err #3       @SC86156 02769500
         MSGDF TIE,'&TERMIOE'                     Err #4       @SC86156 02770000
         MSGDF BPC,'&BADCHEK'                     Err #5       @SC86156 02770500
         MSGDF IPS,'&BADPSYN'                     Err #6       @SC86158 02771000
         MSGDF IPT,'&BADPTYP'                     Err #7       @SC86156 02771500
         MSGDF MIS,'&LOSTPAK'                     Err #8       @SC86156 02772000
         MSGDF NAK,'&GOTNAK'                      Err #9       @SC86156 02772500
         MSGDF ABO,'&MICROAB'                     Err #10      @SC86156 02773000
         MSGDF FNE,'&BADNAME'                     Err #11      @SC86156 02773500
         MSGDF FNF,'&NOTFOUN'                     Err #12      @SC86156 02774000
         MSGDF FUL,'&DSKFULL'                     Err #13      @SC86345 02774500
         MSGDF DIE,'&DSKIOER'                     Err #14      @SC86345 02775000
         MSGDF MOP,'&MISSOPR'                     Err #15      @SC86158 02775500
         MSGDF SYS,'&BADSCMD'                     Err #16      @SC86268 02776000
         MSGDF KCE,'&KCMDERR'                     Err #17      @SC86171 02776500
         MSGDF TIM,'&NOPACKS'                     Err #18      @SC86355 02777000
         MSGDF RTR,'&RECTRNC'                     Err #19      @SC87268 02777500
         MSGDF COM,'&BADCOMM'                     Err #20      @SC87300 02778000
         MSGDF PTY,'&NO8THBQ'                     Err #21      @SC89072 02778500
         MSGDF FTS,'&TOOSHRT'                     Err #22      @SC89218 02779000
         MSGDF SOH,'&NOSTART'                     Err #23      @SC89219 02779500
         MSGDF OPT,'&BADOPTN'                     Err #24      @SC89249 02780000
         MSGDF DSP,'&BADDISP'                     Err #25      @SC90037 02780500
