*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 00805100
         AIF   ('&KVRSN' EQ '4.2' OR '&KSYS' EQ '').VOK        @SC90072 00805200
   MNOTE 16,'* * * --> IKTMAC version number should be &KVRSN' @SC89027 00805300
.VOK     ANOP                                                  @SC89027 00805400
&LABEL   DS    0H                                              @SC86299 00806000
         AIF   (T'&PROMPT EQ 'O').NOPR                         @SC87268 00807000
         AIF   ('&PROMPT(1)'(1,1) NE '(').NOSV1                @SC89214 00807100
         ST    &PROMPT(1),RTXTSV  Save register, in case (1)   @SC89214 00807200
.NOSV1   ANOP                                                  @SC89214 00807300
         KCALL SUPFNC,7,E=RTE&SYSNDX Skip prompt if stacked    @SC88095 00807400
         AIF   ('&PROMPT(1)'(1,1) NE '(').NOSV2                @SC89214 00807500
         L     &PROMPT(1),RTXTSV                               @SC89214 00807600
.NOSV2   ANOP                                                  @SC89214 00807700
         TPUT  &PROMPT(1),&PROMPT(2),ASIS                      @SC87268 00808000
.NOPR    ANOP                                                           00809000
RTE&SYSNDX KCALL GETLIN,&BUF,E=&E                              @SC88095 00809100
         MEND                                                           00810000
*COPY                                                 DMSFREE           00811000
         MACRO                                                          00812000
&LABEL   DMSFREE &DWORDS=(0),&ERR=                                      00813000
.* Obtain free storage block: len=8*(R0).  Returns ptr in R1, but       00814000
.*    preserves registers 2-14                                          00815000
.*  &DWORDS= length in doublewords should be in R0,                     00816000
.*  &ERR= branch if failure                                             00817000
&LABEL   LREG  0,&DWORDS                                       @SC86299 00818000
         SLA   0,3                                             @SC86299 00819000
         AIF   ('&ERR' NE '').COND                             @SC86345 00820000
         GETMAIN R,LV=(0)                                      @SC86299 00821000
         MEXIT                                                          00822000
.COND    GETMAIN RC,LV=(0)                                     @SC86345 00823000
         LTR   15,15                                           @SC86345 00824000
         BNZ   &ERR                                            @SC86345 00825000
         MEND                                                           00826000
*COPY                                                 DMSFRET           00827000
         MACRO                                                          00828000
&LABEL   DMSFRET &DWORDS=(0),&LOC=(1),&ERR=                             00829000
.* Return free storage block: len=8*(R0), adr=(R1).  Preserve R2-14.    00830000
.*  &DWORDS= length in doublewords should be in R0, &LOC= adr (in R1),  00831000
.*  &ERR= branch if failure                                             00832000
&LABEL   LREG  0,&DWORDS                                       @SC86299 00833000
         SLA   0,3                                             @SC86299 00834000
         FREEMAIN R,LV=(0),A=&LOC                              @SC86299 00835000
         MEND                                                           00836000
*COPY                                                 WRITF             00837000
         MACRO                                                          00838000
&LABEL   WRITF &TICK,&BUFFER=,&BSIZE=,&E=                               00839000
.* Write to a disk file (ticket ptr in R1)                              00840000
.*  &1: adr of file access ticket returned by OPENF (A),                00841000
.*  &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00842000
.*  given, it replaces FDB value (see OPENF), &E= branch on error       00843000
&LABEL   READF &TICK,BUFFER=&BUFFER,BSIZE=&BSIZE,E=&E,CODE=10           00844000
         MEND                                                           00845000
*COPY                                                 READF             00846000
         MACRO                                                          00847000
&LABEL   READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=,&CODE=9                00848000
.* Read from disk file (or write) (see WRITF, but also...)              00848500
.*  &2: NONUM means chop off numbers                                    00849000
         LCLC  &R                                              @SC86299 00850000
         LCLA  &C                                              @SC88101 00850100
&C       SETA  &CODE                                           @SC88101 00850200
         AIF   (T'&NONUM EQ 'O').RDC                           @SC88101 00850300
         AIF   ('&NONUM' NE 'NONUM').ER1                       @SC88101 00850400
&C       SETA  0             Code 0 means exclude sequence nos.@SC88101 00850500
.RDC     ANOP                                                  @SC88101 00850600
&LABEL   L     1,&TICK                                         @SC86299 00851000
         AIF   ('&BUFFER' EQ '').BZ                            @SC86299 00852000
         AIF   ('&BUFFER'(1,1) NE '(').BLA                     @SC86299 00853000
&R       SETC  '&BUFFER(1)'                                    @SC86299 00854000
         AGO   .BST                                            @SC86299 00855000
.BLA     LA    15,&BUFFER                                      @SC86299 00856000
&R       SETC  '15'                                            @SC86299 00857000
.BST     ST    &R,FDBBUFF-FABD(1)                              @SC86299 00858000
.BZ      AIF   ('&BSIZE' EQ '').SZ                             @SC86299 00859000
         AIF   ('&BSIZE'(1,1) NE '(').SLA                      @SC86299 00860000
&R       SETC  '&BSIZE(1)'                                     @SC86299 00861000
         AGO   .SST                                            @SC86299 00862000
.SLA     LA    15,&BSIZE                                       @SC86299 00863000
&R       SETC  '15'                                            @SC86299 00864000
.SST     ST    &R,FDBBSIZ-FABD(1)                              @SC86299 00865000
.SZ      LA    0,&C                                            @SC88101 00866000
         KCALL DISKIO,E=&E                                     @SC86299 00867000
         MEXIT                                                          00867300
.ER1     MNOTE 2,'INVALID PARAMETER ''&NONUM'''                @SC88101 00867600
         MEND                                                           00868000
*COPY                                                 SAVEF             00868100
         MACRO                                                          00868200
&LABEL   SAVEF &TICK,&E=                                       @SC88168 00868300
.* Update disk directory for given file (ticket ptr in R1)              00868400
.*  &1: adr of file access ticket (A), &E= branch on error              00868500
&LABEL   L     1,&TICK                                         @SC88168 00868600
         READF &TICK,E=&E,CODE=21                              @SC88168 00868700
         MEND                                                           00868800
*COPY                                                 KSETKW            00869000
         MACRO                                                          00870000
         KSETKW ,                                              @SC87166 00871000
.* Define system-specific SET/SHOW parameters (keywords)                00872000
         KW    'DELIM',SHODLM,MIN=4                            @SC88095 00872500
         KW    'PREFIX',SHODST,MIN=3                           @SC87166 00873000
         MEND                                                           00875000
*COPY                                                 KSETPRC           00876000
         MACRO                                                          00877000
         KSETPRC                                                        00878000
.* System-specific SET handlers (in any order).  No operands.           00879000
         PUSH  PRINT                                           @SC86355 00880000
         PRINT GEN                                             @SC86355 00881000
SETDST   KCALL CWDSET                                          @SC86164 00882000
         B     RTRN          Preserve return code              @SC86295 00883000
SETDLM   NTOKN N=SETDLM1,H=SETDLMH                             @SC88095 00883100
         LTR   7,7           Exactly one character?            @SC88095 00883200
         BNZ   SETDLMH       No, explain it                    @SC88095 00883300
         MVC   LNDLM,0(6)    Yes, use that character           @SC88095 00883400
         B     RTRN0                                           @SC88095 00883500
SETDLM1  MVI   LNDLM,C' '    Turn delimiter off                @SC88095 00883600
         B     RTRN0                                           @SC88095 00883700
SETDLMH  PTEXT 'Line delimiter: one char or none'              @SC88095 00883800
         B     SUBERR                                          @SC88095 00883900
         POP   PRINT                                           @SC86355 00884000
         MEND                                                           00885000
*COPY                                                 KSHOPRC           00886000
         MACRO                                                          00887000
         KSHOPRC                                                        00888000
.* System-specific SHOW handlers (in same order as KW).  No operands.   00889000
         PUSH  PRINT                                           @SC86355 00890000
         PRINT GEN                                             @SC86355 00891000
SHODLM   LA    8,LNDLM       Show delimiter                    @SC88095 00891200
         BAL   14,SHOCHR                                       @SC88095 00891400
          B    SETDLM                                          @SC88095 00891600
SHODST   LA    8,DEST                                          @SC86316 00892000
         LH    9,DESTL       Get length                        @SC86316 00893000
         BAL   14,SHOCHRN                                      @SC86295 00894000
          B    SETDST                                          @SC87166 00895000
         POP   PRINT                                           @SC86355 00898000
         MEND                                                           00899000
*COPY                                                 KFILKW            00900000
         MACRO                                                          00901000
         KFILKW ,                                              @SC87166 00902000
.* Define system-specific file attribute parameters (keywords)          00903000
         KW    'BLKSIZE',SHOBSZ,MIN=2                          @SC87166 00904000
         KW    'RECFM',SHORFM                                  @SC87166 00905000
         KW    'SPACE',SHOTRK,MIN=2                            @SC87166 00906000
         KW    'UNIT',SHOUNT                                   @SC87166 00907000
         KW    'VOLUME',SHOVOL,MIN=2                           @SC87166 00908000
         MEND                                                           00909000
*COPY                                                 KFILSET           00910000
         MACRO                                                          00911000
         KFILSET                                                        00912000
.* Specific SET FILE handlers (any order).  No operands.                00913000
         PUSH  PRINT                                           @SC87012 00914000
         PRINT GEN                                             @SC87012 00915000
SETRECVF MVC   FILRCF,0(6)   Copy RECFM                        @SC88120 00916000
         B     RTRN0                                           @SC87012 00917000
*                                                              @SC87012 00918000
SETRFM   BAL   4,SETSCN                                        @SC87012 00919000
         KW    'FIXED',SETRECVF                                @SC87012 00920000
         KW    'VARIABLE',SETRECVF                             @SC87012 00921000
         KW    'UNDEFINED',SETRECVF                            @SC86295 00922000
         KW    ,                                               @SC87012 00923000
*                                                                       00924000
SETUNT   BAL   2,SETFSTR     Get fixed-format string           @SC86316 00925000
         TR    FILUNT,UPCASE Should always be upper case       @SC88020 00925500
         MVC   LOGUNT,FILUNT                                   @SC86316 00926000
         B     RTRN0                                           @SC86316 00927000
*                                                                       00928000
SETVOL   BAL   2,SETFSTR     Get fixed-format string           @SC86295 00929000
         TR    FILVOL,UPCASE Should always be upper case       @SC88020 00929500
         MVC   LOGVOL,FILVOL                                   @SC86316 00930000
         B     RTRN0                                           @SC86295 00931000
         POP   PRINT                                           @SC87012 00932000
         MEND                                                           00933000
*COPY                                                 KFILSHO           00934000
         MACRO                                                          00935000
         KFILSHO                                                        00936000
.* Specific SHOW FILE handlers (same order as KW).  No operands.        00937000
         PUSH  PRINT                                           @SC87012 00938000
         PRINT GEN                                             @SC87012 00939000
SHOBSZ   L     8,MAXBSZ      Limit                             @SC87166 00940000
         LH    4,FILBLKSI                                      @SC87320 00941000
         BAL   14,SHONUM     Print it                          @SC86295 00942000
          B    RTRN0                                           @SC86295 00943000
SHORFM   LA    8,FILRCF                                        @SC88120 00944000
         BAL   14,SHOCHR                                       @SC87012 00945000
          B    SETRFM                                          @SC87166 00946000
SHOTRK   L     8,MAXBSZ      Limit                             @SC87166 00947000
         L     4,FILTRKAL                                      @SC88026 00948000
         BAL   14,SHONUM     Print it                          @SC86295 00949000
          B    RTRN0                                           @SC87166 00950000
SHOUNT   LA    8,FILUNT                                        @SC86316 00951000
         LA    9,8                                             @SC86316 00952000
         BAL   14,SHOCHRN                                      @SC86316 00953000
          B    SETUNT                                          @SC87166 00954000
SHOVOL   LA    8,FILVOL                                        @SC86295 00955000
         LA    9,6                                             @SC86295 00956000
         BAL   14,SHOCHRN                                      @SC86295 00957000
          B    SETVOL                                          @SC87166 00958000
         POP   PRINT                                           @SC87012 00959000
         MEND                                                           00960000
*COPY                                                 WTEXT             00961000
         MACRO                                                          00962000
&LABEL   WTEXT &ARG,&LEN                                                00963000
.* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4)           00964000
.* Preserves R2-R14                                                     00965000
.*  &1: 'text' (where text has no doubled ' or & characters)  OR        00966000
.*  &1: adr of text (LA/R), &2: length of text (LA/R)                   00967000
&LABEL   PTEXT &ARG,&LEN,AREG=1,LREG=0                         @SC86295 00968000
         BAL   15,WTEXT      'TPUT'                            @SC87020 00969000
         MEND                                                           00970000
*COPY                                                 FDBD              00971000
         MACRO                                                          00972000
         FDBD                                                           00973000
.* Map of File Descriptor Block + File Access Block                     00974000
FABD     DSECT ,                                               @SC86295 00975000
FABRELAD DS    17X           FAB maps DCB                      @SC86299 00976000
FABREL   DS    AL3                                             @SC86299 00977000
FABBUFNO DS    0BL1                                            @SC86299 00978000
FABBUFCB DS    A                                               @SC86299 00979000
FABBUFL  DS    H                                               @SC86299 00980000
FABDSORG DS    BL2                                             @SC86299 00981000
FABIOBAD DS    A                                               @SC86299 00982000
FABEODAD DS    A                                               @SC86299 00983000
FABRECFM DS    0BL1                                            @SC86299 00984000
FABRECU  EQU   X'C0'         Undefined-length records          @SC86299 00985000
FABRECF  EQU   X'80'         Fixed-length records              @SC86299 00986000
FABRECV  EQU   X'40'         Varying-length records            @SC86299 00987000
FABRECBR EQU   X'10'         Blocked records                   @SC86299 00988000
FABRECCC EQU   X'06'         Control chars present             @SC88106 00988500
FABEXLST DS    A                                               @SC86299 00989000
FABDDNAM DS    CL8                                             @SC86299 00990000
FABOFLGS DS    BL1                                             @SC86299 00991000
FABIFLG  DS    BL1                                             @SC86299 00992000
FABMACR  DS    BL2                                             @SC86299 00993000
         ORG   FABDDNAM                                        @SC86299 00994000
FABTIOT  DS    BL2                                             @SC86299 00995000
FABMACRF DS    BL2                                             @SC86299 00996000
FABDEBAD DS    A                                               @SC86299 00997000
FABGET   DS    A                                               @SC86299 00998000
FABCHECK DS    A                                               @SC86299 00999000
FABSYNAD DS    A                                               @SC86299 01000000
FABCIND1 DS    BL2                                             @SC86299 01001000
FABBLKSI DS    H                                               @SC86299 01002000
FABWCPO  DS    BL4                                             @SC86299 01003000
FABIOBA  DS    A                                               @SC86299 01004000
FABEOBAD DS    A                                               @SC86299 01005000
FABRECAD DS    A                                               @SC86299 01006000
FABDIRCT DS    H                                               @SC86299 01007000
FABLRECL DS    H                                               @SC86299 01008000
FABCNTRL DS    A                                               @SC86299 01009000
         ORG   FABD+90                                         @SC86299 01010000
FABPRECL DS    AL2                                             @SC86299 01011000
FABEOB   DS    A                                               @SC86299 01012000
FDBD     DS    0F            Beginning of short descriptor     @SC86295 01013000
FDBBUFF  DS    A             Buffer ptr                        @SC86295 01014000
FDBBSIZ  DS    F             Max record length                 @SC86295 01015000
FDBRCF   DS    C             Record format                     @SC86295 01016000
FDBFLGS  DS    X             Flags                             @SC86295 01017000
FDBACTV  EQU   X'80'         File is already open              @SC86295 01018000
* SVATT  EQU   X'40'         Preserve attributes               @SC90033 01018500
* APPN   EQU   X'10'         DISP=MOD                          @SC86295 01019000
*ABRECCC EQU   X'06'         Control chars present             @SC88246 01020000
PDSF     EQU   X'01'         Dataset is a PDS                  @SC87015 01021000
FDBLRC   DS    H             File record length                @SC86295 01022000
FDBTRKAL DS    F             File track allocation increment   @SC88026 01023000
FDBBLKSI DS    H             File block size                   @SC86295 01024000
FDBDEVT  DS    XL4           Device type (must precede VOL)    @SC88106 01024500
FDBVOL   DS    CL6           File volume label                 @SC86295 01025000
FDBUNT   DS    CL8           File unit name                    @SC86299 01026000
FDBSIZE  DS    F             File size in Kbytes               @SC86299 01028000
FDBCOP   EQU   *-FDBD        Length to copy for OPEN           @SC90037 01028500
FDBDATE  DS    XL7,X         Time stamp: packed yyyymmddhhmmss @SC88235 01029000
FABDSN   DS    CL52          Dataset name                      @SC86299 01032000
FABDSMB  EQU   FABDSN+44,8   Member name                       @SC88119 01032050
FDBINFO  EQU   *-FDBD        Length of info returned           @SC86295 01032100
FABLRTR  DS    F             Record length for truncation      @SC88120 01032300
FABEXL   DS    3A            Modifiable EXLST                  @SC89073 01032600
FABCOMM  DS    CL8           Command name                      @SC87351 01033000
FABDWDS  EQU   (*-FABD+7)/8                                    @SC86295 01034000
         MEND                                                           01035000
*COPY                                                 FDBPAT            01036000
         MACRO                                                          01037000
         FDBPAT &N,&RFM,&SIZ                                   @SC88120 01038000
.* Define system-dependent part of output FDB patterns                  01039000
.*  &1: variable-name prefix (or null if defining init. values)         01040000
.*  &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 01040500
         LCLC  &T,&B,&D,&V,&U,&Z                               @SC88287 01041000
         LCLC  &R,&F,&L,&S,&P4                                 @SC90037 01041500
         AIF   ('&N' EQ '').ALC                                @SC86316 01042000
&R       SETC  'RCF'                                           @SC88120 01042200
&F       SETC  'FLGS'                                          @SC88120 01042400
&L       SETC  'LRC'                                           @SC88120 01042600
&T       SETC  'TRKAL'                                         @SC87320 01043000
&B       SETC  'BLKSI'                                         @SC87320 01044000
&D       SETC  'DEVT'                                          @SC88287 01044500
&V       SETC  'VOL'                                           @SC86316 01045000
&U       SETC  'UNT'                                           @SC86316 01046000
&S       SETC  'FSIZ'                                          @SC90037 01046500
.ALC     ANOP                                                  @SC86316 01047000
&N&R     DC    C'&RFM'       RECFM                             @SC88120 01047100
&N&F     DC    X'00'         Flags                             @SC88120 01047200
         AIF   ('&SIZ' EQ '').DONE                             @SC88120 01047300
         AIF   ('&RFM' NE 'V').OKL                             @SC88120 01047400
&P4      SETC  '+4'          Add 4 for RDW                     @SC88120 01047500
.OKL     ANOP                                                  @SC88120 01047600
&N&L     DC    Y(&SIZ&P4)    LRECL                             @SC88120 01047700
&N&T     DC    F'5'          Track allocation                  @SC88026 01048000
&Z       SETC  '6233'        Default block size                @SC87320 01049000
         AIF   ('&SIZ' NE 'LPKT').P1                           @SC88120 01050000
&Z       SETC  'LPKT+8'      Block size for log file           @SC87320 01051000
.P1      ANOP                                                           01052000
&N&B     DC    Y(&Z)                                           @SC87320 01053000
&N&D     DC    XL4'0'        Device type (must precede VOL)    @SC88287 01053500
&N&V     DC    CL6' '        No volume specified               @SC87320 01054000
&N&U     DC    CL8' '        Default unit                      @SC88054 01055000
&N&S     DC    F'0'          File size in Kbytes               @SC90037 01055200
.DONE    ANOP                                                  @SC88120 01055500
         MEND                                                           01056000
*COPY                                                 KSYSVAR           01057000
         MACRO                                                          01058000
         KSYSVAR                                                        01059000
.* Define system-dependent globally-known variables                     01060000
COMPTR   DS    2A            Common/storage ptrs               @SC87015 01061000
APGPB    GETLINE MF=L        Parameter block for GETLINE       @NW86330 01062000
STAXPLR  STAX  0,MF=L        Parameter block for STAX (replace)@NW86330 01064000
IOPLAREA DS    4F            IOPL                              @TS86001 01065000
ORGPCMD  DS    CL8           Saved ECT PCMD field              @SC89052 01065500
CPECB    DS    F             GETLINE/PUTLINE/PUTGET ECB        @TS86001 01066000
ECBREAD  DS    F                                               @NW86330 01067000
TASKADD  DS    A             Async task adr                    @NW86330 01068000
SYSPROC  DS    A             Ptr to CLIST library DCB          @SC89073 01068500
ECBTGET  DS    F                                               @NW86330 01069000
KTGETT   DS    2F            Adr and length of read request    @SC87015 01070000
PUTLINAD DS    A             Adr of PUTLINE routine            @SC88026 01070500
GETLINAD DS    A             Adr of GETLINE routine            @NW86330 01071000
DFMSGP   DS    A             Ptr to DAIR message buffer        @SC88119 01073000
CATDSPTR DS    A             Catalog buffer ptr                @NW86330 01075000
NXSFPTR  DS    A             Ptr to suffix comparand           @SC87015 01076000
CIRPARM  DS    0F                                              @NW86330 01077000
CIROPT   DS    X'02'         Get all matches                   @NW86330 01078000
         DS    2AL1(0)       Reserved by system                @NW86330 01079000
CIRLOCRC DS    AL1(0)        Locate return code                @NW86330 01080000
CIRSRCH  DS    A             Search arg: adr of test DSN       @NW86330 01081000
CIRCVOL  DS    F'0'          Vol adr=0 - force cat lookup      @NW86330 01082000
CIRWA    DS    A             Ptr to user work area             @NW86330 01083000
CIRSAVE  DS    A             Ptr to save area for macro        @NW86330 01084000
CIRPSWD  DS    F'0'          Adr of password                   @NW86330 01085000
DESTL    DS    H'0'          Length                            @SC86299 01085500
DEST     DS    CL44          Default PREFIX                    @SC86299 01086000
DESTP    DS    C' '          PDS indicator ('.' if so)         @SC86299 01087000
RTXTSV   DS    F             Saved register for prompt         @SC89214 01087050
CAMLOC   DS    4F            Ptrs for locating dataset         @SC86299 01087100
CAMOBT   DS    4F            Ptrs for getting DSCB             @SC86299 01087200
DSKCOD   EQU   CAMOBT        Temp for function code            @SC88101 01087300
CAMVOLS  DS    0D,XL265      Storage for volume list           @SC86299 01087400
CAMDEVT  EQU   CAMVOLS+2,4   1st device type                   @SC88106 01087500
         ORG   CAMVOLS+100   Do a little overlaying            @SC88049 01087600
CAMDSCB  DS    0F,XL101      Storage for DSCB                  @SC88014 01087700
         ORG   CAMDSCB+1                                       @SC88014 01087800
DS1VOL   DS    CL6,XL2       Volume serial                     @SC86299 01087900
DS1CRDT  DS    2XL3,3X,XL8   Creation date                     @GH89270 01088000
DS1MDDT  DS    XL3           Modification date (ASM2)          @GH89270 01088010
DS1MDTM  DS    XL2           Modification time of day (ASM2)   @GH89270 01088020
DS1RFDT  DS    XL3,XL4       Reference date                    @SC86299 01088100
DS1DSO   DS    XL2           Dataset org                       @SC86299 01088200
DS1RCF   DS    X             Record format                     @SC86299 01088300
DS1OPT   DS    X             Error option                      @SC86299 01088400
DS1BLK   DS    H             Block size                        @SC86299 01088500
DS1LRC   DS    H             Logical record length             @SC86299 01088600
LKPMEM   DS    CL8           Temporary for member name if mig. @SC89250 01088650
         ORG   ,                                               @SC86299 01088700
         DS    0F                                              @SC86299 01089000
DSKSTT   EQU   *-FDBD+FABD                                     @SC86299 01090000
         DS    XL(FDBINFO)   Room for FDB                      @SC86299 01091000
NXFN     DS    CL(LFID)      Pattern filespec for search       @SC87015 01092000
DSNPFL   DS    H             Prefix length for search          @NW86330 01093000
DSNSFL   DS    H             Suffix length for search          @NW86330 01094000
ICPRGS   DS    4F            Saved registers for type-out      @SC88026 01095000
ICPFL    DS    X             Flag for type-out interception    @SC87020 01096000
SCRLST   DS    X             Flag for previous I/O op          @SC88091 01096500
STMUCH   DS    XL2           Saved user profile values         @SC86299 01097000
OLDUPTSW DS    X             Old UPTSWS field, saved for STCOM @TL89181 01097100
PTLLEN   DS    0F,2H         PUTLINE data descriptor           @SC88026 01097200
PTLBUF   DS    CL133                                           @SC88026 01097400
STKDSN   DS    CL(LFID)      DSN for STACK                     @SC88026 01097600
*                                                                       01097680
DSKFL    DS    X             Flags for catalog scanning        @SC90033 01097760
NXDON    EQU   X'40'         Catalog search done               @SC87015 01097840
WFN      EQU   X'08'         Filename contains wild chars      @SC88246 01097920
         MEND                                                           01098000
*COPY                                                 KSYSTF            01099000
         MACRO                                                          01100000
         KSYSTF                                                         01101000
.* Define system-dependent globally-known constants and init. variables 01102000
.*  symb .DS + label &P.DEFS mark start of variables/init. values       01103000
         GBLC  &STORDS                                         @SC89268 01103500
         LCLC  &P                                                       01104000
         PUSH  PRINT                                                    01105000
         PRINT GEN                                                      01106000
         AIF   ('&SYSECT' EQ '&STORDS').DS                     @SC89268 01107000
&P       SETC  'I'           For initial values                         01108000
WTEXT    STM   14,1,ICPRGS   Save                              @SC88026 01109000
         CLI   ICPFL,2       Intercepting?                     @SC88026 01109200
         BE    WTXICP        Yes, do it                        @SC88026 01109400
         MVC   PTLBUF,0(1)   Copy to buffer                    @SC88026 01109600
         A     0,F4                                            @SC88026 01109800
         STH   0,PTLLEN      And save length                   @SC88026 01110000
         MVI   CPECB,0       Clear ECB                         @SC88119 01110100
         L     15,PUTLINAD                                     @SC88026 01110200
         PUTLINE PARM=PTPB,MF=(E,IOPLAREA),ENTRY=(15)          @SC88026 01110400
         B     WTXRET                                          @SC87020 01113000
WTXICP   KCALL ICPTYP        Call interception routine         @SC87020 01114000
WTXRET   LM    14,1,ICPRGS   Restore                           @SC88026 01115000
         BR    15                                              @SC87020 01116000
KSYSATOE DC    A(0)          Normal TTY E/A translation        @SC88302 01116300
KSYSETOA DC    A(0)                                            @SC88302 01116600
SYSATR   DC    AL1(ADOT,ABL+2,AI,A2)  ."I2  System type=TSO    @SC88273 01117000
LSYSATR  EQU   *-SYSATR      Length of stuff for A-packet      @SC88273 01117500
LOGNAM   DC    C'KER.LOG'                                      @SC86299 01118000
REPNAM   DC    C'KER.REPLY'                                    @SC86299 01119000
SYSTAKE  DC    C'''SYS1'                                       @SC88113 01120000
DKERMINI DC    C'.KERMINI'''                                   @SC88113 01120500
LSYST    EQU   *-SYSTAKE                                       @SC86299 01121000
USRTAKE  DC    C'KERMINI'    Init file                         @SC86299 01122000
LUSRT    EQU   *-USRTAKE                                       @SC86299 01123000
KMAIL1   DC    C'KERMAIL ' System cmd for invoking mail        @SC90037 01123100
KMAIL2   DC    C' LIST('                                       @SC90037 01123200
KMAIL3   DC    C')'                                            @SC90037 01123300
KPRNT1   DC    C'KERMPRT ' System cmd for printing             @SC90037 01123400
KPRNT2   DC    C' OPTIONS('                                    @SC90037 01123500
KPRNT3   DC    C')'                                            @SC90037 01123600
KSUBM1   DC    C'KERMSUB ' System cmd for submitting job       @SC90037 01123700
KSUBM2   DC    C' OPTIONS('                                    @SC90037 01123800
KSUBM3   DC    C')'                                            @SC90037 01123900
CIRWAL   DC    H'32004,0'    Length of catalog work area       @SC87015 01125000
KSYSNIT  CSECT                                                 @SC89215 01125500
.DS      ANOP                                                           01126000
&P.DEFS  DS    0D                                                       01127000
* Timer exit routine                                           @SC88299 01127090
         USING *,15          Addressiblity for getting ECB     @SC88299 01127180
&P.TMXIT STM   0,1,20(13)    Save registers                    @SC88299 01127270
         ICM   1,15,&P.TMXPT Get ptr to target ECB             @SC88299 01127360
         POST  (1),1                                           @SC88299 01127450
         LM    0,1,20(13)    Restore registers                 @SC88299 01127540
         BR    14            Return to system                  @SC88299 01127630
&P.TMXPT DS    AL4           Ptr to ECB                        @SC88299 01127720
         DROP  15                                              @SC88299 01127810
*                                                                       01127900
&P.KPRPL DC    AL1(L'KPRPT)                                    @SC89268 01128000
&P.KPRPT DC    C'Kermit-TSO>'                                  @SC87268 01129000
         ORG   &P.KPRPT+20                                     @SC87268 01130000
&P.LNDLM DC    C' '          Initially no delimiter            @SC88095 01130200
         POP   PRINT                                                    01131000
&P.PTPB  PUTLINE MF=L,OUTPUT=(0,TERM,SINGLE,DATA)              @SC88026 01131100
         MEND                                                           01132000
*COPY                                                 KSYSBUF           01133000
         MACRO                                                          01134000
         KSYSBUF                                                        01135000
.* Store buffer ptrs from R1 and increment R1 for specific buffers      01136000
         LA    0,4-1                                           @SC87015 01137000
         AR    1,0                                             @SC87015 01138000
         OR    1,0                                             @SC87015 01139000
         XR    1,0                                             @SC87015 01140000
         ST    1,CIRSAVE     Catalog scan save area            @SC87015 01141000
         LA    1,72(1)                                         @SC87015 01142000
         ST    1,CIRWA       Catalog info buffer               @SC87015 01143000
         AH    1,CIRWAL                                        @SC87015 01144000
         ST    1,CIRSRCH     Catalog search comparand          @SC87015 01145000
         LA    1,44(1)                                         @SC87015 01146000
         ST    1,DFMSGP      DAIR message buffer               @SC88119 01146300
         LA    1,512(1)                                        @SC88119 01146600
         MEND                                                           01147000
*COPY                                                 SSYMS             01148000
         MACRO                                                          01149000
         SSYMS                                                          01150000
.* Set global symbols for conditional assembly                          01151000
         GBLC  &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT  @SC88309 01152000
         GBLC  &KEDIT,&STORDS,&KTAG                            @SC90067 01152500
         GBLA  &MAXLR,&MAXBS                                   @SC86268 01153000
&KSYS    SETC  'TSO'         System name                       @SC86299 01154000
  MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***'    01155500
&MAXLR   SETA  32756         Max lrecl                         @SC86299 01156000
&MAXBS   SETA  32760         Max blksize                       @SC86299 01157000
&S1CMD   SETC  'F1C2'        S/1 command prefix                @LP88187 01158000
&KCONT   SETC  'T'           Default controller type (TTY)     @SC88309 01158500
         PUSH  PRINT                                                    01159000
         PRINT GEN                                                      01160000
MAXWT    EQU   1024          Max TPUT buffer                   @SC86299 01161000
MAXRT    EQU   1024          Max TGET buffer                   @SC86299 01162000
LFID     EQU   60            Max length of filespec            @SC88342 01163000
&TYPCMD  SETC  'LIST'        Host command for TYPE             @SC86299 01164000
TYPMIN   EQU   4             Min abbrv of system TYPE cmd or 2 @SC86299 01165000
FBRK1    EQU   C'<'          Starting character for options    @SC89218 01165300
FBRK2    EQU   C'>'          Ending character for options      @SC89218 01165600
KMAXE    EQU   1920-7        < 9025  Kermit extended max pkt   @SC87351 01166000
STKDWDS  EQU   511           Size of save-area stack           @SC87012 01167000
&STORDS  SETC  'KSTORG'      Storage DSECT for Kermit globals  @SC89268 01167200
KWRKBASE EQU   11            Base register for work area       @SC89268 01167400
KSUBBASE EQU   12            Base register for CSECT           @SC89268 01167600
         POP   PRINT                                                    01168000
         MEND                                                  @SC86268 01169000
*COPY                                                 SYSMACS           01170000
         MACRO                                                          01171000
         SYSMACS                                                        01172000
.* Include system control block definition macros and list all macros   01173000
 MNOTE '---MACROs: ATTACH, CATALOG, CLOSE, DETACH, DEVTYPE,'            01174000
 MNOTE '---        ESTAI, FIND, FREEMAIN,'                              01174500
 MNOTE '---        FREEPOOL, GETLINE, GETMAIN, GTSIZE, IDENTIFY,'       01175000
 MNOTE '---        IKJCPPL, IKJECT, IKJGTPB, IKJIOPL, IKJUPT,'          01175050
 MNOTE '---        LINK, LOAD, LOCATE, OBTAIN, OPEN, POST,'             01175100
 MNOTE '---        PUTLINE, RDJFCB, SAVE, SCRATCH, STATUS, STAX,'       01175150
 MNOTE '---        STCOM, STFSMODE, STIMER, STSIZE, SYNADAF,'           01175200
 MNOTE '---        SYNADRLS, TGET, TPG, TPUT, TTIMER, WAIT'             01175250
         IKJCPPL ,                                             @SC86299 01179000
         IKJECT ,                                              @SC86299 01182000
         IKJGTPB ,                                             @NW86330 01183000
         IKJIOPL ,                                             @TS86001 01184000
         IKJUPT ,                                              @SC86299 01186000
* DSECT for addressing catalog information work area                    01187000
CATDSET  DSECT                                                 @NW86330 01188000
TYPEBYTE DS    XL1           Type byte we want only A's        @NW86330 01189000
CATDNAME DS    44CL1         Data set name                     @NW86330 01190000
         MEND                                                  @SC86268 01191000
*COPY                                                 STRTMSGS          01192000
         MACRO                                                          01193000
&LABEL   STRTMSGS                                                       01194000
.* Print system-dependent start-up messages                             01195000
&LABEL   CLI   S1HND,XON                                       @SC87338 01196000
         BNE   STRT1Z                                          @SC87338 01197000
         CLI   TRMTP,C'T'                                      @SC87338 01198000
         BE    STRT1Z                                          @SC87338 01199000
         CLI   TRMTP,C'V'                                      @SC89020 01199300
         BE    STRT1Z                                          @SC89020 01199600
         WTEXT 'Handshake is XON -- not needed'                @SC87338 01200000
STRT1Z   DS    0H                                              @SC87338 01201000
         MEND                                                  @SC87338 01202000
*COPY                                                 KMAIN             01203000
         MACRO                                                          01204000
&LABEL   KMAIN &TYPE                                                    01205000
.* Linkage conventions with system.                                     01206000
.*  &1: ENTER if entering, RETURN if returning                          01207000
         AIF   ('&TYPE' NE 'RETURN').ENT                       @SC89268 01208000
&LABEL   L     13,4(13)      Unlink                            @SC86295 01209000
         ST    15,16(13)     Save return code                  @SC86295 01210000
         LA    0,STODWDS+STKDWDS                               @SC87012 01211000
         LR    1,KWRKBASE                                      @SC89268 01212000
         DMSFRET DWORDS=(0),LOC=(1)                            @SC86295 01213000
         LM    14,12,12(13)  Restore registers                 @SC86295 01214000
         BR    14                                              @SC86295 01215000
         MEXIT ,                                               @SC89268 01216000
.ENT     AIF   ('&TYPE' NE 'ENTER').OTH                        @SC89268 01217000
         LR    KSUBBASE,15                                     @SC89268 01218000
         L     10,=A(COMMON) Common code addressibility        @SC86316 01219000
         LA    0,STODWDS+STKDWDS                               @SC87012 01220000
         DMSFREE DWORDS=(0)  Get storage for vars + stack      @SC86295 01221000
         LR    KWRKBASE,1    Get addressibility                @SC89268 01222000
         LR    0,1                                             @SC86295 01223000
         LA    1,8*STODWDS   Length of storage                 @SC86295 01224000
         SR    15,15         Zero fill                         @SC86295 01225000
         MVCL  0,14                                            @SC86295 01226000
         LR    15,0          Start of stack                    @SC86295 01227000
         A     0,=A(8*STKDWDS) End of stack                    @SC87012 01228000
         STM   15,0,STKPTR                                     @SC86295 01229000
         ST    15,STKLO                                        @SC89089 01230000
         LM    15,1,16(13)   Restore registers                 @SC86295 01231000
         MEXIT ,                                               @SC89268 01232000
.OTH     MNOTE 12,'Invalid type &TYPE'                         @SC89268 01233000
         MEND                                                  @SC89268 01234000
