*COPY                                                 CTOKN             00800000
         MACRO                                                          00801000
&LABEL   CTOKN &OPT1,&H=,&N=,&OPTS=                                     00802000
.* Pick a token, optionally test for ?, set up for pad/trunc   @SC86224 00803000
.*  &1: 'NOBRK' if not to check for comma break, 'FM' if getting FM,    00803300
.*      'NODOT' if not to convert dots to blanks,                       00803500
.*  &H= handler if '?' (LA), &N= handler if none (LA)                   00804000
.*  &OPTS= handler if options already found (but 0 => don't test)       00804030
.*  don't look for options if omitted                                   00804060
         GBLC  &KVRSN,&KSYS                                    @SC89027 00804100
         AIF   ('&KVRSN' EQ '4.3' OR '&KSYS' EQ '').VOK        @SC90072 00804200
   MNOTE 16,'* * * --> IKCMAC version number should be &KVRSN' @SC89027 00804300
.VOK     ANOP                                                  @SC89027 00804400
         AIF   ('&LABEL' EQ '').NOLAB                          @SC89097 00805000
&LABEL   DS    0H                                              @SC89097 00805100
.NOLAB   AIF   ('&OPT1' EQ 'NOBRK').GETTOK                     @SC89097 00805200
         CLI   BRK,C','      Found end?                        @SC89097 00805300
         BE    &N            Take comma as end                 @SC89097 00805400
.GETTOK  AIF   ('&OPTS' EQ '' OR '&OPTS' EQ '0').GETTK2        @SC89097 00805500
         TM    FL2,FOPTS     Options already found?            @SC89218 00805600
         BO    &OPTS                                           @SC89218 00805700
.GETTK2  BAL   14,WSPTOK                                       @SC89097 00805800
          B    &N                                              @SC86135 00806000
         AIF   ('&H' EQ '').H                                  @SC86224 00808000
         CLI   0(6),C'?'                                                00809000
         BE    &H                                                       00810000
.H       AIF   ('&OPT1' EQ 'FM' OR '&OPT1' EQ 'NODOT').CMST    @SC89097 00811000
         BAL   14,FSPDOTS    Convert fn.ft.fm, if necessary    @SC89097 00811080
.CMST    AIF   ('&OPTS' EQ '').CMSTK                           @SC89218 00811160
         KCALL FOPSTR,(5),E=FSPINV                             @SC89218 00811170
.CMSTK   BAL   14,CMSTOK8                                      @SC89097 00811180
         AIF   ('&OPT1' NE 'FM').ZZ                            @SC89097 00811240
         LA    1,L'FM                                          @SC89097 00811320
         CLM   7,3,*-2       Valid length token?               @SC89097 00811400
         BH    FSPINV        No                                @SC89097 00811480
         BL    *+12          Ok, just disk                     @SC89097 00811560
         CLI   1(6),C'0'     2nd character must be digit       @SC89097 00811640
         BL    FSPINV        Oops                              @SC89097 00811720
.ZZ      MEND                                                  @SC89097 00811800
*COPY                                                 RTEXT             00812000
         MACRO                                                          00813000
&LABEL   RTEXT  &BUF,&PROMPT=,&E=1                                      00814000
.* Read from the terminal, possible prompt.  Get length read in R0.     00815000
.*  &1: read buffer (len=130) (LA), &PROMPT(1)= prompt buf. if any      00816000
.*  (LA/R), &PROMPT(2)= prompt length (LA/R), &E= branch if error       00817000
&LABEL   DS    0H                                              @SC87268 00818000
         AIF   (T'&BUF EQ 'O').ERRB                            @SC87268 00819000
         AIF   ('&BUF'(1,1) NE '(').SETPC                      @SC87268 00820000
         STCM  &BUF(1),7,RT&SYSNDX+1                           @SC87268 00821000
.SETPC   AIF   (T'&PROMPT EQ 'O').EXCT                         @SC87268 00822000
         AIF   (N'&PROMPT NE 2).ERRP                           @SC87268 00823000
         AIF   ('&PROMPT(1)' EQ '' OR '&PROMPT(2)' EQ '').ERRP @SC87268 00824000
         MVI   RT&SYSNDX+5,C'0'  No prompt...                  @SC87268 00825000
         LREG  15,&PROMPT(2)                                   @SC87268 00826000
         ST    15,RT&SYSNDX+12                                 @SC87268 00827000
         LTR   15,15                                           @SC87268 00828000
         BNP   RT&SYSNDX.S                                     @SC87268 00829000
         MVI   RT&SYSNDX+5,C'P'  Prompt...                     @SC87268 00830000
         LREG  15,&PROMPT(1)                                   @SC87268 00831000
         ST    15,RT&SYSNDX+8                                  @SC87268 00832000
.EXCT    CNOP  0,4                                             @SC87268 00833000
RT&SYSNDX.S BAL 1,RT&SYSNDX.X                                  @SC87268 00834000
         DC    CL8'WAITRD'                                     @SC87268 00835000
RT&SYSNDX DC X'01',AL3(&BUF)                                   @SC87268 00836000
         DC    C'T0',AL2(0)                                    @SC87268 00837000
         AIF   (T'&PROMPT EQ 'O').PLZ                          @SC87268 00838000
         DC    AL4(0,0)      Prompt buffer+length              @SC87268 00839000
.PLZ     ANOP                                                  @SC87268 00840000
RT&SYSNDX.X SVC 202                                            @SC87268 00841000
         DC    AL4(&E)                                         @SC87268 00842000
         LH    0,RT&SYSNDX+6                                   @SC87268 00843000
         MEXIT                                                 @SC87268 00844000
.ERRB    MNOTE 2,'BUFFER ADDRESS OMITTED'                      @SC87268 00845000
         MEXIT                                                 @SC87268 00846000
.ERRP    MNOTE 2,'INVALID PROMPT PARAMETER'                    @SC87268 00847000
         MEND                                                           00848000
*COPY                                                 WRITF             00849000
         MACRO                                                          00850000
&LABEL   WRITF &TICK,&BUFFER=,&BSIZE=,&E=                      @VB89014 00851000
.* Write to a disk file (ticket ptr in R1)                              00852000
.*  &1: adr of file access ticket returned by OPENF (A),                00853000
.*  &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00854000
.*  given, it replaces FDB value (see OPENF), &E= branch on error       00855000
&LABEL   L     1,&TICK                                         @SC87034 00856000
         AIF   ('&E' EQ '').EL                                 @VB89014 00856500
       FSWRITE FSCB=(1),BUFFER=&BUFFER,BSIZE=&BSIZE,ERROR=&E   @SC87034 00857000
         MEXIT                                                 @VB89014 00857300
.EL    FSWRITE FSCB=(1),BUFFER=&BUFFER,BSIZE=&BSIZE            @VB89014 00857600
         MEND                                                           00858000
*COPY                                                 READF             00859000
         MACRO                                                          00860000
&LABEL   READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=1                       00861000
.* Read from disk file (or write) (see WRITF, but also...)              00861500
.*  &2: NONUM means chop off numbers                                    00862000
&LABEL   L     1,&TICK                                         @SC87034 00863000
        FSREAD FSCB=(1),BUFFER=&BUFFER,BSIZE=&BSIZE,ERROR=&E   @SC87034 00864000
         AIF   (T'&NONUM EQ 'O').RDC                           @SC88101 00864100
         AIF   ('&NONUM' NE 'NONUM').ER1                       @SC88101 00864200
         SR    0,0           Code 0 for chopping off numbers   @SC88101 00864300
         KCALL DISKIO                                          @SC88101 00864400
.RDC     MEXIT                                                          00864500
.ER1     MNOTE 2,'INVALID PARAMETER ''&NONUM'''                @SC88101 00864600
         MEND                                                           00865000
*COPY                                                 SAVEF             00865100
         MACRO                                                          00865200
&LABEL   SAVEF &TICK,&E=                                       @VB89014 00865300
.* Update disk directory for given file (ticket ptr in R1)              00865400
.*  &1: adr of file access ticket (A), &E= branch on error              00865500
&LABEL   L     1,&TICK                                         @SC88168 00865600
         AIF   ('&E' EQ '').EL                                 @VB89014 00865650
         FSCLOSE FSCB=(1),ERROR=&E                             @SC88168 00865700
         MEXIT                                                 @VB89014 00865730
.EL      FSCLOSE FSCB=(1)                                      @VB89014 00865760
         MEND                                                  @SC88168 00865800
*COPY                                                 CPCMD             00866000
         MACRO                                                          00867000
&LABEL   CPCMD &AREG,&LREG,&CMD,&RESP=NO                                00868000
.* Issue a CP command, optionally return result into a buffer.          00869000
.*  &1: reg->command text, &2: reg=length, &3: 'text' of command (opt)  00870000
.*  &RESP= YES/NO if response to be intercepted at (&1+1) length (&2+1) 00871000
         LCLA  &AREG2,&LREG2                                            00872000
         AIF   ('&LABEL' EQ '').NOLAB                                   00873000
&LABEL   DS    0H                                                       00874000
.NOLAB   AIF   ('&CMD' EQ '').CMD                                       00875000
         PTEXT &CMD,AREG=&AREG,LREG=&LREG                               00876000
.CMD     AIF   ('&RESP' NE 'YES').DIAG                                  00877000
         ICM   &LREG,B'1000',BLANK                                      00878000
&AREG2   SETA  &AREG+1                                                  00879000
&LREG2   SETA  &LREG+1                                                  00880000
         L     &AREG2,CBUF                                              00881000
         LA    &LREG2,512                                      @SC89235 00882000
.DIAG    ANOP                                                           00883000
         DIAG  &AREG,&LREG,X'0008'                                      00884000
         AIF   ('&RESP' NE 'YES').EXIT                                  00885000
         BZ    *+8                                                      00886000
         LA    &LREG2,512                                      @SC89235 00887000
.EXIT    MEND                                                           00888000
*COPY                                                 KSETKW            00889000
         MACRO                                                          00890000
         KSETKW ,                                              @SC87166 00891000
.* Define system-specific SET/SHOW parameters (keywords)                00892000
         GBLC  &DESTINA,&SEARCHA                               @SC92300 00892500
         KW    '&DESTINA',SHODST,MIN=4                         @SC92300 00893000
         KW    '&SEARCHA',SHOSRCH,MIN=3                        @SC92300 00894000
         MEND                                                           00895000
*COPY                                                 KSETPRC           00896000
         MACRO                                                          00897000
         KSETPRC                                                        00898000
.* System-specific SET handlers (in any order).  No operands.           00899000
         PUSH  PRINT                                           @SC86355 00900000
         PRINT GEN                                             @SC86355 00901000
SETDST   KCALL CWDSET                                          @SC86164 00902000
         B     RTRN          Preserve return code              @SC86295 00903000
         POP   PRINT                                           @SC86355 00904000
         MEND                                                           00905000
*COPY                                                 KSHOPRC           00906000
         MACRO                                                          00907000
         KSHOPRC                                                        00908000
.* System-specific SHOW handlers (in same order as KW).  No operands.   00909000
         PUSH  PRINT                                           @SC86355 00910000
         PRINT GEN                                             @SC86355 00911000
SHODST   LA    8,DEST                                          @SC86316 00912000
         BAL   14,SHOCHR                                       @SC86295 00913000
          B    SETDST                                          @SC87166 00914000
SHOSRCH  BAL   14,SHOOO      On or off                         @SC86209 00915000
          OI   FL5,SALL                                        @SC87166 00916000
         POP   PRINT                                           @SC86355 00917000
         MEND                                                           00918000
*COPY                                                 KFILKW            00919000
         MACRO                                                          00920000
         KFILKW ,                                              @SC87166 00921000
.* Define system-specific file attribute parameters (keywords)          00922000
         GBLC  &AARECFM                                        @SC92300 00923000
         KW    '&AARECFM',SHORFM                               @SC87166 00923500
         MEND                                                           00924000
*COPY                                                 KFILSET           00925000
         MACRO                                                          00926000
         KFILSET                                                        00927000
.* Specific SET FILE handlers (any order).  No operands.                00928000
         GBLC  &FIXED,&VARIABL                                 @SC92300 00928500
         PUSH  PRINT                                           @SC87012 00929000
         PRINT GEN                                             @SC87012 00930000
SETCMDS  CSECT                                                 @SC92300 00931000
SETRFMKW KW    '&FIXED',SETT,F                                 @SC92300 00932000
         KW    '&VARIABL',SETT,V                               @SC92300 00933000
         KW    ,                                               @SC87012 00937000
.* add any others here                                         @SC87012 00938000
SET      CSECT                                                 @SC92300 00938500
         POP   PRINT                                           @SC87012 00939000
         MEND                                                           00940000
*COPY                                                 KFILSHO           00941000
         MACRO                                                          00942000
         KFILSHO                                                        00943000
.* Specific SHOW FILE handlers (same order as KW).  No operands.        00944000
         PUSH  PRINT                                           @SC87012 00945000
         PRINT GEN                                             @SC87012 00946000
SHORFM   LA    4,SETRFMKW                                      @SC92300 00947000
         LA    6,FILRCF                                        @SC92300 00947600
         BAL   14,SHOBRV                                       @SC92300 00948200
          NOP  0                                               @SC92300 00948800
.* add any others here                                         @SC87012 00950000
         POP   PRINT                                           @SC87012 00951000
         MEND                                                           00952000
*COPY                                                 WTEXT             00953000
         MACRO                                                          00954000
&LABEL   WTEXT &ARG,&LEN                                                00955000
.* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4)           00956000
.* Preserves R2-R14                                                     00957000
.*  &1: 'text' (where text has no doubled ' or & characters)  OR        00958000
.*  &1: adr of text (LA/R), &2: length of text (LA/R)                   00959000
&LABEL   PTEXT &ARG,&LEN,AREG=1,LREG=0                         @SC86295 00960000
         SVC   93            'TPUT'                            @SC86295 00961000
         MEND                                                           00962000
*COPY                                                 FDBD              00963000
         MACRO                                                          00964000
         FDBD                                                           00965000
.* Map of File Descriptor Block + File Access Block                     00966000
.* Required items below: FABCOMM, FDBD-FDBLRC, FDBSIZE, FDBDATE,        00966200
.*     FDBDLRTR, FDBCOP, FDBINFO.  See also FDBPAT.                     00966400
FABD     DSECT ,                                               @SC86295 00967000
FABCOMM  DS    CL8           FAB maps FSCB                     @SC87007 00968000
FABFN    DS    CL8                                             @SC86295 00969000
FABFT    DS    CL8                                             @SC86295 00970000
FABFM    DS    CL2                                             @SC87320 00971000
FABITNO  DS    H             Unextended item number            @SC88120 00972000
FDBD     DS    0F            Beginning of short descriptor     @SC86295 00973000
FDBBUFF  DS    A             Buffer ptr                        @SC86295 00974000
FDBBSIZ  DS    F             Max record length                 @SC86295 00975000
FDBRCF   DS    C             Record format                     @SC86295 00976000
FDBFLGS  DS    X             Flags                             @SC86295 00977000
FDBACTV  EQU   X'80'         File is already open              @SC86295 00978000
* SVATT  EQU   X'40'         Preserve attributes               @SC90033 00979000
FDBEPL   EQU   X'20'         Extended form                     @SC86295 00980000
* APPN   EQU   X'10'         DISP=MOD                          @SC86295 00981000
FDBLRCTT DS    H             File record length (temp)         @SC92076 00985000
FDBSIZE  DS    0F            File size in Kbytes               @SC86295 00987000
FABNORD  DS    F             Bytes read                        @SC86295 00988000
FDBCOP   EQU   *-FDBD        Length to copy for OPEN           @SC90037 00988500
FABAITN  DS    F             Item number                       @SC86295 00989000
FABANIT  DS    F             Number of items                   @SC86295 00990000
FDBDATE  DS    0XL7          Time stamp: packed yyyymmddhhmmss @SC88235 00991000
FABWPTR  DS    F             Write pointer                     @SC86295 00992000
FABRPTR  DS    F             Read pointer                      @SC86295 00994000
FDBNREC  DS    F             Length of file in records         @SC89218 00994070
FDBSREC  DS    F             Length of send request            @SC89218 00994140
FDBLRC   DS    H             File record length                @SC92076 00994170
FDBINFO  EQU   *-FDBD        Length of info returned           @SC88235 00994200
FABLRTR  DS    F             Record length for truncation      @SC88120 00994500
FABDWDS  EQU   (*-FABD+7)/8                                    @SC86295 00995000
         MEND                                                           00996000
*COPY                                                 FDBPAT            00997000
         MACRO                                                          00998000
         FDBPAT &N,&RFM,&SIZ                                   @SC88120 00999000
.* Define system-dependent part of output FDB patterns                  01000000
.*  &1: variable-name prefix (or null if defining init. values)         01001000
.*  &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 01001300
         LCLC  &R,&F,&L,&S                                     @SC90037 01001600
         AIF   ('&N' EQ '').ALC                                @SC86316 01002000
&R       SETC  'RCF'                                           @SC88120 01002200
&F       SETC  'FLGS'                                          @SC88120 01002400
&L       SETC  'LRC'                                           @SC88120 01002600
&S       SETC  'FSIZ'                                          @SC90037 01002800
.ALC     ANOP                                                  @SC86316 01003000
&N&R     DC    C'&RFM'       RECFM                             @SC88120 01003100
&N&F     DC    X'00'         Flags                             @SC88120 01003200
         AIF   ('&SIZ' EQ '').DONE                             @SC88120 01003300
&N&L     DC    Y(&SIZ)       LRECL                             @SC88120 01003400
&N&S     DC    F'0'          File size in Kbytes               @SC90037 01003450
.DONE    ANOP                                                  @SC88120 01003500
         MEND                                                           01004000
*COPY                                                 KSYSVAR           01005000
         MACRO                                                          01006000
         KSYSVAR                                                        01007000
.* Define system-dependent globally-known variables                     01008000
ASTMUSET DS    A             Ptr to user CP settings           @SC87117 01009000
STMUITB  DS    A             Ptr to user translate table       @SC87201 01010000
STMUOTB  DS    A             Ptr to user translate table       @SC87201 01011000
KRMNAM   DS    CL8           Saved Kermit name invoked         @SC88049 01011500
*          Extra FDB for file manipulations                             01012000
DSKSTT   DC    0F'0',CL8'ESTATE'                               @SC86295 01013000
DSKSTNM  DS    CL18          File name                         @SC86295 01014000
         ORG   DSKSTT+FDBD-FABD                                @SC86295 01015000
         DS    XL(FDBINFO)   Room for FDB                      @SC86295 01016000
FLGXA    DS    X             Flags for XA vs. 370              @SC89235 01016100
XACP     EQU   X'02'         Running under VM/XA               @SC89235 01016200
XACMS    EQU   X'01'         Running under XA CMS              @SC89235 01016300
*          Variables for file directory search                          01017000
NXFSTR   DS    D             Move FN or FT here from FST       @SC87201 01018000
NXFHYPE  DS    A             Address of current hyperblk                01019000
NXFHEND  DS    A             End of current hyperblk                    01020000
NXFN     DS    CL8           Pattern filespec                  @SC86295 01021000
NXFT     DS    CL8                                             @SC86295 01022000
NXFM     DS    CL2                                             @SC86295 01023000
*                                                                       01023100
DSKFL    DS    X             Flags for directory scanning      @SC90033 01023200
CWDF     EQU   X'80'         Looking only for disk             @SC86295 01023300
WARB     EQU   X'40'         Wild char seen                    @SC86295 01023400
WFM      EQU   X'08'         Filemode contains wild chars               01023500
WFT      EQU   X'04'         Filetype contains wild chars               01023600
WFN      EQU   X'02'         Filename contains wild chars               01023700
*                                                                       01024000
FST      DS    A             Last FST ptr                      @SC86295 01025000
NXFFNL   DS    F             Pattern length for FN             @SC86295 01026000
ADT      DS    A             Saved ADT ptr                     @SC86295 01027000
NXFFTL   DS    F             Pattern length (must be NXFFNL+8) @SC86295 01028000
* HNDINT Plist for Series/1 interrupt handling                 @SC88326 01028080
HNDINTPL DS    CL8'HNDINT'   HNDINT plist                      @SC88326 01028160
HNDFNC   DS    CL4'SET'      Set function                      @SC88326 01028240
HNDDV    DS    CL4'CONK'     Symbolic device (or CON1)         @SC88326 01028320
         DS    AL4(0)        S1 Interrupt handler              @SC88326 01028400
CONSADDR DS    AL2(9)        Console address (fill in)         @SC88326 01028480
         DS    CL2'WC'                                         @SC88326 01028560
         DS    4X'FF'                                          @SC88326 01028640
HNDWAIT  DS    CL8'WAIT'     WAITD macro plist                 @SC88326 01028720
WAITDV   DS    CL4'CONK'                                       @SC88326 01028800
         DS    2F'0'                                           @SC88326 01028880
         MEND                                                           01029000
*COPY                                                 KSYSTF            01030000
         MACRO                                                          01031000
         KSYSTF                                                         01032000
.* Define system-dependent globally-known constants and init. variables 01033000
.*  symb .DS + label &P.DEFS mark start of variables/init. values       01034000
         GBLC  &STORDS                                         @SC89268 01034500
         LCLC  &P                                                       01035000
         PUSH  PRINT                                                    01036000
         PRINT GEN                                                      01037000
         AIF   ('&SYSECT' EQ '&STORDS').DS                     @SC89268 01038000
&P       SETC  'I'           For initial values                         01039000
KSYSATOE DC    A(0)          Normal TTY E/A translation        @SC88302 01039300
KSYSETOA DC    A(0)                                            @SC88302 01039600
SYSATR   DC    AL1(ADOT,ABL+2,AI,A1)  ."I1  System type=CMS    @SC88273 01040000
LSYSATR  EQU   *-SYSATR      Length of stuff for A-packet      @SC88273 01040500
LOGNAM   DC    C'KER LOG A'                                    @SC86295 01041000
REPNAM   DC    C'KER REPLY A'                                  @SC86295 01042000
SYSTAKE  DC    C'SYSTEM KERMINI' File type                              01043000
LSYST    EQU   *-SYSTAKE                                       @SC86295 01044000
KMAIL1   DC    C'EXEC KERMAIL ' System cmd for invoking mail   @SC90037 01044100
KMAIL2   DC    C' ('                                           @SC90037 01044200
KMAIL3   DC    C' '                                            @SC90037 01044300
KPRNT1   DC    C'EXEC KERMPRT ' System cmd for printing        @SC90037 01044400
KPRNT2   DC    C' ('                                           @SC90037 01044500
KPRNT3   DC    C' '                                            @SC90037 01044600
KSUBM1   DC    C'EXEC KERMSUB ' System cmd for submitting job  @SC90037 01044700
KSUBM2   DC    C' ('                                           @SC90037 01044800
KSUBM3   DC    C' '                                            @SC90037 01044900
ASTER    DC    CL8'*'                                          @SC86295 01045000
KSYSNIT  CSECT                                                 @SC89215 01045500
.DS      ANOP                                                           01046000
&P.DEFS  DS    0D                                                       01047000
&P.QDISK DC    CL8'Q',CL8'DISK',CL8' ',8X'FF'                  @SC87201 01048000
&P.USRTAKE DS  CL8           User for init file                         01049000
         DC    C' KERMINI'   File type expected                         01050000
&P.LUSRT EQU   *-&P.USRTAKE                                    @SC86295 01051000
&P.DEST  DC    C'A '         Default filemode                  @SC86158 01052000
&P.UFM   DC    C'A1'         Filemode user wants                        01053000
&P.KPRPL DC    AL1(L'KPRPT+1)                                  @SC89334 01054000
&P.KPRPT DC    C'Kermit-CMS>'                                  @SC87268 01055000
         DC    AL1(XON)                                        @SC89334 01056000
         ORG   &P.KPRPT+21                                     @SC89334 01056500
         POP   PRINT                                                    01057000
         MEND                                                           01058000
*COPY                                                 KSYSBUF           01059000
         MACRO                                                          01060000
         KSYSBUF                                                        01061000
.* Store buffer ptrs from R1 and increment R1 for specific buffers      01062000
         ST    1,ASTMUSET    User CP settings                  @SC87117 01063000
         LA    1,STMUL+STMLL(1)  Length of user CP settings    @SC87117 01064000
         MEND                                                           01065000
*COPY                                                 HOST              01066000
         MACRO                                                          01067000
&LABEL   HOST  &PLIST,&E=1,&EPL=NO                             @SC89264 01068000
.* Issue system cmd - if no PLIST, assume prepped command at (R1)       01069000
.*  &1: text of cmd (LA), &E= error branch (A)                          01070000
.*  &EPL= YES if extended PLIST may be used                    @SC89264 01070500
&LABEL   LA    1,&PLIST                                                 01071000
         AIF   ('&EPL' NE 'YES').SVC                           @SC89264 01071100
         TM    FL4,UCMD                                        @SC89264 01071200
         BZ    *+12          Not from user -- don't bother     @SC89264 01071300
          ICM  1,8,=X'0B'    Indicate Extended PLIST used      @SC91170 01071400
          LA   0,NUCPLIST    and assume we called SCANN        @SC89264 01071500
.SVC     SVC   202                                                      01072000
         DC    AL4(&E)                                                  01073000
         MEND                                                           01074000
*COPY                                                 SSYMS             01075000
         MACRO                                                          01076000
         SSYMS                                                          01077000
.* Set global symbols for conditional assembly                          01078000
         GBLC  &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT  @SC88309 01079000
         GBLC  &KEDIT,&STORDS,&KTAG,&AEACMD,&CONOPTS,&S1CMD1   @SC91311 01079500
         GBLC  &CMSSFS                                         @SC92076 01079700
         GBLA  &MAXLR,&MAXBS                                   @SC86268 01080000
         GBLC  &CPCMND,&CWDERRM,&DESTINA                       @SC92300 01080100
         GBLC  &FILCLSN,&FMTFSPC,&NONXAMS,&SEARCHA             @SC92300 01080200
&KSYS    SETC  'CMS'         System name                       @SC86268 01081000
  MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***'    01082000
** BEGIN LANGUAGE-SPECIFIC DATA **   ** CMS-specific **        @SC92300 01082050
&CPCMND  SETC 'Specify a CP command to issue'                  @SC92300 01082100
&CWDERRM SETC 'Must be valid CMS mode letter'                  @SC86295 01082150
&FILCLSN SETC 'File name collision'                            @SC88049 01082200
&FMTFSPC SETC 'Filespec has format: fn ft [fm]'                @SC92300 01082250
&NONXAMS SETC 'This is a non-XA Kermit: SET MACHINE 370'       @SC89235 01082300
* Subcommand keywords                                          @SC92300 01082350
&DESTINA SETC 'DESTINATION'     kwd->AAAASET, m=4              @SC92300 01082400
&SEARCHA SETC 'SEARCH-ALL'      kwd->AAAASET, m=3              @SC92300 01082450
** END LANGUAGE-SPECIFIC DATA **                               @SC92300 01082500
&MAXLR   SETA  65535         Max lrecl                         @SC86268 01083000
&MAXBS   SETA  65535         Max blksize                       @SC86268 01084000
&AEACMD  SETC  '0X''0'''     AEA command prefix (X'F3'=WSF)    @SC90173 01084500
&S1CMD   SETC  'X''C2'''     S/1 command prefix                @SC90264 01085000
&S1CMD1  SETC  'X''C1'''     S/1 command prefix for Status Req @SC91311 01085100
&CONOPTS SETC  'STCQNS1'     SETCON options                    @SC91311 01085200
&KCONT   SETC  'T'           Default controller type (TTY)     @SC88309 01085500
&CMSSFS  SETC  'NO'          CMS does not have SFS             @SC92076 01085700
         PUSH  PRINT                                                    01086000
         PRINT GEN                                                      01087000
MAXWT    EQU   1760          Max WRTERM buffer                 @SC86268 01088000
MAXRT    EQU   2030          Max RDTERM buffer                 @SC86268 01089000
MAXWS    EQU   1920          Max fullscreen output buffer      @SC90277 01089100
MAXRS    EQU   1920          Max fullscreen input buffer       @SC90277 01089200
FSRDOF   EQU   0             No offset for full-screen read    @SC92030 01089250
MAXDOF   EQU   0             Offset of disk out buffer         @SC90264 01089300
STMGT    EQU   0             Overhead for storage mngmnt       @SC90264 01089600
LFID     EQU   18            Max length of filespec            @SC86268 01090000
&TYPCMD  SETC  'TYPE'        Host command for TYPE             @SC86268 01091000
TYPMIN   EQU   2             Min abbrv of system TYPE cmd or 2 @SC86268 01092000
FBRK1    EQU   C'<'          Starting character for options    @SC89218 01092300
FBRK2    EQU   C'>'          Ending character for options      @SC89218 01092600
KMAXE    EQU   2030          < 9025  Kermit extended max pkt   @SC90277 01093000
STKDWDS  EQU   511           Size of save-area stack           @SC87012 01094000
&STORDS  SETC  'KSTORG'      Storage DSECT for Kermit globals  @SC89268 01094200
KWRKBASE EQU   11            Base register for work area       @SC89268 01094400
KSUBBASE EQU   12            Base register for CSECT           @SC89268 01094600
         POP   PRINT                                                    01095000
         MEND                                                  @SC86268 01096000
*COPY                                                 SYSMACS           01097000
         MACRO                                                          01098000
         SYSMACS                                                        01099000
.* Include system control block definition macros and list all macros   01100000
         GBLC  &KTAG                                           @SC90067 01100500
 MNOTE '---MACLIBs needed: DMSSP, CMSLIB, TSOMAC, OSMACRO'              01101000
 MNOTE '---MACROs: ADT, DCH, DIAG, DMSEXS, DMSFREE, DMSFRET, DMSKEY,'   01102000
 MNOTE '---        DEVSECT,'                                            01102500
 MNOTE '---        FSCB, FSCLOSE, FSPOINT, FSREAD, FSSTATE,'   @SC92076 01103000
 MNOTE '---        FSTB, FSWRITE, FVS, GETFST, HNDINT,'                 01103500
 MNOTE '---        LINEDIT, NUCON, RDTERM, SAVE, STAX, WAITD, WAITT'    01104000
 MNOTE '--- (for XA): ENABLE, GETSID, SVCSECT'                 @SC90067 01104500
         USING NUCON,0                                                  01105000
         NUCON ,             CMS Nucleus                                01106000
         FSTB  ,             File Status Table                          01107000
         DCH   ,             Data Control Hyperblock                    01108000
         ADT   ,             Active Disk Table                          01109000
         FVS   ,             File system storage               @SC86268 01110000
         DEVSECT ,           Device table entry                @SC88326 01110500
         AIF   ('&KTAG' NE 'XA').CMSXA0                        @SC90067 01110600
         SVCSECT ,           SVC table                         @XS89235 01110700
.CMSXA0  ANOP                                                  @SC90067 01110800
         MEND                                                  @SC86268 01111000
*COPY                                                 STRTMSGS          01112000
         MACRO                                                          01113000
&LABEL   STRTMSGS                                                       01114000
.* Print system-dependent start-up messages                             01115000
         GBLC  &HANDXON                                        @SC92300 01115500
&LABEL   CLI   S1HND,XON                                       @SC87338 01116000
         BNE   STRT1Z                                          @SC87338 01117000
         WTEXT '&HANDXON'                                      @SC87338 01118000
STRT1Z   DS    0H                                              @SC87338 01119000
         MEND                                                  @SC87338 01120000
*COPY                                                 KMAIN             01121000
         MACRO                                                          01122000
&LABEL   KMAIN &TYPE                                                    01123000
.* Linkage conventions with system.                                     01124000
.*  &1: ENTER if entering, RETURN if returning                          01125000
         AIF   ('&TYPE' NE 'RETURN').ENT                       @SC89268 01126000
&LABEL   L     13,4(13)      Unlink                            @SC86295 01127000
         ST    15,16(13)     Save return code                  @SC86295 01128000
         LA    0,STODWDS+STKDWDS                               @SC87012 01129000
         LR    1,KWRKBASE                                      @SC89268 01130000
         DMSFRET DWORDS=(0),LOC=(1)                            @SC86295 01131000
         LM    14,12,12(13)  Restore registers                 @SC86295 01132000
         BR    14                                              @SC86295 01133000
         MEXIT ,                                               @SC89268 01134000
.ENT     AIF   ('&TYPE' NE 'ENTER').OTH                        @SC89268 01135000
         SAVE  (14,12),,&LABEL                                 @SC90264 01135500
         LR    KSUBBASE,15                                     @SC89268 01136000
         L     10,=A(COMMON) Common code addressibility        @SC86316 01137000
         LA    0,STODWDS+STKDWDS                               @SC87012 01138000
         DMSFREE DWORDS=(0)  Get storage for vars + stack      @SC86295 01139000
         LR    KWRKBASE,1    Get addressibility                @SC89268 01140000
         LR    0,1                                             @SC86295 01141000
         LA    1,8*STODWDS   Length of storage                 @SC86295 01142000
         SR    15,15         Zero fill                         @SC86295 01143000
         MVCL  0,14                                            @SC86295 01144000
         LR    15,0          Start of stack                    @SC86295 01145000
         A     0,=A(8*STKDWDS) End of stack                    @SC87012 01146000
         STM   15,0,STKPTR                                     @SC86295 01147000
         ST    15,STKLO                                        @SC89089 01148000
         LM    15,1,16(13)   Restore registers                 @SC86295 01149000
         MEXIT ,                                               @SC89268 01150000
.OTH     MNOTE 12,'Invalid type &TYPE'                         @SC89268 01151000
         MEND                                                  @SC89268 01152000
*COPY                                                 ENABLE            01153000
         MACRO                                                          01154000
&LABEL   ENABLE &INTTYPE=                                      @SC90067 01155000
.* Set system mask in non-XA environments                               01156000
.* &INTTYPE= 'ALL' or 'NONE'                                            01157000
         AIF   ('&INTTYPE' NE 'ALL').TNONE                     @SC90067 01158000
&LABEL   SSM   =X'FF'                                          @SC90067 01159000
         MEXIT                                                 @SC90067 01160000
.TNONE   AIF   ('&INTTYPE' NE 'NONE').ERR                      @SC90067 01161000
&LABEL   SSM   *+1                                             @SC90067 01162000
         MEXIT                                                 @SC90067 01163000
.ERR     MNOTE 8,'INVALID ''INTTYPE'' OPERAND'                 @SC90067 01164000
         MEND                                                  @SC90067 01165000
