Columbia Kermit

home *** CD-ROM | disk | FTP | other *** search

/ Columbia Kermit / kermit.zip / ibm370 / ikcmac.asm < prev next >

Wrap

Assembly Source File | 2020-01-01 | 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