*COPY                                                 KW                00300000
         MACRO                                                          00301000
&LABEL   KW    &KW,&ADDR,&MIN=1                                         00302000
.* Define a KW for the parser                                           00303000
.*  &1: 'keyword' or GOTO (to define ptr to next keyword item) or nil   00304000
.*  (to end a list), &2: address of handler (if &1 is a 'keyword') or   00305000
.*  of next item (if &1 is GOTO) (A), &MIN=length of min. abrv          00306000
         LCLA  &LEN                                                     00307000
         AIF   ('&KW' NE '').KW                                         00308000
&LABEL   DC    X'FF'                                                    00309000
         AGO   .DONE                                                    00310000
.KW      AIF   ('&KW' NE 'GOTO').KWN                                    00311000
&LABEL   DC    AL3(&ADDR),AL1(255)                             @SC87117 00312000
         MEXIT                                                          00313000
.KWN     ANOP                                                           00314000
&LEN     SETA  K'&KW-3                                                  00315000
&LABEL   DC    AL3(&ADDR.),AL1(&LEN.),AL1(&MIN.-1),C&KW                 00316000
.DONE    MEND                                                           00317000
*COPY                                                 SCAN              00318000
         MACRO                                                          00319000
&LABEL   SCAN  &TABLE,&HELP,&NODISP                            @SC87320 00320000
.* Parse input using a KW table. Setup already done via NTOKN or CTOKN. 00321000
.* Dispatch to proper handler if found in table, else return.           00322000
.*  &1: adr of relevant table (LA/R), &2: handler if '?' (LA),          00323000
.*  &3: if 'NODISP', then dispatch to HELP handler with high byte of    00324000
.*  R7 not 0 and (R1)-> KW entry (if found)                             00325000
&LABEL   LREG  1,&TABLE                                        @SC86295 00326000
         AIF   ('&NODISP' EQ '').CALL                          @SC87320 00327000
         AIF   ('&NODISP' NE 'NODISP').ERR                     @SC87320 00328000
         ICM   7,8,*                                           @SC87320 00329000
.CALL    BAL   14,SCAN                                         @SC87320 00330000
          B    &HELP                                           @SC86135 00331000
         MEXIT                                                 @SC87320 00332000
.ERR     MNOTE 2,'Invalid positional parameter &NODISP'        @SC87320 00333000
         MEND                                                           00334000
*COPY                                                 HELP              00335000
         MACRO                                                          00336000
&LABEL   HELP  &TABLE,&RETURN                                           00337000
.* Display acceptable keywords, then branch                             00338000
.*  &1: ptr to table (LA/R), &2: place to branch (LA)                   00339000
&LABEL   LREG  1,&TABLE                                        @SC86295 00340000
         BAL   14,HELPKW                                                00341000
          B    &RETURN                                         @SC86135 00342000
         MEND                                                           00343000
*COPY                                                 NTOKN             00344000
         MACRO                                                          00345000
&LABEL   NTOKN &H=,&N=                                                  00346000
.* Pick next token, optionally test for ?                               00347000
.*  &H= handler if '?' (LA), &N= handler if none (LA)                   00348000
&LABEL   BAL   14,WSPTOK                                                00349000
          B    &N                                              @SC86135 00350000
         AIF   ('&H' EQ '').H                                           00351000
         CLI   0(6),C'?'                                       @SC86115 00352000
         BE    &H                                                       00353000
.H       MEND                                                           00354000
*COPY                                                 FTOKN             00355000
         MACRO                                                          00356000
&LABEL   FTOKN &H=,&N=                                                  00357000
.* Find start of next token, optionally test for ?                      00358000
.*  &H= handler if '?' (LA), &N= handler if none (LA)                   00359000
&LABEL   BAL   9,WSP                                           @SC86295 00360000
          B    &N                                              @SC86224 00361000
         AIF   ('&H' EQ '').H                                  @SC86224 00362000
         CLI   0(7),C'?'                                                00363000
         BE    &H                                                       00364000
.H       MEND                                                           00365000
*COPY                                                 PTEXT             00366000
         MACRO                                                          00367000
&LABEL   PTEXT &TEXT,&LEN,&AREG=3,&LREG=4                               00368000
.* Set up 2 registers to point to some text and contain the length      00369000
.*  &1: 'text' (where text has no doubled ' or & characters)  OR        00370000
.*  &1: text (LA/R), &2: length of text (LA/R),                         00371000
.*  &AREG= reg for ptr, &LREG= reg for len                              00372000
         LCLA  &TEXTL                                                   00373000
         AIF   ('&TEXT'(1,1) EQ '''').TEXT                     @SC86355 00374000
&LABEL   LREG  &AREG,&TEXT                                     @SC86295 00375000
         AGO   .LEN                                            @SC86355 00376000
.TEXT    ANOP                                                           00377000
&TEXTL   SETA  K'&TEXT-2                                                00378000
&LABEL   LA    &AREG,=C&TEXT                                            00379000
         AIF   ('&LEN' NE '').LEN                              @SC86355 00380000
         LA    &LREG,&TEXTL                                             00381000
         MEXIT                                                          00382000
.LEN     LREG  &LREG,&LEN                                      @SC86295 00383000
         MEND                                                           00384000
*COPY                                                 KCALL             00385000
         MACRO                                                          00386000
&LABEL   KCALL &NAME,&VALUE,&EXT,&E=                                    00387000
* Call a routine, fill R1 with a parm if any, and allow error branch    00388000
.*  &1: routine name or (reg), &2: argument (LA/R) (opt),      @SC87275 00389000
.*  &3: EXT if non-Kermit,                                     @SC87275 00390000
.*  &E= branch if R15 NZ (LA) or (branch,cc) with cc=suffix of B instr  00391000
         LCLC  &CC                                             @SC86135 00392000
&CC      SETC  'NZ'          Default condition                 @SC86135 00393000
&LABEL   LREG  1,&VALUE                                        @SC86295 00394000
         AIF   ('&EXT' NE 'EXT').INTRN                         @SC86295 00395000
         L     15,=V(&NAME)                                    @SC86295 00396000
         AGO   .BAL                                            @SC87012 00397000
.INTRN   AIF   ('&NAME'(1,1) NE '(').INTRNL                    @SC87275 00398000
         LREG  15,&NAME                                        @SC87275 00399000
         AGO   .BAL                                            @SC87275 00400000
.INTRNL  L     15,A&NAME                                       @SC86295 00401000
.BAL     BALR  14,15                                           @SC87012 00402000
         AIF   ('&E' EQ '').NOERR                                       00403000
         AIF   ('&EXT' NE 'EXT').NOLT                          @SC87012 00404000
         LTR   15,15                                           @SC87012 00405000
.NOLT    AIF   (N'&E LT 2).NCC                                 @SC87012 00406000
&CC      SETC  '&E(2)'                                         @SC86135 00407000
.NCC      B&CC &E(1)                                           @SC86135 00408000
.NOERR   MEND                                                           00409000
*COPY                                                 ADCON             00410000
         MACRO                                                          00411000
         ADCON                                                          00412000
.* Define address constants for subroutine calls, etc.  Takes a list.   00413000
         LCLA  &N                                              @SC86295 00414000
.LUP     AIF   (&N GE N'&SYSLIST).DUN                          @SC86295 00415000
&N       SETA  &N+1                                            @SC86295 00416000
A&SYSLIST(&N) DC A(&SYSLIST(&N))                               @SC87201 00417000
         AGO   .LUP                                            @SC86295 00418000
.DUN     MEND                                                           00419000
*COPY                                                 LREG              00420000
         MACRO                                                          00421000
&LABEL   LREG  &R,&VAL                                         @SC86295 00422000
.* Load register with parameter                                         00423000
.*  &1: reg, &2: value (LA) or (reg) or omitted                         00424000
         AIF   ('&VAL' EQ '').OKREG                            @SC86295 00425000
         AIF   ('&VAL'(1,1) EQ '(').REG                        @SC86295 00426000
&LABEL   LA    &R,&VAL                                         @SC86295 00427000
         MEXIT                                                 @SC86295 00428000
.REG     AIF   ('&VAL' EQ '(&R)').OKREG                        @SC86295 00429000
&LABEL   LR    &R,&VAL(1)                                      @SC86295 00430000
         MEXIT                                                 @SC86295 00431000
.OKREG   AIF   ('&LABEL' EQ '').Z                              @SC86295 00432000
&LABEL   DS    0H                                              @SC86295 00433000
.Z       MEND                                                  @SC86295 00434000
*COPY                                                 OPENF             00435000
         MACRO                                                          00436000
&LABEL   OPENF &MODE,&NAME,&FDB,&FID,&E=                                00437000
.* Open file for input or output or test existence                      00438000
.*  &1: I|O|T, &2: file name (LA/R), &3: pattern FDB (LA/R),            00439000
.*  &4: file ticket (LA) (opt), &E= error branch (see KCALL)            00440000
         LCLA  &CODE                                           @SC86295 00441000
         AIF   ('&MODE' NE 'I').CKO                            @SC86295 00442000
&CODE    SETA  1                                               @SC86295 00443000
         AGO   .MOK                                            @SC86295 00444000
.CKO     AIF   ('&MODE' NE 'O').CKT                            @SC86295 00445000
&CODE    SETA  2                                               @SC86295 00446000
         AGO   .MOK                                            @SC86295 00447000
.CKT     AIF   ('&MODE' NE 'T').ILLM                           @SC86295 00448000
&CODE    SETA  3                                               @SC86295 00449000
         AIF   ('&FID' NE '').ILLF                             @SC86295 00450000
.MOK     ANOP  ,                                               @SC86295 00451000
&LABEL   LA    0,&CODE                                         @SC86295 00452000
         LREG  2,&NAME                                         @SC86295 00453000
         KCALL DISKIO,&FDB,E=&E                                @SC86295 00454000
         AIF   ('&FID' EQ '').Z                                @SC86295 00455000
         ST    0,&FID                                          @SC86295 00456000
.Z       MEXIT                                                 @SC86295 00457000
.ILLM    MNOTE 2,'ILLEGAL MODE ''&MODE'''                               00458000
         MEXIT                                                 @SC86295 00459000
.ILLF    MNOTE 2,'FID NOT ALLOWED WITH MODE ''&MODE'''                  00460000
         MEND                                                           00461000
*COPY                                                 CLOSF             00462000
         MACRO                                                          00463000
&LABEL   CLOSF &FID,&E=                                                 00464000
.* Call DSKIO to close a file and zero ticket.  NOP if already 0.       00465000
.*  &1: file ticket (LA) (opt), &E= error branch (see KCALL)            00466000
&LABEL   LA    0,4                                             @SC86295 00467000
.CAL     KCALL DISKIO,&FID,E=&E                                @SC86295 00468000
         MEND                                                           00469000
*COPY                                                 ERRF              00470000
         MACRO                                                          00471000
&LABEL   ERRF                                                           00472000
.* Call DISKIO to analyze an error code in R15 (no options)             00473000
.* Clobbers TMPDW                                                       00474000
&LABEL   LA    0,12                                            @SC87338 00475000
         CVD   15,TMPDW      Save error code                   @SC87338 00476000
         KCALL DISKIO        Keep registers same               @SC87338 00477000
         MEND                                                           00478000
*COPY                                                 ERASF             00479000
         MACRO                                                          00480000
&LABEL   ERASF &NAME,&E=                                                00481000
.* Call DISKIO to erase a file                                          00482000
.*  &1: file name (LA/R), &E= error branch (see KCALL)                  00483000
&LABEL   LA    0,14                                            @SC86295 00484000
         KCALL DISKIO,&NAME,E=&E                               @SC86295 00485000
         MEND                                                           00486000
*COPY                                                 NXTFSET           00487000
         MACRO                                                          00488000
&LABEL   NXTFSET &NAME,&TYPE,&E=                                        00489000
.* Call DISKIO to set up search for files                               00490000
.*  &1: file name (LA/R), &2: CWD => checking validity for CWD,         00491000
.*  END => closing file name search,                                    00492000
.*  &E= error branch (see KCALL)                                        00493000
         LCLA  &CODE                                           @SC86295 00494000
&CODE    SETA  5             Ordinary setup                    @SC86295 00495000
         AIF   ('&TYPE' EQ '').TOK                             @SC86295 00496000
&CODE    SETA  7             End of search                     @SC86355 00497000
         AIF   ('&TYPE' EQ 'END').TOK                          @SC86355 00498000
&CODE    SETA  8             Check CWD string                  @SC86295 00499000
.TOK     ANOP                                                           00500000
&LABEL   LA    0,&CODE                                         @SC86295 00501000
         KCALL DISKIO,&NAME,E=&E  Init for NXTFST call         @SC86295 00502000
         MEND                                                           00503000
*COPY                                                 NXTF              00504000
         MACRO                                                          00505000
&LABEL   NXTF  &E=                                                      00506000
.* Call DISKIO to get next file name in FILNAM                          00507000
.*  &E= error branch (see KCALL)                                        00508000
&LABEL   LA    0,6                                             @SC86295 00509000
         KCALL DISKIO,E=&E   Find next file                    @SC86295 00510000
         MEND                                                           00511000
*COPY                                                 RET               00512000
         MACRO                                                          00513000
&LABEL   RET   &TYPE                                                    00514000
.* Generate return from subroutines.                                    00515000
.*  &1: MAIN if return from Kermit main code                            00516000
         AIF   ('&TYPE' EQ 'MAIN').RMAIN                       @SC86295 00517000
&LABEL   B     RTRN                                            @SC86295 00518000
         MEXIT                                                          00519000
.RMAIN   ANOP                                                           00520000
&LABEL   L     13,4(13)      Unlink                            @SC86295 00521000
         ST    15,16(13)     Save return code                  @SC86295 00522000
         LA    0,STODWDS+STKDWDS                               @SC87012 00523000
         LR    1,11                                            @SC86316 00524000
       DMSFRET DWORDS=(0),LOC=(1)                              @SC86295 00525000
         LM    14,12,12(13)  Restore registers                 @SC86295 00526000
         BR    14                                              @SC86295 00527000
         MEND                                                           00528000
*COPY                                                 ENTER             00529000
         MACRO                                                          00530000
&LABEL   ENTER &TYPE                                           @SC86295 00531000
.* Establish routine entry code                                         00532000
.*  &1: ALT if 2ndary entry or MAIN if main program                     00533000
         GBLC  &RTN                                            @SC86295 00534000
         AIF   ('&TYPE' EQ 'ALT').ALT                          @SC86141 00535000
&RTN     SETC  '&LABEL'                                                 00536000
&LABEL   CSECT                                                          00537000
         USING &RTN.SV,13                                      @SC86295 00538000
         USING &LABEL,12                                       @SC86295 00539000
         SAVE  (14,12),,&LABEL                                 @SC86141 00540000
         AIF   ('&TYPE' NE 'MAIN').ORD                         @SC86295 00541000
         LR    12,15                                           @SC86295 00542000
         L     10,=A(COMMON) Common code addressibility        @SC86316 00543000
         LA    0,STODWDS+STKDWDS                               @SC87012 00544000
       DMSFREE DWORDS=(0)    Get storage for vars + stack      @SC86295 00545000
         LR    11,1          Get addressibility                @SC86295 00546000
         LR    0,1                                             @SC86295 00547000
         LA    1,8*STODWDS   Length of storage                 @SC86295 00548000
         SR    15,15         Zero fill                         @SC86295 00549000
         MVCL  0,14                                            @SC86295 00550000
         LR    15,0          Start of stack                    @SC86295 00551000
         A     0,=A(8*STKDWDS) End of stack                    @SC87012 00552000
         STM   15,0,STKPTR                                     @SC86295 00553000
         LM    15,1,16(13)   Restore registers                 @SC86295 00554000
         AGO   .ORD                                            @SC86141 00555000
.ALT     ENTRY &LABEL                                          @SC86141 00556000
&LABEL   SAVE  (14,12),,*                                      @SC86141 00557000
         L     15,A&RTN                                        @SC86295 00558000
.ORD     LA    0,&RTN.LX                                       @SC86295 00559000
         BAL   14,SUBENT                                       @SC86295 00560000
         MEND                                                           00561000
*COPY                                                 EXIT              00562000
         MACRO                                                          00563000
         EXIT                                                           00564000
.* Assembler stuff for end of routine and end of local temporaries      00565000
         GBLC  &RTN                                            @SC86295 00566000
         DS    0D                                              @SC86295 00567000
&RTN.LX  EQU   *-&RTN.SV                                       @SC86295 00568000
         DROP  13,12                                           @SC86295 00569000
         MEND                                                           00570000
*COPY                                                 LOCALS            00571000
         MACRO                                                          00572000
         LOCALS                                                         00573000
.* Define storage for save area.  Follow with temporaries               00574000
         GBLC  &RTN                                            @SC86295 00575000
.LT      LTORG                                                 @SC86141 00576000
&RTN.SV  DSECT                                                 @SC86295 00577000
         DS    18F                                             @SC86295 00578000
         MEND                                                           00579000
*COPY                                                 ASCSYM            00580000
         MACRO                                                          00581000
         ASCSYM &LIST                                                   00582000
.* Define symbols (of form 'Ax') for ASCII upper-case & digits          00583000
         LCLA  &I,&N                                                    00584000
         LCLC  &C                                                       00585000
&N       SETA  K'&LIST       Number of chars                            00586000
&I       SETA  0                                                        00587000
.LP      AIF   (&I GE &N).DONE                                          00588000
&I       SETA  &I+1                                                     00589000
&C       SETC  '&LIST'(&I,1)                                            00590000
         AIF   ('&C' LT 'A').LP                                         00591000
         AIF   ('&C' GT 'I').TRJR                                       00592000
A&C      EQU   C'&C'-128                                                00593000
         AGO   .LP                                                      00594000
.TRJR    AIF   ('&C' GT 'R').TRSZ                                       00595000
A&C      EQU   C'&C'-135                                                00596000
         AGO   .LP                                                      00597000
.TRSZ    AIF   ('&C' GT 'Z').TRNUM                                      00598000
A&C      EQU   C'&C'-143                                                00599000
         AGO   .LP                                                      00600000
.TRNUM   AIF   ('&C' GT '9').LP                                         00601000
A&C      EQU   C'&C'-192                                                00602000
         AGO   .LP                                                      00603000
.DONE    MEND                                                           00604000
*COPY                                                 NOTQR             00605000
         MACRO                                                          00606000
&LABEL   NOTQR &BRANCH                                         @SC86120 00607000
.* Test for an Ascii char range of 33-62 and 96-126                     00608000
.*  &1: branch if out of range (LA)                                     00609000
&LABEL   BAL   14,CHKQR                                        @SC86120 00610000
          B    &BRANCH                                         @SC86120 00611000
         MEND                                                           00612000
*COPY                                                 UNCHR             00613000
         MACRO                                                          00614000
&LABEL   UNCHR &REG,&DATA,&TO                                           00615000
.* UnChr: Subtract an ASCII space.  Set cc=M if too small.              00616000
.*  &1: reg for value, &2: source (LA) if not &1, &3: dest (LA) (opt)   00617000
&LABEL   CCHAR &REG,&DATA,&TO,S,SPACE                                   00618000
         MEND                                                           00619000
*COPY                                                 TOCHR             00620000
         MACRO                                                          00621000
&LABEL   TOCHR &REG,&DATA,&TO                                           00622000
.* ToChr: Add an ASCII space                                            00623000
.*  &1: reg for value, &2: source (LA) if not &1, &3: dest (LA) (opt)   00624000
&LABEL   CCHAR &REG,&DATA,&TO,A,SPACE                                   00625000
         MEND                                                           00626000
*COPY                                                 CTL               00627000
         MACRO                                                          00628000
&LABEL   CTL   &REG,&DATA,&TO                                           00629000
.* CTL: Reverse bit 6 to make a ctl char printable and vice versa       00630000
.*  &1: reg for value, &2: source (LA) if not &1, &3: dest (LA) (opt)   00631000
&LABEL   CCHAR &REG,&DATA,&TO,X,F64                            @SC86120 00632000
         MEND                                                           00633000
*COPY                                                 CCHAR             00634000
         MACRO                                                          00635000
&LABEL   CCHAR &REG,&DATA,&TO,&OP,&VALUE                                00636000
.* CCHAR: Used by CTL/UNCHR/TOCHR to add/subtract number                00637000
.*  &1: reg for value, &2: source (LA) if not &1, &3: dest (LA) (opt),  00638000
.*  &4: opcode for change, &5: operand                                  00639000
         AIF   ('&LABEL' EQ '').NOLAB                                   00640000
&LABEL   DS    0H                                                       00641000
.NOLAB   AIF   ('&DATA' EQ '').NODATA                                   00642000
         SR    &REG,&REG                                       @SC86120 00643000
         IC    &REG,&DATA                                               00644000
.NODATA  &OP   &REG,&VALUE                                              00645000
         AIF   ('&TO' EQ '').TO                                         00646000
         STC   &REG,&TO                                                 00647000
.TO      MEND                                                           00648000
*COPY                                                 MSGDF             00649000
         MACRO                                                          00650000
         MSGDF &NM,&TEXT                                                00651000
.* Define error message table entry and pointer                         00652000
.*  &1: 3-letter error code, &2: 'text of message'                      00653000
ERRTAB   CSECT                                                          00654000
ERR&NM   EQU   (*-ERRTAB)/4  Symbolic error number                      00655000
         DC    AL1(L'MSG&NM),AL3(MSG&NM)                                00656000
ERRMSGS  CSECT                                                          00657000
MSG&NM   DC    C&TEXT                                                   00658000
         MEND                                                           00659000
