*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