home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
deleteme.zip
/
ikcmac.asm
< prev
next >
Wrap
Assembly Source File
|
1993-10-21
|
42KB
|
514 lines
*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