*COPY                                                 RTEXT             00800000
         MACRO                                                          00800500
&LABEL   RTEXT  &BUF,&PROMPT=,&E=                                       00801000
.* Read from the terminal, possible prompt.  Get length read in R0.     00801500
.*  &1: read buffer (len=130) (LA), &PROMPT(1)= prompt buf. if any      00802000
.*  (LA/R), &PROMPT(2)= prompt length (LA/R), &E= branch if error       00802500
         GBLC  &KVRSN,&KSYS                                    @SC89027 00803000
         AIF   ('&KVRSN' EQ '4.3' OR '&KSYS' EQ '').VOK        @SC90072 00803500
   MNOTE 16,'* * * --> IKTMAC version number should be &KVRSN' @SC89027 00804000
.VOK     ANOP                                                  @SC89027 00804500
&LABEL   DS    0H                                              @SC86299 00805000
         AIF   (T'&PROMPT EQ 'O').NOPR                         @SC87268 00805500
         AIF   ('&PROMPT(1)'(1,1) NE '(').NOSV1                @SC89214 00806000
         ST    &PROMPT(1),RTXTSV  Save register, in case (1)   @SC89214 00806500
.NOSV1   ANOP                                                  @SC89214 00807000
         KCALL SUPFNC,7,E=RTE&SYSNDX Skip prompt if stacked    @SC88095 00807500
         AIF   ('&PROMPT(1)'(1,1) NE '(').NOSV2                @SC89214 00808000
         L     &PROMPT(1),RTXTSV                               @SC89214 00808500
.NOSV2   ANOP                                                  @SC89214 00809000
         TPUT  &PROMPT(1),&PROMPT(2),ASIS                      @SC87268 00809500
.NOPR    ANOP                                                           00810000
RTE&SYSNDX KCALL GETLIN,&BUF,E=&E                              @SC88095 00810500
         MEND                                                           00811000
*COPY                                                 DMSFREE           00811500
         MACRO                                                          00812000
&LABEL   DMSFREE &DWORDS=(0),&ERR=                                      00812500
.* Obtain free storage block: len=8*(R0).  Returns ptr in R1, but       00813000
.*    preserves registers 2-14                                          00813500
.*  &DWORDS= length in doublewords should be in R0,                     00814000
.*  &ERR= branch if failure                                             00814500
&LABEL   LREG  0,&DWORDS                                       @SC86299 00815000
         SLA   0,3                                             @SC86299 00815500
         AIF   ('&ERR' NE '').COND                             @SC86345 00816000
         GETMAIN R,LV=(0)                                      @SC86299 00816500
         MEXIT                                                          00817000
.COND    GETMAIN RC,LV=(0)                                     @SC86345 00817500
         LTR   15,15                                           @SC86345 00818000
         BNZ   &ERR                                            @SC86345 00818500
         MEND                                                           00819000
*COPY                                                 DMSFRET           00819500
         MACRO                                                          00820000
&LABEL   DMSFRET &DWORDS=(0),&LOC=(1),&ERR=                             00820500
.* Return free storage block: len=8*(R0), adr=(R1).  Preserve R2-14.    00821000
.*  &DWORDS= length in doublewords should be in R0, &LOC= adr (in R1),  00821500
.*  &ERR= branch if failure                                             00822000
&LABEL   LREG  0,&DWORDS                                       @SC86299 00822500
         SLA   0,3                                             @SC86299 00823000
         FREEMAIN R,LV=(0),A=&LOC                              @SC86299 00823500
         MEND                                                           00824000
*COPY                                                 WRITF             00824500
         MACRO                                                          00825000
&LABEL   WRITF &TICK,&BUFFER=,&BSIZE=,&E=                               00825500
.* Write to a disk file (ticket ptr in R1)                              00826000
.*  &1: adr of file access ticket returned by OPENF (A),                00826500
.*  &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00827000
.*  given, it replaces FDB value (see OPENF), &E= branch on error       00827500
&LABEL   READF &TICK,BUFFER=&BUFFER,BSIZE=&BSIZE,E=&E,CODE=10           00828000
         MEND                                                           00828500
*COPY                                                 READF             00829000
         MACRO                                                          00829500
&LABEL   READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=,&CODE=9                00830000
.* Read from disk file (or write) (see WRITF, but also...)              00830500
.*  &2: NONUM means chop off numbers                                    00831000
         LCLC  &R                                              @SC86299 00831500
         LCLA  &C                                              @SC88101 00832000
&C       SETA  &CODE                                           @SC88101 00832500
         AIF   (T'&NONUM EQ 'O').RDC                           @SC88101 00833000
         AIF   ('&NONUM' NE 'NONUM').ER1                       @SC88101 00833500
&C       SETA  0             Code 0 means exclude sequence nos.@SC88101 00834000
.RDC     ANOP                                                  @SC88101 00834500
&LABEL   L     1,&TICK                                         @SC86299 00835000
         AIF   ('&BUFFER' EQ '').BZ                            @SC86299 00835500
         AIF   ('&BUFFER'(1,1) NE '(').BLA                     @SC86299 00836000
&R       SETC  '&BUFFER(1)'                                    @SC86299 00836500
         AGO   .BST                                            @SC86299 00837000
.BLA     LA    15,&BUFFER                                      @SC86299 00837500
&R       SETC  '15'                                            @SC86299 00838000
.BST     ST    &R,FDBBUFF-FABD(1)                              @SC86299 00838500
.BZ      AIF   ('&BSIZE' EQ '').SZ                             @SC86299 00839000
         AIF   ('&BSIZE'(1,1) NE '(').SLA                      @SC86299 00839500
&R       SETC  '&BSIZE(1)'                                     @SC86299 00840000
         AGO   .SST                                            @SC86299 00840500
.SLA     LA    15,&BSIZE                                       @SC86299 00841000
&R       SETC  '15'                                            @SC86299 00841500
.SST     ST    &R,FDBBSIZ-FABD(1)                              @SC86299 00842000
.SZ      LA    0,&C                                            @SC88101 00842500
         KCALL DISKIO,E=&E                                     @SC86299 00843000
         MEXIT                                                          00843500
.ER1     MNOTE 2,'INVALID PARAMETER ''&NONUM'''                @SC88101 00844000
         MEND                                                           00844500
*COPY                                                 SAVEF             00845000
         MACRO                                                          00845500
&LABEL   SAVEF &TICK,&E=                                       @SC88168 00846000
.* Update disk directory for given file (ticket ptr in R1)              00846500
.*  &1: adr of file access ticket (A), &E= branch on error              00847000
&LABEL   L     1,&TICK                                         @SC88168 00847500
         READF &TICK,E=&E,CODE=21                              @SC88168 00848000
         MEND                                                           00848500
*COPY                                                 KSETKW            00849000
         MACRO                                                          00849500
         KSETKW ,                                              @SC87166 00850000
.* Define system-specific SET/SHOW parameters (keywords)                00850500
         GBLC  &AADELIM,&DESTINA                               @SC92300 00851000
         KW    '&AADELIM',SHODLM,MIN=4                         @SC92300 00851500
         KW    '&DESTINA',SHODST,MIN=3                         @SC87166 00852000
         MEND                                                           00852500
*COPY                                                 KSETPRC           00853000
         MACRO                                                          00853500
         KSETPRC                                                        00854000
.* System-specific SET handlers (in any order).  No operands.           00854500
         GBLC  &DELIMSG                                        @SC92300 00855000
         PUSH  PRINT                                           @SC86355 00855500
         PRINT GEN                                             @SC86355 00856000
SETDST   KCALL CWDSET                                          @SC86164 00856500
         B     RTRN          Preserve return code              @SC86295 00857000
SETDLM   NTOKN N=SETDLM1,H=SETDLMH                             @SC88095 00857500
         LTR   7,7           Exactly one character?            @SC88095 00858000
         BNZ   SETDLMH       No, explain it                    @SC88095 00858500
         MVC   LNDLM,0(6)    Yes, use that character           @SC88095 00859000
         B     RTRN0                                           @SC88095 00859500
SETDLM1  MVI   LNDLM,C' '    Turn delimiter off                @SC88095 00860000
         B     RTRN0                                           @SC88095 00860500
SETDLMH  PTEXT '&DELIMSG'                                      @SC88095 00861000
         B     SUBERR                                          @SC88095 00861500
         POP   PRINT                                           @SC86355 00862000
         MEND                                                           00862500
*COPY                                                 KSHOPRC           00863000
         MACRO                                                          00863500
         KSHOPRC                                                        00864000
.* System-specific SHOW handlers (in same order as KW).  No operands.   00864500
         PUSH  PRINT                                           @SC86355 00865000
         PRINT GEN                                             @SC86355 00865500
SHODLM   LA    8,LNDLM       Show delimiter                    @SC88095 00866000
         BAL   14,SHOCHR                                       @SC88095 00866500
          B    SETDLM                                          @SC88095 00867000
SHODST   LA    8,DEST                                          @SC86316 00867500
         LH    9,DESTL       Get length                        @SC86316 00868000
         BAL   14,SHOCHRN                                      @SC86295 00868500
          B    SETDST                                          @SC87166 00869000
         POP   PRINT                                           @SC86355 00869500
         MEND                                                           00870000
*COPY                                                 KFILKW            00870500
         MACRO                                                          00871000
         KFILKW ,                                              @SC87166 00871500
.* Define system-specific file attribute parameters (keywords)          00872000
         GBLC  &AABLKSI,&AARECFM,&DCBSPAC,&AAAUNIT,&AAAAVOL    @SC92300 00872500
         KW    '&AABLKSI',SHOBSZ,MIN=2                         @SC87166 00873000
         KW    '&AARECFM',SHORFM                               @SC87166 00873500
         KW    '&DCBSPAC',SHOTRK,MIN=2                         @SC87166 00874000
         KW    '&AAAUNIT',SHOUNT                               @SC87166 00874500
         KW    '&AAAAVOL',SHOVOL,MIN=2                         @SC87166 00875000
         MEND                                                           00875500
*COPY                                                 KFILSET           00876000
         MACRO                                                          00876500
         KFILSET                                                        00877000
.* Specific SET FILE handlers (any order).  No operands.                00877500
         GBLC  &FIXED,&VARIABL,&UNDEFND                        @SC92300 00878000
         PUSH  PRINT                                           @SC87012 00878500
         PRINT GEN                                             @SC87012 00879000
SETCMDS  CSECT                                                 @SC92300 00879500
SETRFMKW KW    '&FIXED',SETT,F                                 @SC92300 00880000
         KW    '&VARIABL',SETT,V                               @SC92300 00880500
         KW    '&UNDEFND',SETT,U                               @SC92300 00881000
         KW    ,                                               @SC92300 00881500
SET      CSECT                                                 @SC92300 00882000
*                                                                       00882500
SETUNT   BAL   2,SETFSTR     Get fixed-format string           @SC86316 00883000
         TR    FILUNT,UPCASE Should always be upper case       @SC88020 00883500
         MVC   LOGUNT,FILUNT                                   @SC86316 00884000
         B     RTRN0                                           @SC86316 00884500
*                                                                       00885000
SETVOL   BAL   2,SETFSTR     Get fixed-format string           @SC86295 00885500
         TR    FILVOL,UPCASE Should always be upper case       @SC88020 00886000
         MVC   LOGVOL,FILVOL                                   @SC86316 00886500
         B     RTRN0                                           @SC86295 00887000
         POP   PRINT                                           @SC87012 00887500
         MEND                                                           00888000
*COPY                                                 KFILSHO           00888500
         MACRO                                                          00889000
         KFILSHO                                                        00889500
.* Specific SHOW FILE handlers (same order as KW).  No operands.        00890000
         PUSH  PRINT                                           @SC87012 00890500
         PRINT GEN                                             @SC87012 00891000
SHOBSZ   L     8,MAXBSZ      Limit                             @SC87166 00891500
         LH    4,FILBLKSI                                      @SC87320 00892000
         BAL   14,SHONUM     Print it                          @SC86295 00892500
          B    RTRN0                                           @SC86295 00893000
SHORFM   LA    4,SETRFMKW                                      @SC92300 00893500
         LA    6,FILRCF                                        @SC92300 00894000
         BAL   14,SHOBRV                                       @SC92300 00894500
          NOP  0                                               @SC92300 00895000
SHOTRK   L     8,MAXBSZ      Limit                             @SC87166 00895500
         L     4,FILTRKAL                                      @SC88026 00896000
         BAL   14,SHONUM     Print it                          @SC86295 00896500
          B    RTRN0                                           @SC87166 00897000
SHOUNT   LA    8,FILUNT                                        @SC86316 00897500
         LA    9,8                                             @SC86316 00898000
         BAL   14,SHOCHRN                                      @SC86316 00898500
          B    SETUNT                                          @SC87166 00899000
SHOVOL   LA    8,FILVOL                                        @SC86295 00899500
         LA    9,6                                             @SC86295 00900000
         BAL   14,SHOCHRN                                      @SC86295 00900500
          B    SETVOL                                          @SC87166 00901000
         POP   PRINT                                           @SC87012 00901500
         MEND                                                           00902000
*COPY                                                 WTEXT             00902500
         MACRO                                                          00903000
&LABEL   WTEXT &ARG,&LEN                                                00903500
.* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4)           00904000
.* Preserves R2-R14                                                     00904500
.*  &1: 'text' (where text has no doubled ' or & characters)  OR        00905000
.*  &1: adr of text (LA/R), &2: length of text (LA/R)                   00905500
&LABEL   PTEXT &ARG,&LEN,AREG=1,LREG=0                         @SC86295 00906000
         BAL   15,WTEXT      'TPUT'                            @SC87020 00906500
         MEND                                                           00907000
*COPY                                                 FDBD              00907500
         MACRO                                                          00908000
         FDBD                                                           00908500
.* Map of File Descriptor Block + File Access Block                     00909000
FABD     DSECT ,                                               @SC86295 00909500
FABRELAD DS    17X           FAB maps DCB                      @SC86299 00910000
FABREL   DS    AL3                                             @SC86299 00910500
FABBUFNO DS    0BL1                                            @SC86299 00911000
FABBUFCB DS    A                                               @SC86299 00911500
FABBUFL  DS    H                                               @SC86299 00912000
FABDSORG DS    BL2                                             @SC86299 00912500
FABIOBAD DS    A                                               @SC86299 00913000
FABEODAD DS    A                                               @SC86299 00913500
FABRECFM DS    0BL1                                            @SC86299 00914000
FABRECU  EQU   X'C0'         Undefined-length records          @SC86299 00914500
FABRECF  EQU   X'80'         Fixed-length records              @SC86299 00915000
FABRECV  EQU   X'40'         Varying-length records            @SC86299 00915500
FABRECBR EQU   X'10'         Blocked records                   @SC86299 00916000
FABRECCC EQU   X'06'         Control chars present             @SC88106 00916500
FABEXLST DS    A                                               @SC86299 00917000
FABDDNAM DS    CL8                                             @SC86299 00917500
FABOFLGS DS    BL1                                             @SC86299 00918000
FABIFLG  DS    BL1                                             @SC86299 00918500
FABMACR  DS    BL2                                             @SC86299 00919000
         ORG   FABDDNAM                                        @SC86299 00919500
FABTIOT  DS    BL2                                             @SC86299 00920000
FABMACRF DS    BL2                                             @SC86299 00920500
FABDEBAD DS    A                                               @SC86299 00921000
FABGET   DS    A                                               @SC86299 00921500
FABCHECK DS    A                                               @SC86299 00922000
FABSYNAD DS    A                                               @SC86299 00922500
FABCIND1 DS    BL2                                             @SC86299 00923000
FABBLKSI DS    H                                               @SC86299 00923500
FABWCPO  DS    BL4                                             @SC86299 00924000
FABIOBA  DS    A                                               @SC86299 00924500
FABEOBAD DS    A                                               @SC86299 00925000
FABRECAD DS    A                                               @SC86299 00925500
FABDIRCT DS    H                                               @SC86299 00926000
FABLRECL DS    H                                               @SC86299 00926500
FABCNTRL DS    A                                               @SC86299 00927000
         ORG   FABD+90                                         @SC86299 00927500
FABPRECL DS    AL2                                             @SC86299 00928000
FABEOB   DS    A                                               @SC86299 00928500
FDBD     DS    0F            Beginning of short descriptor     @SC86295 00929000
FDBBUFF  DS    A             Buffer ptr                        @SC86295 00929500
FDBBSIZ  DS    F             Max record length                 @SC86295 00930000
FDBRCF   DS    C             Record format                     @SC86295 00930500
FDBFLGS  DS    X             Flags                             @SC86295 00931000
FDBACTV  EQU   X'80'         File is already open              @SC86295 00931500
* SVATT  EQU   X'40'         Preserve attributes               @SC90033 00932000
* APPN   EQU   X'10'         DISP=MOD                          @SC86295 00932500
*ABRECCC EQU   X'06'         Control chars present             @SC88246 00933000
PDSF     EQU   X'01'         Dataset is a PDS                  @SC87015 00933500
FDBLRC   DS    H             File record length                @SC86295 00934000
FDBTRKAL DS    F             File track allocation increment   @SC88026 00934500
FDBBLKSI DS    H             File block size                   @SC86295 00935000
FDBDEVT  DS    XL4           Device type (must precede VOL)    @SC88106 00935500
FDBVOL   DS    CL6           File volume label                 @SC86295 00936000
FDBUNT   DS    CL8           File unit name                    @SC86299 00936500
FDBSIZE  DS    F             File size in Kbytes               @SC86299 00937000
FDBCOP   EQU   *-FDBD        Length to copy for OPEN           @SC90037 00937500
FDBDATE  DS    XL7,X         Time stamp: packed yyyymmddhhmmss @SC88235 00938000
FABDSN   DS    CL52          Dataset name                      @SC86299 00938500
FABDSMB  EQU   FABDSN+44,8   Member name                       @SC88119 00939000
FDBINFO  EQU   *-FDBD        Length of info returned           @SC86295 00939500
FABLRTR  DS    F             Record length for truncation      @SC88120 00940000
FABEXL   DS    3A            Modifiable EXLST                  @SC89073 00940500
FABCOMM  DS    CL8           Command name                      @SC87351 00941000
FABDWDS  EQU   (*-FABD+7)/8                                    @SC86295 00941500
         MEND                                                           00942000
*COPY                                                 FDBPAT            00942500
         MACRO                                                          00943000
         FDBPAT &N,&RFM,&SIZ                                   @SC88120 00943500
.* Define system-dependent part of output FDB patterns                  00944000
.*  &1: variable-name prefix (or null if defining init. values)         00944500
.*  &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 00945000
         LCLC  &T,&B,&D,&V,&U,&Z                               @SC88287 00945500
         LCLC  &R,&F,&L,&S,&P4                                 @SC90037 00946000
         AIF   ('&N' EQ '').ALC                                @SC86316 00946500
&R       SETC  'RCF'                                           @SC88120 00947000
&F       SETC  'FLGS'                                          @SC88120 00947500
&L       SETC  'LRC'                                           @SC88120 00948000
&T       SETC  'TRKAL'                                         @SC87320 00948500
&B       SETC  'BLKSI'                                         @SC87320 00949000
&D       SETC  'DEVT'                                          @SC88287 00949500
&V       SETC  'VOL'                                           @SC86316 00950000
&U       SETC  'UNT'                                           @SC86316 00950500
&S       SETC  'FSIZ'                                          @SC90037 00951000
.ALC     ANOP                                                  @SC86316 00951500
&N&R     DC    C'&RFM'       RECFM                             @SC88120 00952000
&N&F     DC    X'00'         Flags                             @SC88120 00952500
         AIF   ('&SIZ' EQ '').DONE                             @SC88120 00953000
         AIF   ('&RFM' NE 'V').OKL                             @SC88120 00953500
&P4      SETC  '+4'          Add 4 for RDW                     @SC88120 00954000
.OKL     ANOP                                                  @SC88120 00954500
&N&L     DC    Y(&SIZ&P4)    LRECL                             @SC88120 00955000
&N&T     DC    F'5'          Track allocation                  @SC88026 00955500
&Z       SETC  '6233'        Default block size                @SC87320 00956000
         AIF   ('&SIZ' NE 'LPKT').P1                           @SC88120 00956500
&Z       SETC  'LPKT+8'      Block size for log file           @SC87320 00957000
.P1      ANOP                                                           00957500
&N&B     DC    Y(&Z)                                           @SC87320 00958000
&N&D     DC    XL4'0'        Device type (must precede VOL)    @SC88287 00958500
&N&V     DC    CL6' '        No volume specified               @SC87320 00959000
&N&U     DC    CL8' '        Default unit                      @SC88054 00959500
&N&S     DC    F'0'          File size in Kbytes               @SC90037 00960000
.DONE    ANOP                                                  @SC88120 00960500
         MEND                                                           00961000
*COPY                                                 KSYSVAR           00961500
         MACRO                                                          00962000
         KSYSVAR                                                        00962500
.* Define system-dependent globally-known variables                     00963000
COMPTR   DS    2A            Common/storage ptrs               @SC87015 00963500
APGPB    GETLINE MF=L        Parameter block for GETLINE       @NW86330 00964000
STAXPLR  STAX  0,MF=L        Parameter block for STAX (replace)@NW86330 00964500
IOPLAREA DS    4F            IOPL                              @TS86001 00965000
ORGPCMD  DS    CL8           Saved ECT PCMD field              @SC89052 00965500
CPECB    DS    F             GETLINE/PUTLINE/PUTGET ECB        @TS86001 00966000
ECBREAD  DS    F                                               @NW86330 00966500
TASKADD  DS    A             Async task adr                    @NW86330 00967000
SYSPROC  DS    A             Ptr to CLIST library DCB          @SC89073 00967500
ECBTGET  DS    F                                               @NW86330 00968000
KTGETT   DS    2F            Adr and length of read request    @SC87015 00968500
PUTLINAD DS    A             Adr of PUTLINE routine            @SC88026 00969000
GETLINAD DS    A             Adr of GETLINE routine            @NW86330 00969500
DFMSGP   DS    A             Ptr to DAIR message buffer        @SC88119 00970000
CATDSPTR DS    A             Catalog buffer ptr                @NW86330 00970500
NXSFPTR  DS    A             Ptr to suffix comparand           @SC87015 00971000
CIRPARM  DS    0F                                              @NW86330 00971500
CIROPT   DS    X'02'         Get all matches                   @NW86330 00972000
         DS    2AL1(0)       Reserved by system                @NW86330 00972500
CIRLOCRC DS    AL1(0)        Locate return code                @NW86330 00973000
CIRSRCH  DS    A             Search arg: adr of test DSN       @NW86330 00973500
CIRCVOL  DS    F'0'          Vol adr=0 - force cat lookup      @NW86330 00974000
CIRWA    DS    A             Ptr to user work area             @NW86330 00974500
CIRSAVE  DS    A             Ptr to save area for macro        @NW86330 00975000
CIRPSWD  DS    F'0'          Adr of password                   @NW86330 00975500
DESTL    DS    H'0'          Length                            @SC86299 00976000
DEST     DS    CL44          Default PREFIX                    @SC86299 00976500
DESTP    DS    C' '          PDS indicator ('.' if so)         @SC86299 00977000
RTXTSV   DS    F             Saved register for prompt         @SC89214 00977500
CAMLOC   DS    4F            Ptrs for locating dataset         @SC86299 00978000
CAMOBT   DS    4F            Ptrs for getting DSCB             @SC86299 00978500
CAMVOLS  DS    0D,XL265      Storage for volume list           @SC86299 00979000
CAMDEVT  EQU   CAMVOLS+2,4   1st device type                   @SC88106 00979500
         ORG   CAMVOLS+100   Do a little overlaying            @SC88049 00980000
CAMDSCB  DS    0F,XL101      Storage for DSCB                  @SC88014 00980500
         ORG   CAMDSCB+1                                       @SC88014 00981000
DS1VOL   DS    CL6,XL2       Volume serial                     @SC86299 00981500
DS1CRDT  DS    2XL3,3X,XL8   Creation date                     @GH89270 00982000
DS1MDDT  DS    XL3           Modification date (ASM2)          @GH89270 00982500
DS1MDTM  DS    XL2           Modification time of day (ASM2)   @GH89270 00983000
DS1RFDT  DS    XL3,XL4       Reference date                    @SC86299 00983500
DS1DSO   DS    XL2           Dataset org                       @SC86299 00984000
DS1RCF   DS    X             Record format                     @SC86299 00984500
DS1OPT   DS    X             Error option                      @SC86299 00985000
DS1BLK   DS    H             Block size                        @SC86299 00985500
DS1LRC   DS    H             Logical record length             @SC86299 00986000
LKPMEM   DS    CL8           Temporary for member name if mig. @SC89250 00986500
         ORG   ,                                               @SC86299 00987000
         DS    0F                                              @SC86299 00987500
DSKSTT   EQU   *-FDBD+FABD                                     @SC86299 00988000
         DS    XL(FDBINFO)   Room for FDB                      @SC86299 00988500
         ORG   DSKSTT+8*FABDWDS  Rest of FAB to end            @SC91017 00989000
NXFN     DS    CL(LFID)      Pattern filespec for search       @SC87015 00989500
DSNPFL   DS    H             Prefix length for search          @NW86330 00990000
DSNSFL   DS    H             Suffix length for search          @NW86330 00990500
ICPRGS   DS    4F            Saved registers for type-out      @SC88026 00991000
ICPFL    DS    X             Flag for type-out interception    @SC87020 00991500
SCRLST   DS    X             Flag for previous I/O op          @SC88091 00992000
STMUCH   DS    XL2           Saved user profile values         @SC86299 00992500
OLDUPTSW DS    X             Old UPTSWS field, saved for STCOM @TL89181 00993000
PTLLEN   DS    0F,2H         PUTLINE data descriptor           @SC88026 00993500
PTLBUF   DS    CL133                                           @SC88026 00994000
STKDSN   DS    CL(LFID)      DSN for STACK                     @SC88026 00994500
*                                                                       00995000
DSKFL    DS    X             Flags for catalog scanning        @SC90033 00995500
NXDON    EQU   X'40'         Catalog search done               @SC87015 00996000
WFN      EQU   X'08'         Filename contains wild chars      @SC88246 00996500
PDSBLK   DS    0H,XL62       BLDL list                         @GH90139 00997000
         ORG   PDSBLK                                          @GH90139 00997500
PDSCOUNT DS    H'1'          Number of entries                 @GH90139 00998000
PDSSIZE  DS    Y(58)         Size of each entry                @GH90139 00998500
PDSMEMBR DS    CL8           Member name                       @GH90139 00999000
         DS    XL3,2XL1      TTRC, Linklist/STEPLIB            @GH90139 00999500
PDSINDIC DS    XL1           Indicators                        @GH90139 01000000
PDSUSER  DS    0C            User data field                   @GH90139 01000500
         DS    2XL1,XL2,PL4  Version, level, reserved, CREDT   @GH90139 01001000
ISPFMDDT DS    PL4           ISPF mod date (00YYDDDF)          @GH90139 01001500
ISPFMDTM DS    PL2           ISPF mod time (HHMM)              @GH90139 01002000
         ORG   ,                                               @GH90139 01002500
         MEND                                                           01003000
*COPY                                                 KSYSTF            01003500
         MACRO                                                          01004000
         KSYSTF                                                         01004500
.* Define system-dependent globally-known constants and init. variables 01005000
.*  symb .DS + label &P.DEFS mark start of variables/init. values       01005500
         GBLC  &STORDS                                         @SC89268 01006000
         LCLC  &P                                                       01006500
         PUSH  PRINT                                                    01007000
         PRINT GEN                                                      01007500
         AIF   ('&SYSECT' EQ '&STORDS').DS                     @SC89268 01008000
&P       SETC  'I'           For initial values                         01008500
WTEXT    STM   14,1,ICPRGS   Save                              @SC88026 01009000
         CLI   ICPFL,2       Intercepting?                     @SC88026 01009500
         BE    WTXICP        Yes, do it                        @SC88026 01010000
         MVC   PTLBUF,0(1)   Copy to buffer                    @SC88026 01010500
         A     0,F4                                            @SC88026 01011000
         STH   0,PTLLEN      And save length                   @SC88026 01011500
         MVI   CPECB,0       Clear ECB                         @SC88119 01012000
         L     15,PUTLINAD                                     @SC88026 01012500
         PUTLINE PARM=PTPB,MF=(E,IOPLAREA),ENTRY=(15)          @SC88026 01013000
         B     WTXRET                                          @SC87020 01013500
WTXICP   KCALL ICPTYP        Call interception routine         @SC87020 01014000
WTXRET   LM    14,1,ICPRGS   Restore                           @SC88026 01014500
         BR    15                                              @SC87020 01015000
KSYSATOE DC    A(0)          Normal TTY E/A translation        @SC88302 01015500
KSYSETOA DC    A(0)                                            @SC88302 01016000
SYSATR   DC    AL1(ADOT,ABL+2,AI,A2)  ."I2  System type=TSO    @SC88273 01016500
LSYSATR  EQU   *-SYSATR      Length of stuff for A-packet      @SC88273 01017000
LOGNAM   DC    C'KER.LOG'                                      @SC86299 01017500
REPNAM   DC    C'KER.REPLY'                                    @SC86299 01018000
SYSTAKE  DC    C'''SYS1'                                       @SC88113 01018500
DKERMINI DC    C'.KERMINI'''                                   @SC88113 01019000
LSYST    EQU   *-SYSTAKE                                       @SC86299 01019500
USRTAKE  DC    C'KERMINI'    Init file                         @SC86299 01020000
LUSRT    EQU   *-USRTAKE                                       @SC86299 01020500
KMAIL1   DC    C'KERMAIL ' System cmd for invoking mail        @SC90037 01021000
KMAIL2   DC    C' LIST('                                       @SC90037 01021500
KMAIL3   DC    C')'                                            @SC90037 01022000
KPRNT1   DC    C'KERMPRT ' System cmd for printing             @SC90037 01022500
KPRNT2   DC    C' OPTIONS('                                    @SC90037 01023000
KPRNT3   DC    C')'                                            @SC90037 01023500
KSUBM1   DC    C'KERMSUB ' System cmd for submitting job       @SC90037 01024000
KSUBM2   DC    C' OPTIONS('                                    @SC90037 01024500
KSUBM3   DC    C')'                                            @SC90037 01025000
CIRWAL   DC    H'32004,0'    Length of catalog work area       @SC87015 01025500
KSYSNIT  CSECT                                                 @SC89215 01026000
.DS      ANOP                                                           01026500
&P.DEFS  DS    0D                                                       01027000
* Timer exit routine                                           @SC88299 01027500
         USING *,15          Addressiblity for getting ECB     @SC88299 01028000
&P.TMXIT STM   0,1,20(13)    Save registers                    @SC88299 01028500
         ICM   1,15,&P.TMXPT Get ptr to target ECB             @SC88299 01029000
         POST  (1),1                                           @SC88299 01029500
         LM    0,1,20(13)    Restore registers                 @SC88299 01030000
         BR    14            Return to system                  @SC88299 01030500
&P.TMXPT DS    AL4           Ptr to ECB                        @SC88299 01031000
         DROP  15                                              @SC88299 01031500
*                                                                       01032000
&P.KPRPL DC    AL1(L'KPRPT)                                    @SC89268 01032500
&P.KPRPT DC    C'Kermit-TSO>'                                  @SC87268 01033000
         ORG   &P.KPRPT+20                                     @SC87268 01033500
&P.LNDLM DC    C' '          Initially no delimiter            @SC88095 01034000
         POP   PRINT                                                    01034500
&P.PTPB  PUTLINE MF=L,OUTPUT=(0,TERM,SINGLE,DATA)              @SC88026 01035000
         MEND                                                           01035500
*COPY                                                 KSYSBUF           01036000
         MACRO                                                          01036500
         KSYSBUF                                                        01037000
.* Store buffer ptrs from R1 and increment R1 for specific buffers      01037500
         LA    0,4-1                                           @SC87015 01038000
         AR    1,0                                             @SC87015 01038500
         OR    1,0                                             @SC87015 01039000
         XR    1,0                                             @SC87015 01039500
         ST    1,CIRSAVE     Catalog scan save area            @SC87015 01040000
         LA    1,72(1)                                         @SC87015 01040500
         ST    1,CIRWA       Catalog info buffer               @SC87015 01041000
         AH    1,CIRWAL                                        @SC87015 01041500
         ST    1,CIRSRCH     Catalog search comparand          @SC87015 01042000
         LA    1,44(1)                                         @SC87015 01042500
         ST    1,DFMSGP      DAIR message buffer               @SC88119 01043000
         LA    1,512(1)                                        @SC88119 01043500
         MEND                                                           01044000
*COPY                                                 SSYMS             01044500
         MACRO                                                          01045000
         SSYMS                                                          01045500
.* Set global symbols for conditional assembly                          01046000
         GBLC  &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT  @SC88309 01046500
         GBLC  &KEDIT,&STORDS,&KTAG,&AEACMD,&CONOPTS,&S1CMD1   @SC91311 01047000
         GBLA  &MAXLR,&MAXBS                                   @SC86268 01047500
         GBLC  &AAAAAOK,&AAAAVOL,&AAAUNIT,&AABLKSI,&BADFSPC    @SC92300 01048000
         GBLC  &CWDERRM,&DCBSPAC,&DESTINA,&FILCLSN,&FMTFSPC    @SC92300 01048500
         GBLC  &MIGRATD,&NOFSPEC,&NOTCPER,&QQWRITE,&SPACERR    @SC92300 01049000
&KSYS    SETC  'TSO'         System name                       @SC86299 01049500
  MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***'    01050000
** BEGIN LANGUAGE-SPECIFIC DATA **   ** TSO-specific **        @SC92300 01050500
&AAAAAOK SETC 'OK'            (see QQWRITE)                    @SC88076 01051000
&BADFSPC SETC 'Invalid DSN'                                    @SC86299 01051500
&CWDERRM SETC 'Must be valid DSN prefix'                       @SC86299 01052000
&FILCLSN SETC '  File name collision'  (2 leading blanks)      @SC88049 01052500
&FMTFSPC SETC 'Enter d.s.n'                                    @SC91224 01053000
&MIGRATD SETC '  Dataset not on-line'  (2 leading blanks)      @SC89250 01053500
&NOFSPEC SETC 'Missing DSN'                                    @SC86299 01054000
&NOTCPER SETC 'Kermit-TSO must be a command processor'         @SC86299 01054500
&QQWRITE SETC ' exists.  Reply "OK" to overwrite:'             @SC87015 01055000
&SPACERR SETC 'SPACE not implemented'  (see AASPACE)           @SC86299 01055500
* Subcommand keywords                                          @SC92300 01056000
&AAAAVOL SETC 'VOLUME'          kwd->AAAFILE, m=2              @SC87166 01056500
&AAAUNIT SETC 'UNIT'            kwd->AAAFILE                   @SC87166 01057000
&AABLKSI SETC 'BLKSIZE'         kwd->AAAFILE, m=2              @SC87166 01057500
&DCBSPAC SETC 'SPACE'           kwd->AAAFILE, m=2              @SC87166 01058000
&DESTINA SETC 'PREFIX'          kwd->AAAASET, m=3              @SC87166 01058500
** END LANGUAGE-SPECIFIC DATA **                               @SC92300 01059000
&MAXLR   SETA  32756         Max lrecl                         @SC86299 01059500
&MAXBS   SETA  32760         Max blksize                       @SC86299 01060000
&AEACMD  SETC  'X''F3'''        AEA command prefix (X'F3'=WSF) @SC90173 01060500
&S1CMD   SETC  'X''F1C2'''   S/1 command prefix                @SC90264 01061000
&S1CMD1  SETC  'X''F1C1'''   S/1 command prefix for Status Req @SC91311 01061500
&CONOPTS SETC  'STCQNS1'     SETCON options                    @SC91311 01062000
&KCONT   SETC  'T'           Default controller type (TTY)     @SC88309 01062500
         PUSH  PRINT                                                    01063000
         PRINT GEN                                                      01063500
MAXWT    EQU   1024          Max TPUT buffer                   @SC86299 01064000
MAXRT    EQU   1024          Max TGET buffer                   @SC86299 01064500
MAXWS    EQU   1920          Max fullscreen output buffer      @SC90277 01065000
MAXRS    EQU   1920          Max fullscreen input buffer       @SC90277 01065500
FSRDOF   EQU   6             Offset of data in fullscreen read @SC92030 01066000
MAXDOF   EQU   0             Offset of disk out buffer         @SC90264 01066500
STMGT    EQU   0             Overhead for storage mngmnt       @SC90264 01067000
LFID     EQU   60            Max length of filespec            @SC88342 01067500
&TYPCMD  SETC  'LIST'        Host command for TYPE             @SC86299 01068000
TYPMIN   EQU   4             Min abbrv of system TYPE cmd or 2 @SC86299 01068500
FBRK1    EQU   C'<'          Starting character for options    @SC89218 01069000
FBRK2    EQU   C'>'          Ending character for options      @SC89218 01069500
KMAXE    EQU   1920          < 9025  Kermit extended max pkt   @SC90277 01070000
STKDWDS  EQU   511           Size of save-area stack           @SC87012 01070500
&STORDS  SETC  'KSTORG'      Storage DSECT for Kermit globals  @SC89268 01071000
KWRKBASE EQU   11            Base register for work area       @SC89268 01071500
KSUBBASE EQU   12            Base register for CSECT           @SC89268 01072000
         POP   PRINT                                                    01072500
         MEND                                                  @SC86268 01073000
*COPY                                                 SYSMACS           01073500
         MACRO                                                          01074000
         SYSMACS                                                        01074500
.* Include system control block definition macros and list all macros   01075000
 MNOTE '---MACROs: ATTACH, BLDL, CATALOG, CLOSE, DETACH, DEVTYPE,'      01075500
 MNOTE '---        ESTAI, FIND, FREEMAIN,'                              01076000
 MNOTE '---        FREEPOOL, GETLINE, GETMAIN, GTSIZE, IDENTIFY,'       01076500
 MNOTE '---        IKJCPPL, IKJECT, IKJGTPB, IKJIOPL, IKJUPT,'          01077000
 MNOTE '---        LINK, LOAD, LOCATE, OBTAIN, OPEN, POST,'             01077500
 MNOTE '---        PUTLINE, RDJFCB, SAVE, SCRATCH, STACK,'              01078000
 MNOTE '---        STATUS, STAX, STCC,'                                 01078500
 MNOTE '---        STCOM, STFSMODE, STIMER, STSIZE, SYNADAF,'           01079000
 MNOTE '---        SYNADRLS, TGET, TPG, TPUT, TTIMER, WAIT'             01079500
         IKJCPPL ,                                             @SC86299 01080000
         IKJECT ,                                              @SC86299 01080500
         IKJGTPB ,                                             @NW86330 01081000
         IKJIOPL ,                                             @TS86001 01081500
         IKJUPT ,                                              @SC86299 01082000
* DSECT for addressing catalog information work area                    01082500
CATDSET  DSECT                                                 @NW86330 01083000
TYPEBYTE DS    XL1           Type byte we want only A's        @NW86330 01083500
CATDNAME DS    44CL1         Data set name                     @NW86330 01084000
         MEND                                                  @SC86268 01084500
*COPY                                                 STRTMSGS          01085000
         MACRO                                                          01085500
&LABEL   STRTMSGS                                                       01086000
.* Print system-dependent start-up messages                             01086500
         GBLC  &HANDXON                                        @SC92300 01087000
&LABEL   CLI   S1HND,XON                                       @SC87338 01087500
         BNE   STRT1Z                                          @SC87338 01088000
         BAL   14,TTYCHK                                       @SC92030 01088500
          B    STRT1Z        TTY, suppress message             @SC87338 01089000
         WTEXT '&HANDXON'                                      @SC87338 01089500
STRT1Z   DS    0H                                              @SC87338 01090000
         MEND                                                  @SC87338 01090500
*COPY                                                 KMAIN             01091000
         MACRO                                                          01091500
&LABEL   KMAIN &TYPE                                                    01092000
.* Linkage conventions with system.                                     01092500
.*  &1: ENTER if entering, RETURN if returning                          01093000
         AIF   ('&TYPE' NE 'RETURN').ENT                       @SC89268 01093500
&LABEL   L     13,4(13)      Unlink                            @SC86295 01094000
         ST    15,16(13)     Save return code                  @SC86295 01094500
         LA    0,STODWDS+STKDWDS                               @SC87012 01095000
         LR    1,KWRKBASE                                      @SC89268 01095500
         DMSFRET DWORDS=(0),LOC=(1)                            @SC86295 01096000
         LM    14,12,12(13)  Restore registers                 @SC86295 01096500
         BR    14                                              @SC86295 01097000
         MEXIT ,                                               @SC89268 01097500
.ENT     AIF   ('&TYPE' NE 'ENTER').OTH                        @SC89268 01098000
         SAVE  (14,12),,&LABEL                                 @SC90264 01098500
         LR    KSUBBASE,15                                     @SC89268 01099000
         L     10,=A(COMMON) Common code addressibility        @SC86316 01099500
         LA    0,STODWDS+STKDWDS                               @SC87012 01100000
         DMSFREE DWORDS=(0)  Get storage for vars + stack      @SC86295 01100500
         LR    KWRKBASE,1    Get addressibility                @SC89268 01101000
         LR    0,1                                             @SC86295 01101500
         LA    1,8*STODWDS   Length of storage                 @SC86295 01102000
         SR    15,15         Zero fill                         @SC86295 01102500
         MVCL  0,14                                            @SC86295 01103000
         LR    15,0          Start of stack                    @SC86295 01103500
         A     0,=A(8*STKDWDS) End of stack                    @SC87012 01104000
         STM   15,0,STKPTR                                     @SC86295 01104500
         ST    15,STKLO                                        @SC89089 01105000
         LM    15,1,16(13)   Restore registers                 @SC86295 01105500
         MEXIT ,                                               @SC89268 01106000
.OTH     MNOTE 12,'Invalid type &TYPE'                         @SC89268 01106500
         MEND                                                  @SC89268 01107000
