*COPY                                                 RTEXT             00800000
         MACRO                                                          00801000
&LABEL   RTEXT  &BUF,&PROMPT=,&E=                                       00802000
.* Read from the terminal, possible prompt.  Get length read in R0.     00803000
.*  &1: read buffer (len=130) (LA), &PROMPT(1)= prompt buf. if any      00804000
.*  (LA/R), &PROMPT(2)= prompt length (LA/R), &E= branch if error       00805000
         GBLC  &KVRSN,&KSYS                                    @SC89027 00806000
         AIF   ('&KVRSN' EQ '4.3' OR '&KSYS' EQ '').VOK        @SC90072 00807000
   MNOTE 16,'* * * --> IKXMAC version number should be &KVRSN' @SC89027 00808000
.VOK     ANOP                                                  @SC89027 00809000
&LABEL   DS    0H                                              @SC86299 00810000
         AIF   (T'&BUF EQ 'O').ERRB                            @SC87268 00811000
         AIF   (T'&PROMPT EQ 'O').NOPR                         @SC87268 00812000
         AIF   (N'&PROMPT NE 2).ERRP                           @SC87268 00813000
         AIF   ('&PROMPT(1)' EQ '' OR '&PROMPT(2)' EQ '').ERRP @SC87268 00814000
         LREG  1,&PROMPT(1)                                    @SC90264 00815000
         LREG  0,&PROMPT(2)                                    @SC90264 00816000
         STM   0,1,GTLPRPS   Save prompt ptrs                  @SC90264 00817000
         AGO   .GETL                                           @SC90264 00818000
.NOPR    XC    GTLPRPS,GTLPRPS                                 @SC90264 00819000
.GETL    KCALL GETLIN,&BUF,E=&E                                @SC88095 00820000
         MEXIT                                                 @SC87268 00821000
.ERRB    MNOTE 2,'BUFFER ADDRESS OMITTED'                      @SC87268 00822000
         MEXIT                                                 @SC87268 00823000
.ERRP    MNOTE 2,'INVALID PROMPT PARAMETER'                    @SC87268 00824000
         MEND                                                           00825000
*COPY                                                 WTEXT             00826000
         MACRO                                                          00827000
&LABEL   WTEXT &ARG,&LEN                                                00828000
.* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4)           00829000
.* Preserves R2-R14                                                     00830000
.*  &1: 'text' (where text has no doubled ' or & characters)  OR        00831000
.*  &1: adr of text (LA/R), &2: length of text (LA/R)                   00832000
&LABEL   PTEXT &ARG,&LEN,AREG=1,LREG=0                         @SC86295 00833000
         BAL   15,WTEXT                                        @SC87020 00834000
         MEND                                                           00835000
*COPY                                                 DMSFREE           00836000
         MACRO                                                          00837000
&LABEL   DMSFREE &DWORDS=(0),&ERR=                                      00838000
.* Obtain free storage block: len=8*(R0).  Returns ptr in R1, but       00839000
.*    preserves registers 2-13                                          00840000
.*  &DWORDS= length in doublewords should be in R0,                     00841000
.*  &ERR= branch if failure                                             00842000
&LABEL   LREG  0,&DWORDS                                       @SC86299 00843000
         SLA   0,3                                             @SC86299 00844000
         ST    0,GTMLEN      Bytes requested                   @SC90264 00845000
         AIF   ('&ERR' EQ '').DOORDIE                          @SC90264 00846000
         EXEC CICS GETMAIN SET(1) FLENGTH(GTMLEN) NOHANDLE,    @SC90264 00847000
         L     15,DFHEIBP                                      @SC90264 00848000
         CLC   F0,EIBRCODE-DFHEIBLK(15)                        @SC90264 00849000
         BNE   &ERR                                            @SC90264 00850000
         AGO   .DONE                                           @SC90264 00851000
.DOORDIE ANOP                                                  @SC90264 00852000
         EXEC CICS GETMAIN SET(1) FLENGTH(GTMLEN),             @SC90264 00853000
.DONE    ANOP                                                  @SC90264 00854000
         MEND                                                           00855000
*COPY                                                 DMSFRET           00856000
         MACRO                                                          00857000
&LABEL   DMSFRET &DWORDS=(0),&LOC=(1),&ERR=                             00858000
.* Return free storage block: len=8*(R0), adr=(R1).  Preserve R2-13.    00859000
.*  &DWORDS= length in doublewords should be in R0, &LOC= adr (in R1),  00860000
.*  &ERR= branch if failure                                             00861000
.*  Note: &DWORDS is ignored                                   @SC90264 00862000
&LABEL   ST    2,GTMSAV                                        @SC90264 00863000
         LREG  2,&LOC                                          @SC90264 00864000
         EXEC CICS FREEMAIN DATA(0(,2)),                       @SC90264 00865000
         L     2,GTMSAV                                        @SC90264 00866000
         MEND                                                           00867000
*COPY                                                 WRITF             00868000
         MACRO                                                          00869000
&LABEL   WRITF &TICK,&BUFFER=,&BSIZE=,&E=                               00870000
.* Write to a disk file (ticket ptr in R1)                              00871000
.*  &1: adr of file access ticket returned by OPENF (A),                00872000
.*  &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00873000
.*  given, it replaces FDB value (see OPENF), &E= branch on error       00874000
&LABEL   READF &TICK,BUFFER=&BUFFER,BSIZE=&BSIZE,E=&E,CODE=10           00875000
         MEND                                                           00876000
*COPY                                                 READF             00877000
         MACRO                                                          00878000
&LABEL   READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=,&CODE=9                00879000
.* Read from disk file (or write) (see WRITF, but also...)              00880000
.*  &2: NONUM means chop off numbers                                    00881000
         LCLC  &R                                              @SC86299 00882000
         LCLA  &C                                              @SC88101 00883000
&C       SETA  &CODE                                           @SC88101 00884000
         AIF   (T'&NONUM EQ 'O').RDC                           @SC88101 00885000
         AIF   ('&NONUM' NE 'NONUM' OR &CODE NE 9).ER1         @SC88101 00886000
&C       SETA  0             Code 0 means exclude sequence nos.@SC88101 00887000
.RDC     ANOP                                                  @SC88101 00888000
&LABEL   L     1,&TICK                                         @SC86299 00889000
         AIF   ('&BUFFER' EQ '').BZ                            @SC86299 00890000
         AIF   ('&BUFFER'(1,1) NE '(').BLA                     @SC86299 00891000
&R       SETC  '&BUFFER(1)'                                    @SC86299 00892000
         AGO   .BST                                            @SC86299 00893000
.BLA     LA    15,&BUFFER                                      @SC86299 00894000
&R       SETC  '15'                                            @SC86299 00895000
.BST     ST    &R,FDBBUFF-FABD(1)                              @SC86299 00896000
.BZ      AIF   ('&BSIZE' EQ '').SZ                             @SC86299 00897000
         AIF   ('&BSIZE'(1,1) NE '(').SLA                      @SC86299 00898000
&R       SETC  '&BSIZE(1)'                                     @SC86299 00899000
         AGO   .SST                                            @SC86299 00900000
.SLA     LA    15,&BSIZE                                       @SC86299 00901000
&R       SETC  '15'                                            @SC86299 00902000
.SST     ST    &R,FDBBSIZ-FABD(1)                              @SC86299 00903000
.SZ      LA    0,&C                                            @SC88101 00904000
         KCALL DISKIO,E=&E                                     @SC86299 00905000
         MEXIT                                                          00906000
.ER1     MNOTE 2,'INVALID PARAMETER ''&NONUM'''                @SC88101 00907000
         MEND                                                           00908000
*COPY                                                 SAVEF             00909000
         MACRO                                                          00910000
&LABEL   SAVEF &TICK,&E=                                       @SC88168 00911000
.* Update disk directory for given file (ticket ptr in R1)              00912000
.*  &1: adr of file access ticket (A), &E= branch on error              00913000
&LABEL   L     1,&TICK                                         @SC88168 00914000
         READF &TICK,E=&E,CODE=21                              @SC88168 00915000
         MEND                                                           00916000
*COPY                                                 KSETKW            00917000
         MACRO                                                          00918000
         KSETKW ,                                              @SC87166 00919000
.* Define system-specific SET/SHOW parameters (keywords)                00920000
         GBLC  &AADELIM,&DESTINA                               @SC92300 00921000
         KW    '&AADELIM',SHODLM,MIN=4                         @SC88095 00921500
         KW    '&DESTINA',SHODST,MIN=3                         @SC87166 00922000
         MEND                                                           00923000
*COPY                                                 KSETPRC           00924000
         MACRO                                                          00925000
         KSETPRC                                                        00926000
.* System-specific SET handlers (in any order).  No operands.           00927000
         GBLC  &DELIMSG                                        @SC92300 00927500
SETDLM   NTOKN N=SETDLM1,H=SETDLMH                             @SC88095 00928000
         LTR   7,7           Exactly one character?            @SC88095 00929000
         BNZ   SETDLMH       No, explain it                    @SC88095 00930000
         MVC   LNDLM,0(6)    Yes, use that character           @SC88095 00931000
         B     RTRN0                                           @SC88095 00932000
SETDLM1  MVI   LNDLM,C' '    Turn delimiter off                @SC88095 00933000
         B     RTRN0                                           @SC88095 00934000
SETDLMH  PTEXT '&DELIMSG'                                      @SC88095 00935000
         B     SUBERR                                          @SC88095 00936000
SETDST   KCALL CWDSET                                          @SC86164 00937000
         B     RTRN          Preserve return code              @SC86295 00938000
         MEND                                                           00939000
*COPY                                                 KSHOPRC           00940000
         MACRO                                                          00941000
         KSHOPRC                                                        00942000
.* System-specific SHOW handlers (in same order as KW).  No operands.   00943000
SHODLM   LA    8,LNDLM       Show delimiter                    @SC88095 00944000
         BAL   14,SHOCHR                                       @SC88095 00945000
          B    SETDLM                                          @SC88095 00946000
SHODST   LA    8,DEST                                          @SC86316 00947000
         LH    9,DESTL       Get length                        @SC86316 00948000
         BAL   14,SHOCHRN                                      @SC86295 00949000
          B    SETDST                                          @SC87166 00950000
         MEND                                                           00951000
*COPY                                                 KFILKW            00952000
         MACRO                                                          00953000
         KFILKW ,                                              @SC87166 00954000
.* Define system-specific file attribute parameters (keywords)          00955000
         GBLC  &AARECFM                                        @SC92300 00956000
         KW    '&AARECFM',SHORFM                               @SC87166 00956300
         MEND                                                           00957000
*COPY                                                 KFILSET           00958000
         MACRO                                                          00959000
         KFILSET                                                        00960000
.* Specific SET FILE handlers (any order).  No operands.                00961000
         GBLC  &FIXED,&UNDEFND,&VARIABL                        @SC92300 00962000
SETCMDS  CSECT                                                 @SC92300 00963000
SETRFMKW KW    '&FIXED',SETT,F                                 @SC92300 00964000
         KW    '&VARIABL',SETT,V                               @SC92300 00965000
         KW    '&UNDEFND',SETT,U                               @SC86295 00966000
         KW    ,                                               @SC87012 00969000
SET      CSECT                                                 @SC92300 00969500
         MEND                                                           00970000
*COPY                                                 KFILSHO           00971000
         MACRO                                                          00972000
         KFILSHO                                                        00973000
.* Specific SHOW FILE handlers (same order as KW).  No operands.        00974000
SHORFM   LA    4,SETRFMKW                                      @SC92300 00975000
         LA    6,FILRCF                                        @SC92300 00975500
         BAL   14,SHOBRV                                       @SC92300 00976000
          NOP  0                                               @SC92300 00976500
         MEND                                                           00978000
*COPY                                                 FDBD              00979000
         MACRO                                                          00980000
         FDBD                                                           00981000
.* Map of File Descriptor Block + File Access Block                     00982000
.* Required items below: FABCOMM, FDBD-FDBLRC, FDBSIZE, FDBDATE,        00983000
.*     FDBDLRTR, FDBCOP, FDBINFO.  See also FDBPAT.                     00984000
LFUID    EQU   8             Length of user id in filespec     @SC92150 00985000
LFFNM    EQU   8             Length of file id in filespec     @SC90264 00986000
LFID     EQU   1+LFUID+LFFNM Length of internal filespec       @SC90264 00987000
LFKEY    EQU   LFUID+LFFNM+5 Length of KSDS key                @SC90264 00988000
FABD     DSECT ,                                               @SC86295 00989000
FABRESP  DS    XL6           Saved response code               @SC90264 00990000
FABNORD  DS    H             Byte count of last transfer       @SC90264 00991000
FDBD     DS    0F            Beginning of short descriptor     @SC86295 00992000
FDBBUFF  DS    A             Buffer ptr                        @SC86295 00993000
FDBBSIZ  DS    F             Max record length                 @SC86295 00994000
FDBRCF   DS    C             Record format                     @SC86295 00995000
FDBFLGS  DS    X             Flags                             @SC86295 00996000
FDBACTV  EQU   X'80'         File is already open              @SC86295 00997000
* SVATT  EQU   X'40'         Preserve attributes               @SC90033 00998000
* APPN   EQU   X'10'         DISP=MOD                          @SC86295 00999000
FDBENQ   EQU   X'04'         Resource is enqueued              @SC92126 00999500
FDBLRC   DS    H             File record length                @SC86295 01000000
FDBSIZE  DS    F             File size in Kbytes               @SC86299 01001000
FDBCOP   EQU   *-FDBD        Length to copy for OPEN           @SC86295 01002000
FDBDATE  DS    XL7           Time stamp: packed yyyymmddhhmmss @SC88235 01003000
* Must align FABFID to abut FABRN (halfword)                   @SC90264 01004000
FABFID   DS    0CL(LFID)     File designator                   @SC90264 01005000
FABFLGS  DS    X             Flags indicating type of file     @SC90264 01006000
FABFMAIN EQU   X'01'         Flag for MAIN TS queue            @SC90264 01007000
FABFTS   EQU   X'02'         Flag for TS queue                 @SC90264 01008000
FABFTD   EQU   X'04'         Flag for TD queue                 @SC90264 01009000
FABFPGM  EQU   X'08'         Flag for pipe file                @SC90264 01010000
FABFSPL  EQU   X'10'         Flag for spool file               @SC90264 01011000
FABFTAK  EQU   X'20'         Flag for internal Kermit file     @SC90264 01012000
FABFUID  DS    CL(LFUID)     User name                         @SC90264 01013000
FABFNAM  DS    CL(LFFNM)     File name                         @SC90264 01014000
FABRN    DS    H             Record number                     @SC90264 01015000
FDBNREC  DS    H             Number of records                 @SC90264 01016000
FDBFL2   DS    X             More flags                        @SC90264 01017000
FDBXRCF  DS    X             External format flags             @SC90264 01018000
FDBXLRC  DS    H             External old LRECL                @SC90264 01019000
FDBXBLK  DS    H             External old block size           @SC90264 01020000
FDBINFO  EQU   *-FDBD        Length of info returned           @SC86295 01021000
FABIOF   DS    X             More flags                        @SC90264 01022000
FABLRTR  DS    F             Record length for truncation      @SC88120 01023000
FABUWORD DS    F             Reserved for user applications    @SC90264 01024000
FABCOMM  DS    CL8           Command name                      @SC87351 01025000
.* CLOSE     Close file named in FABFID                        @SC90264 01026000
.* CWD       Set new user directory or QFN prefix: string is at@SC90264 01027000
.*           FABFID+2 with 2-byte unsigned length at FABFID    @SC90264 01028000
.* DELETE    Delete file named in FABFID                       @SC90264 01029000
.* OPEN I    Open file named in FABFID for input               @SC90264 01030000
.* OPEN O    Open file named in FABFID for output              @SC90264 01031000
.* READ      Read a record from (already open) file            @SC90264 01032000
.* READ TD   Read a record from (already open) TD queue        @SC90264 01033000
.* READ TS   Read a record from (already open) TS queue        @SC90264 01034000
.* TEST      Check whether file named in FABFID exists         @SC90264 01035000
.* WRIT TD   Write a record to (already open) TD queue         @SC90264 01036000
.* WRIT TS   Write a record to (already open) TS queue         @SC90264 01037000
.* WRITE     Write a record to (already open) file             @SC90264 01038000
FABDWDS  EQU   (*-FABD+7)/8                                    @SC86295 01039000
         MEND                                                           01040000
*COPY                                                 FDBPAT            01041000
         MACRO                                                          01042000
         FDBPAT &N,&RFM,&SIZ                                   @SC88120 01043000
.* Define system-dependent part of output FDB patterns                  01044000
.*  &1: variable-name prefix (or null if defining init. values)         01045000
.*  &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 01046000
         LCLC  &R,&F,&L,&S,&P4                                 @SC90037 01047000
         AIF   ('&N' EQ '').ALC                                @SC86316 01048000
&R       SETC  'RCF'                                           @SC88120 01049000
&F       SETC  'FLGS'                                          @SC88120 01050000
&L       SETC  'LRC'                                           @SC88120 01051000
&S       SETC  'FSIZ'                                          @SC90037 01052000
.ALC     ANOP                                                  @SC86316 01053000
&N&R     DC    C'&RFM'       RECFM                             @SC88120 01054000
&N&F     DC    X'00'         Flags                             @SC88120 01055000
         AIF   ('&SIZ' EQ '').DONE                             @SC88120 01056000
&N&L     DC    Y(&SIZ)       LRECL                             @SC88120 01057000
&N&S     DC    F'0'          File size in Kbytes               @SC90037 01058000
.DONE    ANOP                                                  @SC88120 01059000
         MEND                                                           01060000
*COPY                                                 KFSBLKD  @SC90264 01061000
         MACRO                                                 @SC90264 01062000
         KFSBLK                                                         01063000
.* Map of Kermit File System block                             @SC90264 01064000
KFSBLK   DSECT ,                                               @SC90264 01065000
KFSNEXT  DS    A             Ptr to next block in chain        @SC90264 01066000
KFSPREV  DS    A             Ptr to previous block in chain    @SC90264 01067000
KFSFUID  DS    CL(LFUID)     User name                         @SC90264 01068000
KFSFNAM  DS    CL(LFFNM)     File name                         @SC90264 01069000
KFSDAT   EQU   *             Info about file                   @SC90264 01070000
KFSLRC   DS    H             File record length                @SC90264 01071000
KFSNREC  DS    H             Number of records                 @SC90264 01072000
KFSSIZE  DS    F             File size in bytes                @SC90264 01073000
KFSDATE  DS    XL7           Time stamp: yyyymmddhhmmss        @SC90264 01074000
KFSLEN   EQU   *-KFSDAT      Length of block on disk           @SC90264 01075000
         DS    X             Spare for packing                 @SC90264 01076000
KFSDWDS  EQU   (*-KFSBLK+7)/8                                  @SC90264 01077000
         MEND                                                  @SC90264 01078000
*COPY                                                 KSYSVAR           01079000
         MACRO                                                          01080000
         KSYSVAR                                                        01081000
.* Define system-dependent globally-known variables                     01082000
CSAPTR   DS    F             Ptr to common system area         @SC90264 01083000
RTXTSV   DS    F             Saved register for prompt         @SC89214 01084000
STRBUF   DS    A             Address of string editing buffer  @SC90264 01085000
SCRLSTIO DS    D             Saved I/O code from SCRNIO        @SC92016 01085500
DSKSTT   DS    (FABDWDS)D    Dummy FAB                         @SC90264 01086000
         ORG   DSKSTT+FDBD-FABD Start of FDB                   @SC90264 01087000
DSKFDB   DS    XL(FDBINFO)   Room for FDB                      @SC86299 01088000
         ORG   DSKSTT+FABFID-FABD Start of file name           @SC90264 01089000
DSKSTNM  DS    CL(LFID)                                        @SC90264 01090000
         ORG   ,                                               @SC90264 01091000
DESTL    DS    H'0'          Length                            @SC86299 01092000
DEST     DS    CL60          Default PREFIX                    @SC90264 01093000
LINLEN   DS    H             Length of invocation buffer       @SC90264 01094000
GTMLEN   DS    F             Length of getmained area          @NL90264 01095000
GTMSAV   DS    F             Saved reg during DMSFREE          @SC90264 01096000
GTLBUFP  DS    A             Ptr to buffer for terminal input  @SC90264 01097000
GTPBPTRS DS    2F            Address and length of input buffer@SC88095 01098000
GTLPRPS  DS    2F            Ptrs to prompt (passed to GETLIN) @SC90264 01099000
ICPRGS   DS    8F            Saved registers for type-out      @SC88026 01100000
ICPFL    DS    X             Flag for type-out interception    @SC87020 01101000
FSCTRMF  DS    X             Flag for terminal activity        @SC90264 01102000
FSCOTP   DS    H             Current screen write adr          @SC90264 01103000
*  Storage for directory scan                                  @SC90264 01104000
NXFFNL   DS    F             Length of pattern                 @SC90264 01105000
NXPTR    DS    F             Current search position           @SC90264 01106000
NXPTR2   DS    F             Current search position for TS    @SC90264 01107000
NXDEST   DS    CL(LFID)      Pattern                           @SC90264 01108000
NXDNAM   EQU   NXDEST+1+LFUID Start of name part               @SC90264 01109000
KUSERID  DS    CL(LFUID)     Userid (to be filled at startup)  @SC90264 01110000
CURFUID  DS    CL(LFUID)     Current userid                    @SC90264 01111000
PTRKFS   DS    A             Ptr to chain of internal files    @SC90264 01112000
PTRFRE   DS    A             Ptr to chain of free blocks       @SC90264 01113000
PTRFREM  DS    A             Ptr to chain of free megablocks   @SC90264 01114000
USRTOTL  DS    F             Total bytes for current user      @SC90264 01115000
TMPBLK   DS    A             Ptr to block for current file     @SC90264 01116000
QFNBP    DS    A             Ptr to ring of QFN buffers        @SC90264 01117000
QFNPTR   DS    A             Ptr to current QFN buffer       1 @SC90264 01118000
QFNSHB   DS    H             Offset to display form of QFN   2 @SC90264 01119000
QFNSHL   DS    H             Length of display form          3 @SC90264 01120000
DSKFL    DS    X             Flags for disk search             @SC90264 01121000
PLOAD    EQU   X'40'         Auxiliary pgm loaded for pipes    @SC90264 01122000
WARB     EQU   X'20'         Arbitrary chars seen              @SC90264 01123000
WFN      EQU   X'08'         Filename contains wild chars      @SC88246 01124000
NFFND    EQU   X'01'         Found at least one file in search @SC90264 01125000
COPID    DS    CL3           CICS operator id                  @LM90264 01126000
CSCRNHT  DS    H             Terminal screen height in lines   @LM90264 01127000
CSCRNWD  DS    H             Screen width in columns           @LM90264 01128000
CSYSID   DS    CL4           Local CICS system name            @LM90264 01129000
KTSGIDNE DS    H             Number of entries per TSGID       @SC91150 01130000
KTSBPSEG DS    X             Log(length of TS segment)         @SC91150 01131000
         MEND                                                           01133000
*COPY                                                 KSYSTF            01134000
         MACRO                                                          01135000
         KSYSTF                                                         01136000
.* Define system-dependent globally-known constants and init. variables 01137000
.*  symb .DS + label &P.DEFS mark start of variables/init. values       01138000
         GBLC  &STORDS,&KTRMS                                  @SC91260 01139000
         LCLC  &P                                                       01140000
         AIF   ('&SYSECT' EQ '&STORDS').DS                     @SC89268 01141000
&P       SETC  'I'           For initial values                         01142000
WTEXT    STM   14,5,ICPRGS   Save                              @SC89268 01143000
         L     2,=A(ICPTYP)  Call interception routine         @SC89268 01144000
         BR    2                                               @SC89268 01145000
KSYSATOE DC    A(0)          Normal TTY E/A translation        @SC88302 01146000
KSYSETOA DC    A(0)                                            @SC88302 01147000
SYSATR   DC    AL1(ADOT,ABL+2,AI,A7)  ."I7  System type=CICS   @SC90264 01148000
LSYSATR  EQU   *-SYSATR      Length of stuff for A-packet      @SC88273 01149000
KFILE    DC    CL8'KERMFSF'  Name of Kermit file system KSDS   @SC90264 01150000
LIMKFS   DC    A(LIMDSK)     User quota of storage in KSDS     @SC90264 01151000
CUTKFS   DC    A(CUTDSK)     Absolute cutoff ("disk full")     @SC90264 01152000
LOGNAM   DC    C'KLOG&KTRMS..TS' File id for debug log         @SC91260 01152300
REPNAM   DC    C'KREP&KTRMS..TS' File id for reply from server @SC91260 01152600
SYSUID   DC    CL(LFUID)'0000' System userid                   @SC92150 01153000
SYSTAKE  DC    C'KSYS.TD'    File id for system KERMINI        @SC90264 01154000
LSYST    EQU   *-SYSTAKE                                       @SC86299 01155000
USRTAKE  DC    C'KINIT.TAKE' User init file                    @SC90264 01156000
LUSRT    EQU   *-USRTAKE                                       @SC86299 01157000
KMAIL1   DC    C'KERMAIL R(_...) ' System cmd for invoking mail@SC91150 01158000
KMAIL2   DC    C' LIST('                                       @SC90037 01159000
KMAIL3   DC    C')'                                            @SC90037 01160000
KPRNT1   DC    C'KERMPRT R(_...) ' System cmd for printing     @SC91150 01161000
KPRNT2   DC    C' OPTIONS('                                    @SC90037 01162000
KPRNT3   DC    C')'                                            @SC90037 01163000
KSUBM1   DC    C'KERMSUB R(_...) ' System cmd to submit job    @SC91150 01164000
KSUBM2   DC    C' OPTIONS('                                    @SC90037 01165000
KSUBM3   DC    C')'                                            @SC90037 01166000
*                                                                       01167000
FSCBEG   DC    H'1'          Screen adr for first output line  @SC90264 01168000
FSCEND   DC    Y(80*22-1)    Limiting screen adr               @SC90264 01169000
KSYSNIT  CSECT                                                 @SC89215 01170000
.DS      ANOP                                                           01171000
&P.DEFS  DS    0D                                                       01172000
*                                                                       01173000
&P.KPRPL DC    AL1(1+L'KPRPT)                                  @SC89334 01174000
&P.KPRPT DC    C'Kermit-CICS>'                                 @SC90264 01175000
         DC    AL1(XON)                                        @SC89334 01176000
         ORG   &P.KPRPT+21                                     @SC89334 01176500
&P.LNDLM DC    C' '          Initially no delimiter            @SC88095 01177000
         MEND                                                           01180000
*COPY                                                 KSYSBUF           01181000
         MACRO                                                          01182000
         KSYSBUF                                                        01183000
.* Store buffer ptrs from R1 and increment R1 for specific buffers      01184000
.*                                                                      01185000
         ST    1,STRBUF      Ptr to string editing buffer      @SC90264 01186000
         LA    1,256(,1)                                   8*N @SC90264 01187000
         ST    1,GTLBUFP     Ptr to terminal input buffer      @SC90264 01188000
         LA    1,256(,1)                                   8*N @SC90264 01189000
         ST    1,QFNBP       Ptr to ring of QFN buffers        @SC90264 01190000
         LA    1,((3*(QFNSIZ+4)+7)/8)*8(,1)                8*N @SC90264 01191000
         MEND                                                           01192000
*COPY                                                 SSYMS             01193000
         MACRO                                                          01194000
         SSYMS                                                          01195000
.* Set global symbols for conditional assembly                          01196000
         GBLC  &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT  @SC88309 01197000
         GBLC  &KEDIT,&STORDS,&KTAG,&AEACMD,&CONOPTS,&S1CMD1   @SC91311 01198000
         GBLC  &USER,&KTRMS                                    @SC91260 01199000
         GBLA  &MAXLR,&MAXBS                                   @SC86268 01200000
         GBLC  &ANYCICS,&BADFSPC,&BADOUTF,&BYTSALW,&BYTSUSD    @SC92300 01200050
         GBLC  &CWDERRM,&DESTINA,&DIRHDNG,&FILCLSN,&FMTFSPC    @SC92300 01200100
         GBLC  &NODIRDF,&NOFSPEC,&OTHERL6                      @SC92300 01200150
&KSYS    SETC  'CICS'        System name                       @SC90264 01201000
  MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***'    01202000
** BEGIN LANGUAGE-SPECIFIC DATA **   ** CICS-specific **       @SC92300 01202030
&ANYCICS SETC 'any CICS program'                               @SC90264 01202060
&BADFSPC SETC 'Invalid filespec'                               @SC90264 01202090
&BADOUTF SETC 'Illegal output file'                            @SC90264 01202120
&BYTSALW SETC ' bytes allowed, '                               @SC90264 01202150
&BYTSUSD SETC ' bytes used in '                                @SC90264 01202180
&CWDERRM SETC 'Must be a valid file prefix'                    @SC92300 01202210
&DIRHDNG SETC 'Name                   RFM   LRECL   #recs  Kbytes  Type+01202240
                    Date/time'                                 @SC92150 01202270
&FILCLSN SETC 'File name collision'                            @SC90264 01202300
&FMTFSPC SETC 'Enter filespec'                                 @SC91224 01202330
&NODIRDF SETC 'No directory defined'                           @SC90264 01202360
&NOFSPEC SETC 'Missing filespec'                               @SC90264 01202390
&OTHERL6 SETC 'OTHER'       Must be length <7                  @SC92300 01202420
* Subcommand keywords                                                   01202450
&DESTINA SETC 'PREFIX'          kwd->AAAASET, m=3              @SC87166 01202480
** END LANGUAGE-SPECIFIC DATA **                               @SC92300 01202510
&MAXLR   SETA  32767         Max lrecl                         @SC91150 01203000
&MAXBS   SETA  32767         Max blksize                       @SC86268 01204000
&S1CMD   SETC  '0X''0'''     S/1 command prefix                @SC90264 01205000
&S1CMD1  SETC  '0X''0'''     S/1 command prefix for Status     @SC91311 01205100
&CONOPTS SETC  'STCNORD+STCQBIT'  SETCON options               @SC91311 01205200
&AEACMD  SETC  '0X''0'''     AEA command prefix (X'F3'=WSF)    @SC90173 01206000
&KCONT   SETC  'T'           Default controller type (TTY)     @SC88309 01207000
LIMDSK   EQU   100000        User disk space quota for KSDS    @SC90264 01208000
CUTDSK   EQU   150000        Storage cutoff ("disk full")      @SC90264 01209000
QFNSIZ   EQU   54            Length of quoted file name        @SC90264 01210000
MAXWT    EQU   1024          Max TTY write buffer              @SC90264 01211000
MAXRT    EQU   1024          Max TTY read buffer               @SC90264 01212000
MAXWS    EQU   1920          Max fullscreen input buffer       @SC90277 01213000
MAXRS    EQU   1920          Max fullscreen output buffer      @SC90277 01214000
FSRDOF   EQU   3             Offset of data in fullscreen read @SC92030 01214500
MAXDOF   EQU   LFKEY         Data offset into buffer           @SC90264 01215000
STMGT    EQU   0             Overhead for storage mngmnt       @SC90264 01216000
&TYPCMD  SETC  'TYPE'        Host command for TYPE             @SC90264 01217000
TYPMIN   EQU   2             Min abbrv of system TYPE cmd or 2 @SC90264 01218000
FBRK1    EQU   C'<'          Starting character for options    @SC89218 01219000
FBRK2    EQU   C'>'          Ending character for options      @SC89218 01220000
KMAXE    EQU   1920          < 9025  Kermit extended max pkt   @SC90264 01221000
STKDWDS  EQU   511           Size of save-area stack           @SC87012 01222000
&STORDS  SETC  'DFHEISTG'    Append Kermit globals to STG      @SC90264 01223000
KSUBBASE EQU   12            Base register for CSECT           @SC89268 01224000
KWRKBASE EQU   11            Base register for work area       @SC89268 01225000
&USER    SETC  'OPID'        Use OPID for id                   @SC90264 01226000
&KTRMS   SETC  ';;;;'        Signal for inserting terminal id  @SC91260 01226500
         WXTRN KVALID        External security routine         @SC90264 01227000
         WXTRN KHOST,KHIDE   External security routine         @SC90264 01228000
         MEND                                                  @SC86268 01229000
*COPY                                                 SYSMACS           01230000
         MACRO                                                          01231000
         SYSMACS                                                        01232000
.* Include system control block definition macros and list all macros   01233000
 MNOTE '---COPIES: DFHCSADS, DFHDCTDS, DFHTSMDS'                        01234000
 MNOTE '---MACROS: DFHEIEND, DFHEIENT, DFHEIRET, DFHEISTG,'             01235000
 MNOTE '---        EXEC'                                                01236000
         KFSBLK ,                                              @SC90264 01237000
         COPY  DFHCSADS                                        @SC90264 01238000
DCTCBAR  EQU   8             Ptr to DCT entry                  @SC90264 01239000
         COPY  DFHDCTDS                                        @SC90264 01240000
         AIF   ('&SYSPARM' GE '1.7').CICS2                     @SC90264 01241000
TDDCTSDS EQU   TDDCTCBA      Ptr to DCB info CICS 1.6          @SC90264 01242000
DCTSDSTF EQU   DCTSDSCI+48   TYPEFILE status (= OFLGS in DCB)  @SU91304 01243000
DCTSDSOP EQU   X'80'         Output                            @SC90264 01244000
DCTSDSRF EQU   DCTSDSCI+36   RECFM in DCB                      @SU91304 01245000
DCTSDSBL EQU   DCTSDSCI+62   BLKSIZE in DCB                    @SU91304 01246000
DCTSDSRL EQU   DCTSDSCI+82   LRECL in DCB                      @SU91304 01247000
.CICS2   ANOP                                                  @SC90264 01248000
         AIF   ('&SYSPARM' LT '3.1').CICS3                     @SC93006 01248200
TDDCTSDS EQU   TDEXASDS      Ptr to SDSCI in CICS 3            @SC93006 01248400
DCTSDSTF EQU   DCTSDTF       TYPEFILE status                   @SC93006 01248600
.CICS3   ANOP                                                  @SC93006 01248800
TSMAPBAR EQU   1                                               @SC90264 01249000
TSGIDBAR EQU   1                                               @NL90264 01250000
TSUTBAR  EQU   1                                               @NL90264 01251000
TSUTEAR  EQU   1                                               @NL90264 01252000
         COPY  DFHTSMDS                                        @SC90264 01253000
         DROP  TSMAPBAR                                        @SC90264 01254000
         DFHEISTG ,                                            @SC90264 01255000
         MEND                                                  @SC86268 01256000
*COPY                                                 STRTMSGS          01257000
         MACRO                                                          01258000
&LABEL   STRTMSGS                                                       01259000
.* Print system-dependent start-up messages                             01260000
         GBLC  &HANDXON                                        @SC92300 01260500
&LABEL   CLI   S1HND,XON                                       @SC87338 01261000
         BNE   STRT1Z                                          @SC87338 01262000
         BAL   14,TTYCHK                                       @SC92030 01263000
          B    STRT1Z        TTY, suppress message             @SC87338 01264000
         WTEXT '&HANDXON'                                      @SC87338 01265000
STRT1Z   DS    0H                                              @SC87338 01266000
         MEND                                                  @SC87338 01267000
*COPY                                                 KMAIN             01268000
         MACRO                                                          01269000
&LABEL   KMAIN &TYPE                                                    01270000
.* Linkage conventions with system.                                     01271000
.*  &1: ENTER if entering, RETURN if returning                          01272000
         GBLC  &RTN                                            @SC90264 01273000
         AIF   ('&TYPE' NE 'RETURN').ENT                       @SC89268 01274000
&LABEL   DS    0H                                              @SC90264 01275000
         L     DFHEIBR,DFHEIBP                                 @SC91150 01276000
         USING DFHEIBLK,DFHEIBR                                @SC91150 01277000
         ICM   2,15,DFHEICAP Any comm area?                    @SC91150 01278000
         BZ    KR&SYSNDX     No, issue a read                  @SC91150 01279000
         CLC   EIBCALEN,=H'7' Length of comm area?             @SC91150 01280000
         BL    KR&SYSNDX     Not long enough for a return code @SC91150 01281000
         MVC   0(7,2),=C'R(....)'  Set up for return code      @SC91150 01282000
         STM   15,15,2(2)    Ok return it                      @SC91150 01283000
KR&SYSNDX DS   0H                                              @SC91150 01284000
         DROP  DFHEIBR                                         @SC91150 01285000
         DFHEIRET            Unlink                            @SC90264 01286000
         MEXIT ,                                               @SC89268 01287000
.ENT     AIF   ('&TYPE' NE 'ENTER').OTH                        @SC89268 01288000
&LABEL   DFHEIENT DATAREG=(KWRKBASE),CODEREG=(KSUBBASE),       @LM90264+01289000
               EIBREG=(4)                                      @SC90264 01290000
         L     10,=A(COMMON) Common code addressibility        @SC86316 01291000
         LA    0,STORAG                                        @SC86295 01292000
         LA    1,8*STODWDS   Length of storage                 @SC86295 01293000
         SR    15,15         Zero fill                         @SC86295 01294000
         MVCL  0,14                                            @SC86295 01295000
         LR    15,0          Start of stack                    @SC86295 01296000
         A     0,=A(8*STKDWDS) End of stack                    @SC87012 01297000
         STM   15,0,STKPTR                                     @SC86295 01298000
         ST    15,STKLO                                        @SC89089 01299000
         LR    15,KSUBBASE   Get entry address                 @SC90264 01300000
         MEXIT ,                                               @SC89268 01301000
.OTH     MNOTE 12,'Invalid type &TYPE'                         @SC89268 01302000
         MEND                                                  @SC87338 01303000
*COPY                                                 SETUSER  @SC90264 01304000
         MACRO                                                 @SC90264 01305000
&LABEL   SETUSER                                                        01306000
.* Grab appropriate userid according to global symbol &USER    @SC90264 01307000
.* The code can use R0-9,14,15 but should avoid USING's        @SC90264 01308000
.* Valid values: OPID, TERM, UID, OTHER.                       @SC92150 01309000
         GBLC  &USER                                           @SC90264 01310000
         AIF   ('&USER' NE 'OPID').CHKTRM                      @SC90264 01311000
&LABEL   MVC   KUSERID(3),COPID Set default directory          @SC90264 01312000
         MVC   KUSERID+3(5),=CL5' '                            @SC92150 01313000
         MEXIT                                                 @SC90264 01314000
.CHKTRM  AIF   ('&USER' NE 'TERM').CHKUID                      @SC92150 01315000
&LABEL   L     15,DFHEIBP                                      @SC90264 01316000
         MVC   KUSERID,EIBTRMID-DFHEIBLK(15)                   @SC90264 01317000
         MVC   KUSERID+4(4),=CL4' '                            @SC92150 01317500
         MEXIT                                                 @SC90264 01318000
.CHKUID  AIF   ('&USER' NE 'UID').CHKOTH                       @SC92150 01318200
&LABEL   EXEC CICS ASSIGN USERID(KUSERID),                     @SC92150 01318400
         MEXIT                                                 @SC92150 01318600
.CHKOTH  AIF   ('&USER' NE 'OTHER').ERR                        @SC90264 01319000
         KCALL KUSER,KUSERID,EXT                               @SC90264 01320000
         MEXIT                                                 @SC90264 01321000
.ERR     MNOTE 12,'Invalid USER type &USER'                    @SC90264 01322000
         MEND                                                  @SC90264 01323000
*COPY                                                 SAVE              01324000
         MACRO                                                          01325000
&LABEL   SAVE  &REGS,&DUM,&TAG                                 @SC90264 01326000
.* Save registers as in OS type-1 linkage                               01327000
.*  &1: (reg1,reg2) to save, &2 is not used, &3: optional eyecatcher    01328000
         LCLA  &LEN,&OFF                                       @SC90264 01329000
         LCLC  &NAME                                           @SC90264 01330000
         AIF   (N'&REGS NE 2).ER1                              @SC90264 01331000
         AIF   ('&TAG' EQ '').NOTAG                            @SC90264 01332000
         AIF   ('&TAG' EQ '*').DEFTAG                          @SC90264 01333000
&NAME    SETC  '&TAG'                                          @SC90264 01334000
&LEN     SETA  K'&TAG                                          @SC90264 01335000
         AGO   .SETTAG                                         @SC90264 01336000
.DEFTAG  ANOP                                                  @SC90264 01337000
&NAME    SETC  '&LABEL'                                        @SC90264 01338000
&LEN     SETA  1                                               @SC90264 01339000
         AIF   ('&LABEL' NE '').LOOPC                          @SC90264 01340000
&NAME    SETC  '&SYSECT'                                       @SC90264 01341000
.LOOPC   AIF   ('&NAME'(1,&LEN) EQ '&NAME').SETTAG             @SC90264 01342000
&LEN     SETA  &LEN+1                                          @SC90264 01343000
         AGO   .LOOPC                                          @SC90264 01344000
.SETTAG  ANOP                                                  @SC90264 01345000
&OFF     SETA  ((&LEN+6)/2)*2                                  @SC90264 01346000
&LABEL   B     &OFF.(,15)    Skip over tag                     @SC90264 01347000
         DC    AL1(&LEN)     Length of tag                     @SC90264 01348000
         DC    C'&NAME'      Tag                               @SC90264 01349000
         AGO   .STOR                                           @SC90264 01350000
.NOTAG   ANOP                                                  @SC90264 01351000
&LABEL   DS    0H                                              @SC90264 01352000
.STOR    AIF   (T'&REGS(1) NE 'N').ER1                         @SC90264 01353000
&OFF     SETA  &REGS(1)*4+20                                   @SC90264 01354000
         AIF   (&OFF LE 75).OFFOK                              @SC90264 01355000
&OFF     SETA  &OFF-64                                         @SC90264 01356000
.OFFOK   STM   &REGS(1),&REGS(2),&OFF.(13)  Save               @SC90264 01357000
         MEXIT                                                 @SC90264 01358000
.ER1     MNOTE 12,'INVALID REGISTER LIST &REGS'                @SC90264 01359000
         MEND                                                  @SC90264 01360000
*COPY                        Global variables in open code     @SC91260 01390000
         GBLC  &KTRMS                                          @SC91260 01391000
