*COPY                                                 CTOKN             00800000
         MACRO                                                          00801000
&LABEL   CTOKN &H=,&N=                                                  00802000
.* Pick a token, optionally test for ?, set up for pad/trunc   @SC86224 00803000
.*  &H= handler if '?' (LA), &N= handler if none (LA)                   00804000
&LABEL   BAL   14,WSPTOK                                       @SC86224 00805000
          B    &N                                              @SC86135 00806000
         BAL   14,CMSTOK8                                      @SC86224 00807000
         AIF   ('&H' EQ '').H                                  @SC86224 00808000
         CLI   0(6),C'?'                                                00809000
         BE    &H                                                       00810000
.H       MEND                                                           00811000
*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=1                              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
       FSWRITE FSCB=(1),BUFFER=&BUFFER,BSIZE=&BSIZE,ERROR=&E   @SC87034 00857000
         MEND                                                           00858000
*COPY                                                 READF             00859000
         MACRO                                                          00860000
&LABEL   READF &TICK,&BUFFER=,&BSIZE=,&E=1                              00861000
.* Read from disk file (see WRITF)                                      00862000
&LABEL   L     1,&TICK                                         @SC87034 00863000
        FSREAD FSCB=(1),BUFFER=&BUFFER,BSIZE=&BSIZE,ERROR=&E   @SC87034 00864000
         MEND                                                           00865000
*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,256                                               00882000
.DIAG    ANOP                                                           00883000
         DIAG  &AREG,&LREG,X'0008'                                      00884000
         AIF   ('&RESP' NE 'YES').EXIT                                  00885000
         BZ    *+8                                                      00886000
         LA    &LREG2,256                                               00887000
.EXIT    MEND                                                           00888000
*COPY                                                 KSETKW            00889000
         MACRO                                                          00890000
         KSETKW ,                                              @SC87166 00891000
.* Define system-specific SET/SHOW parameters (keywords)                00892000
         KW    'DESTINATION',SHODST,MIN=4                      @SC87166 00893000
         KW    'SEARCH-ALL',SHOSRCH,MIN=3                      @SC87166 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
         KW    'RECFM',SHORFM                                  @SC87166 00923000
         MEND                                                           00924000
*COPY                                                 KFILSET           00925000
         MACRO                                                          00926000
         KFILSET                                                        00927000
.* Specific SET FILE handlers (any order).  No operands.                00928000
         PUSH  PRINT                                           @SC87012 00929000
         PRINT GEN                                             @SC87012 00930000
SETRECVF MVC   RFM,0(6)      Copy RECFM                        @SC87012 00931000
         B     RTRN0                                           @SC87012 00932000
*                                                              @SC87012 00933000
SETRFM   BAL   4,SETSCN                                        @SC87012 00934000
         KW    'FIXED',SETRECVF                                @SC87012 00935000
         KW    'VARIABLE',SETRECVF                             @SC87012 00936000
         KW    ,                                               @SC87012 00937000
.* add any others here                                         @SC87012 00938000
         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    8,RFM                                           @SC87012 00947000
         BAL   14,SHOCHR                                       @SC87012 00948000
          B    SETRFM                                          @SC87166 00949000
.* 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
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
         DS    H             Not used                          @SC87320 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
FDBITAV  EQU   X'40'         Item is available                 @SC86295 00979000
FDBEPL   EQU   X'20'         Extended form                     @SC86295 00980000
* APPN   EQU   X'10'         DISP=MOD                          @SC86295 00981000
WFM      EQU   X'08'         Filemode contains wild chars               00982000
WFT      EQU   X'04'         Filetype contains wild chars               00983000
WFN      EQU   X'02'         Filename contains wild chars               00984000
FDBLRC   DS    H             File record length                @SC86295 00985000
FDBCOP   EQU   *-FDBD        Length to copy for OPEN           @SC86295 00986000
FDBSIZE  DS    0F            File size in Kbytes               @SC86295 00987000
FABNORD  DS    F             Bytes read                        @SC86295 00988000
FABAITN  DS    F             Item number                       @SC86295 00989000
FABANIT  DS    F             Number of items                   @SC86295 00990000
FDBDATE  DS    0F            Creation date: packed yyyymmdd    @SC86295 00991000
FABWPTR  DS    F             Write pointer                     @SC86295 00992000
FDBINFO  EQU   *-FDBD        Length of info returned           @SC86295 00993000
FABRPTR  DS    F             Read pointer                      @SC86295 00994000
FABDWDS  EQU   (*-FABD+7)/8                                    @SC86295 00995000
         MEND                                                           00996000
*COPY                                                 FDBPAT            00997000
         MACRO                                                          00998000
         FDBPAT &N                                                      00999000
.* Define system-dependent part of output FDB patterns                  01000000
.*  &1: variable-name prefix (or null if defining init. values)         01001000
         AIF   ('&N' EQ '').ALC                                @SC86316 01002000
.ALC     ANOP                                                  @SC86316 01003000
         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
*          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
*          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
*                                                                       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
         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
         LCLC  &P                                                       01035000
         PUSH  PRINT                                                    01036000
         PRINT GEN                                                      01037000
         AIF   ('&SYSECT' EQ 'STORAG').DS                               01038000
&P       SETC  'I'           For initial values                         01039000
SYSATR   DC    C'."I1'       System type for A-packet          @SC86295 01040000
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
ASTER    DC    CL8'*'                                          @SC86295 01045000
.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'&P.KPRPT)                                 @SC87268 01054000
&P.KPRPT DC    C'Kermit-CMS>'                                  @SC87268 01055000
         ORG   &P.KPRPT+20                                     @SC87268 01056000
         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                                              01068000
.* Issue system cmd - if no PLIST, assume prepped command at (R1)       01069000
.*  &1: text of cmd (LA), &E= error branch (A)                          01070000
&LABEL   LA    1,&PLIST                                                 01071000
.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         @SC86355 01079000
         GBLA  &MAXLR,&MAXBS                                   @SC86268 01080000
&KSYS    SETC  'CMS'         System name                       @SC86268 01081000
         MNOTE '*** Kermit-&KSYS release &KVRSN (&KDATE) ***'           01082000
&MAXLR   SETA  65535         Max lrecl                         @SC86268 01083000
&MAXBS   SETA  65535         Max blksize                       @SC86268 01084000
&S1CMD   SETC  '40'          S/1 command prefix                @SC86268 01085000
         PUSH  PRINT                                                    01086000
         PRINT GEN                                                      01087000
MAXWT    EQU   1760          Max WRTERM buffer                 @SC86268 01088000
MAXRT    EQU   2030          Max RDTERM buffer                 @SC86268 01089000
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
KMAXE    EQU   1920-7        < 9025  Kermit extended max pkt   @SC87351 01093000
STKDWDS  EQU   511           Size of save-area stack           @SC87012 01094000
         POP   PRINT                                                    01095000
         MEND                                                  @SC86268 01096000
*COPY                                                 SYSMACS           01097000
         MACRO                                                          01098000
         SYSMACS                                                        01099000
.* Include system control block definition macros and list all macros   01100000
 MNOTE '---MACLIBs needed: DMSSP, CMSLIB, TSOMAC, OSMACRO'              01101000
 MNOTE '---MACROs: ADT, DCH, DIAG, DMSEXS, DMSFREE, DMSFRET, DMSKEY,'   01102000
 MNOTE '---        FSCB, FSREAD, FSTB, FSWRITE, FVS, GETFST, HNDINT,'   01103000
 MNOTE '---        LINEDIT, NUCON, RDTERM, SAVE, STAX, WAITD, WAITT'    01104000
         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
         MEND                                                  @SC86268 01111000
*COPY                                                 STRTMSGS          01112000
         MACRO                                                          01113000
&LABEL   STRTMSGS                                                       01114000
.* Print system-dependent start-up messages                             01115000
&LABEL   CLI   S1HND,XON                                       @SC87338 01116000
         BNE   STRT1Z                                          @SC87338 01117000
         WTEXT 'Handshake is XON -- not needed'                @SC87338 01118000
STRT1Z   DS    0H                                              @SC87338 01119000
         MEND                                                  @SC87338 01120000
