home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ibm370.zip
/
iktmac.asm
< prev
next >
Wrap
Assembly Source File
|
1993-10-21
|
50KB
|
616 lines
*COPY RTEXT 00800000
MACRO 00800500
&LABEL RTEXT &BUF,&PROMPT=,&E= 00801000
.* Read from the terminal, possible prompt. Get length read in R0. 00801500
.* &1: read buffer (len=130) (LA), &PROMPT(1)= prompt buf. if any 00802000
.* (LA/R), &PROMPT(2)= prompt length (LA/R), &E= branch if error 00802500
GBLC &KVRSN,&KSYS @SC89027 00803000
AIF ('&KVRSN' EQ '4.3' OR '&KSYS' EQ '').VOK @SC90072 00803500
MNOTE 16,'* * * --> IKTMAC version number should be &KVRSN' @SC89027 00804000
.VOK ANOP @SC89027 00804500
&LABEL DS 0H @SC86299 00805000
AIF (T'&PROMPT EQ 'O').NOPR @SC87268 00805500
AIF ('&PROMPT(1)'(1,1) NE '(').NOSV1 @SC89214 00806000
ST &PROMPT(1),RTXTSV Save register, in case (1) @SC89214 00806500
.NOSV1 ANOP @SC89214 00807000
KCALL SUPFNC,7,E=RTE&SYSNDX Skip prompt if stacked @SC88095 00807500
AIF ('&PROMPT(1)'(1,1) NE '(').NOSV2 @SC89214 00808000
L &PROMPT(1),RTXTSV @SC89214 00808500
.NOSV2 ANOP @SC89214 00809000
TPUT &PROMPT(1),&PROMPT(2),ASIS @SC87268 00809500
.NOPR ANOP 00810000
RTE&SYSNDX KCALL GETLIN,&BUF,E=&E @SC88095 00810500
MEND 00811000
*COPY DMSFREE 00811500
MACRO 00812000
&LABEL DMSFREE &DWORDS=(0),&ERR= 00812500
.* Obtain free storage block: len=8*(R0). Returns ptr in R1, but 00813000
.* preserves registers 2-14 00813500
.* &DWORDS= length in doublewords should be in R0, 00814000
.* &ERR= branch if failure 00814500
&LABEL LREG 0,&DWORDS @SC86299 00815000
SLA 0,3 @SC86299 00815500
AIF ('&ERR' NE '').COND @SC86345 00816000
GETMAIN R,LV=(0) @SC86299 00816500
MEXIT 00817000
.COND GETMAIN RC,LV=(0) @SC86345 00817500
LTR 15,15 @SC86345 00818000
BNZ &ERR @SC86345 00818500
MEND 00819000
*COPY DMSFRET 00819500
MACRO 00820000
&LABEL DMSFRET &DWORDS=(0),&LOC=(1),&ERR= 00820500
.* Return free storage block: len=8*(R0), adr=(R1). Preserve R2-14. 00821000
.* &DWORDS= length in doublewords should be in R0, &LOC= adr (in R1), 00821500
.* &ERR= branch if failure 00822000
&LABEL LREG 0,&DWORDS @SC86299 00822500
SLA 0,3 @SC86299 00823000
FREEMAIN R,LV=(0),A=&LOC @SC86299 00823500
MEND 00824000
*COPY WRITF 00824500
MACRO 00825000
&LABEL WRITF &TICK,&BUFFER=,&BSIZE=,&E= 00825500
.* Write to a disk file (ticket ptr in R1) 00826000
.* &1: adr of file access ticket returned by OPENF (A), 00826500
.* &BUFFER= data ptr (LA/R), &BSIZE= data length (LA/R) - if either is 00827000
.* given, it replaces FDB value (see OPENF), &E= branch on error 00827500
&LABEL READF &TICK,BUFFER=&BUFFER,BSIZE=&BSIZE,E=&E,CODE=10 00828000
MEND 00828500
*COPY READF 00829000
MACRO 00829500
&LABEL READF &TICK,&NONUM,&BUFFER=,&BSIZE=,&E=,&CODE=9 00830000
.* Read from disk file (or write) (see WRITF, but also...) 00830500
.* &2: NONUM means chop off numbers 00831000
LCLC &R @SC86299 00831500
LCLA &C @SC88101 00832000
&C SETA &CODE @SC88101 00832500
AIF (T'&NONUM EQ 'O').RDC @SC88101 00833000
AIF ('&NONUM' NE 'NONUM').ER1 @SC88101 00833500
&C SETA 0 Code 0 means exclude sequence nos.@SC88101 00834000
.RDC ANOP @SC88101 00834500
&LABEL L 1,&TICK @SC86299 00835000
AIF ('&BUFFER' EQ '').BZ @SC86299 00835500
AIF ('&BUFFER'(1,1) NE '(').BLA @SC86299 00836000
&R SETC '&BUFFER(1)' @SC86299 00836500
AGO .BST @SC86299 00837000
.BLA LA 15,&BUFFER @SC86299 00837500
&R SETC '15' @SC86299 00838000
.BST ST &R,FDBBUFF-FABD(1) @SC86299 00838500
.BZ AIF ('&BSIZE' EQ '').SZ @SC86299 00839000
AIF ('&BSIZE'(1,1) NE '(').SLA @SC86299 00839500
&R SETC '&BSIZE(1)' @SC86299 00840000
AGO .SST @SC86299 00840500
.SLA LA 15,&BSIZE @SC86299 00841000
&R SETC '15' @SC86299 00841500
.SST ST &R,FDBBSIZ-FABD(1) @SC86299 00842000
.SZ LA 0,&C @SC88101 00842500
KCALL DISKIO,E=&E @SC86299 00843000
MEXIT 00843500
.ER1 MNOTE 2,'INVALID PARAMETER ''&NONUM''' @SC88101 00844000
MEND 00844500
*COPY SAVEF 00845000
MACRO 00845500
&LABEL SAVEF &TICK,&E= @SC88168 00846000
.* Update disk directory for given file (ticket ptr in R1) 00846500
.* &1: adr of file access ticket (A), &E= branch on error 00847000
&LABEL L 1,&TICK @SC88168 00847500
READF &TICK,E=&E,CODE=21 @SC88168 00848000
MEND 00848500
*COPY KSETKW 00849000
MACRO 00849500
KSETKW , @SC87166 00850000
.* Define system-specific SET/SHOW parameters (keywords) 00850500
GBLC &AADELIM,&DESTINA @SC92300 00851000
KW '&AADELIM',SHODLM,MIN=4 @SC92300 00851500
KW '&DESTINA',SHODST,MIN=3 @SC87166 00852000
MEND 00852500
*COPY KSETPRC 00853000
MACRO 00853500
KSETPRC 00854000
.* System-specific SET handlers (in any order). No operands. 00854500
GBLC &DELIMSG @SC92300 00855000
PUSH PRINT @SC86355 00855500
PRINT GEN @SC86355 00856000
SETDST KCALL CWDSET @SC86164 00856500
B RTRN Preserve return code @SC86295 00857000
SETDLM NTOKN N=SETDLM1,H=SETDLMH @SC88095 00857500
LTR 7,7 Exactly one character? @SC88095 00858000
BNZ SETDLMH No, explain it @SC88095 00858500
MVC LNDLM,0(6) Yes, use that character @SC88095 00859000
B RTRN0 @SC88095 00859500
SETDLM1 MVI LNDLM,C' ' Turn delimiter off @SC88095 00860000
B RTRN0 @SC88095 00860500
SETDLMH PTEXT '&DELIMSG' @SC88095 00861000
B SUBERR @SC88095 00861500
POP PRINT @SC86355 00862000
MEND 00862500
*COPY KSHOPRC 00863000
MACRO 00863500
KSHOPRC 00864000
.* System-specific SHOW handlers (in same order as KW). No operands. 00864500
PUSH PRINT @SC86355 00865000
PRINT GEN @SC86355 00865500
SHODLM LA 8,LNDLM Show delimiter @SC88095 00866000
BAL 14,SHOCHR @SC88095 00866500
B SETDLM @SC88095 00867000
SHODST LA 8,DEST @SC86316 00867500
LH 9,DESTL Get length @SC86316 00868000
BAL 14,SHOCHRN @SC86295 00868500
B SETDST @SC87166 00869000
POP PRINT @SC86355 00869500
MEND 00870000
*COPY KFILKW 00870500
MACRO 00871000
KFILKW , @SC87166 00871500
.* Define system-specific file attribute parameters (keywords) 00872000
GBLC &AABLKSI,&AARECFM,&DCBSPAC,&AAAUNIT,&AAAAVOL @SC92300 00872500
KW '&AABLKSI',SHOBSZ,MIN=2 @SC87166 00873000
KW '&AARECFM',SHORFM @SC87166 00873500
KW '&DCBSPAC',SHOTRK,MIN=2 @SC87166 00874000
KW '&AAAUNIT',SHOUNT @SC87166 00874500
KW '&AAAAVOL',SHOVOL,MIN=2 @SC87166 00875000
MEND 00875500
*COPY KFILSET 00876000
MACRO 00876500
KFILSET 00877000
.* Specific SET FILE handlers (any order). No operands. 00877500
GBLC &FIXED,&VARIABL,&UNDEFND @SC92300 00878000
PUSH PRINT @SC87012 00878500
PRINT GEN @SC87012 00879000
SETCMDS CSECT @SC92300 00879500
SETRFMKW KW '&FIXED',SETT,F @SC92300 00880000
KW '&VARIABL',SETT,V @SC92300 00880500
KW '&UNDEFND',SETT,U @SC92300 00881000
KW , @SC92300 00881500
SET CSECT @SC92300 00882000
* 00882500
SETUNT BAL 2,SETFSTR Get fixed-format string @SC86316 00883000
TR FILUNT,UPCASE Should always be upper case @SC88020 00883500
MVC LOGUNT,FILUNT @SC86316 00884000
B RTRN0 @SC86316 00884500
* 00885000
SETVOL BAL 2,SETFSTR Get fixed-format string @SC86295 00885500
TR FILVOL,UPCASE Should always be upper case @SC88020 00886000
MVC LOGVOL,FILVOL @SC86316 00886500
B RTRN0 @SC86295 00887000
POP PRINT @SC87012 00887500
MEND 00888000
*COPY KFILSHO 00888500
MACRO 00889000
KFILSHO 00889500
.* Specific SHOW FILE handlers (same order as KW). No operands. 00890000
PUSH PRINT @SC87012 00890500
PRINT GEN @SC87012 00891000
SHOBSZ L 8,MAXBSZ Limit @SC87166 00891500
LH 4,FILBLKSI @SC87320 00892000
BAL 14,SHONUM Print it @SC86295 00892500
B RTRN0 @SC86295 00893000
SHORFM LA 4,SETRFMKW @SC92300 00893500
LA 6,FILRCF @SC92300 00894000
BAL 14,SHOBRV @SC92300 00894500
NOP 0 @SC92300 00895000
SHOTRK L 8,MAXBSZ Limit @SC87166 00895500
L 4,FILTRKAL @SC88026 00896000
BAL 14,SHONUM Print it @SC86295 00896500
B RTRN0 @SC87166 00897000
SHOUNT LA 8,FILUNT @SC86316 00897500
LA 9,8 @SC86316 00898000
BAL 14,SHOCHRN @SC86316 00898500
B SETUNT @SC87166 00899000
SHOVOL LA 8,FILVOL @SC86295 00899500
LA 9,6 @SC86295 00900000
BAL 14,SHOCHRN @SC86295 00900500
B SETVOL @SC87166 00901000
POP PRINT @SC87012 00901500
MEND 00902000
*COPY WTEXT 00902500
MACRO 00903000
&LABEL WTEXT &ARG,&LEN 00903500
.* Display some text, e.g., WTEXT 'Hi there' or WTEXT (3),(4) 00904000
.* Preserves R2-R14 00904500
.* &1: 'text' (where text has no doubled ' or & characters) OR 00905000
.* &1: adr of text (LA/R), &2: length of text (LA/R) 00905500
&LABEL PTEXT &ARG,&LEN,AREG=1,LREG=0 @SC86295 00906000
BAL 15,WTEXT 'TPUT' @SC87020 00906500
MEND 00907000
*COPY FDBD 00907500
MACRO 00908000
FDBD 00908500
.* Map of File Descriptor Block + File Access Block 00909000
FABD DSECT , @SC86295 00909500
FABRELAD DS 17X FAB maps DCB @SC86299 00910000
FABREL DS AL3 @SC86299 00910500
FABBUFNO DS 0BL1 @SC86299 00911000
FABBUFCB DS A @SC86299 00911500
FABBUFL DS H @SC86299 00912000
FABDSORG DS BL2 @SC86299 00912500
FABIOBAD DS A @SC86299 00913000
FABEODAD DS A @SC86299 00913500
FABRECFM DS 0BL1 @SC86299 00914000
FABRECU EQU X'C0' Undefined-length records @SC86299 00914500
FABRECF EQU X'80' Fixed-length records @SC86299 00915000
FABRECV EQU X'40' Varying-length records @SC86299 00915500
FABRECBR EQU X'10' Blocked records @SC86299 00916000
FABRECCC EQU X'06' Control chars present @SC88106 00916500
FABEXLST DS A @SC86299 00917000
FABDDNAM DS CL8 @SC86299 00917500
FABOFLGS DS BL1 @SC86299 00918000
FABIFLG DS BL1 @SC86299 00918500
FABMACR DS BL2 @SC86299 00919000
ORG FABDDNAM @SC86299 00919500
FABTIOT DS BL2 @SC86299 00920000
FABMACRF DS BL2 @SC86299 00920500
FABDEBAD DS A @SC86299 00921000
FABGET DS A @SC86299 00921500
FABCHECK DS A @SC86299 00922000
FABSYNAD DS A @SC86299 00922500
FABCIND1 DS BL2 @SC86299 00923000
FABBLKSI DS H @SC86299 00923500
FABWCPO DS BL4 @SC86299 00924000
FABIOBA DS A @SC86299 00924500
FABEOBAD DS A @SC86299 00925000
FABRECAD DS A @SC86299 00925500
FABDIRCT DS H @SC86299 00926000
FABLRECL DS H @SC86299 00926500
FABCNTRL DS A @SC86299 00927000
ORG FABD+90 @SC86299 00927500
FABPRECL DS AL2 @SC86299 00928000
FABEOB DS A @SC86299 00928500
FDBD DS 0F Beginning of short descriptor @SC86295 00929000
FDBBUFF DS A Buffer ptr @SC86295 00929500
FDBBSIZ DS F Max record length @SC86295 00930000
FDBRCF DS C Record format @SC86295 00930500
FDBFLGS DS X Flags @SC86295 00931000
FDBACTV EQU X'80' File is already open @SC86295 00931500
* SVATT EQU X'40' Preserve attributes @SC90033 00932000
* APPN EQU X'10' DISP=MOD @SC86295 00932500
*ABRECCC EQU X'06' Control chars present @SC88246 00933000
PDSF EQU X'01' Dataset is a PDS @SC87015 00933500
FDBLRC DS H File record length @SC86295 00934000
FDBTRKAL DS F File track allocation increment @SC88026 00934500
FDBBLKSI DS H File block size @SC86295 00935000
FDBDEVT DS XL4 Device type (must precede VOL) @SC88106 00935500
FDBVOL DS CL6 File volume label @SC86295 00936000
FDBUNT DS CL8 File unit name @SC86299 00936500
FDBSIZE DS F File size in Kbytes @SC86299 00937000
FDBCOP EQU *-FDBD Length to copy for OPEN @SC90037 00937500
FDBDATE DS XL7,X Time stamp: packed yyyymmddhhmmss @SC88235 00938000
FABDSN DS CL52 Dataset name @SC86299 00938500
FABDSMB EQU FABDSN+44,8 Member name @SC88119 00939000
FDBINFO EQU *-FDBD Length of info returned @SC86295 00939500
FABLRTR DS F Record length for truncation @SC88120 00940000
FABEXL DS 3A Modifiable EXLST @SC89073 00940500
FABCOMM DS CL8 Command name @SC87351 00941000
FABDWDS EQU (*-FABD+7)/8 @SC86295 00941500
MEND 00942000
*COPY FDBPAT 00942500
MACRO 00943000
FDBPAT &N,&RFM,&SIZ @SC88120 00943500
.* Define system-dependent part of output FDB patterns 00944000
.* &1: variable-name prefix (or null if defining init. values) 00944500
.* &2: RECFM (1-char), &3: LRECL (skip rest of FDB if omitted)@SC88120 00945000
LCLC &T,&B,&D,&V,&U,&Z @SC88287 00945500
LCLC &R,&F,&L,&S,&P4 @SC90037 00946000
AIF ('&N' EQ '').ALC @SC86316 00946500
&R SETC 'RCF' @SC88120 00947000
&F SETC 'FLGS' @SC88120 00947500
&L SETC 'LRC' @SC88120 00948000
&T SETC 'TRKAL' @SC87320 00948500
&B SETC 'BLKSI' @SC87320 00949000
&D SETC 'DEVT' @SC88287 00949500
&V SETC 'VOL' @SC86316 00950000
&U SETC 'UNT' @SC86316 00950500
&S SETC 'FSIZ' @SC90037 00951000
.ALC ANOP @SC86316 00951500
&N&R DC C'&RFM' RECFM @SC88120 00952000
&N&F DC X'00' Flags @SC88120 00952500
AIF ('&SIZ' EQ '').DONE @SC88120 00953000
AIF ('&RFM' NE 'V').OKL @SC88120 00953500
&P4 SETC '+4' Add 4 for RDW @SC88120 00954000
.OKL ANOP @SC88120 00954500
&N&L DC Y(&SIZ&P4) LRECL @SC88120 00955000
&N&T DC F'5' Track allocation @SC88026 00955500
&Z SETC '6233' Default block size @SC87320 00956000
AIF ('&SIZ' NE 'LPKT').P1 @SC88120 00956500
&Z SETC 'LPKT+8' Block size for log file @SC87320 00957000
.P1 ANOP 00957500
&N&B DC Y(&Z) @SC87320 00958000
&N&D DC XL4'0' Device type (must precede VOL) @SC88287 00958500
&N&V DC CL6' ' No volume specified @SC87320 00959000
&N&U DC CL8' ' Default unit @SC88054 00959500
&N&S DC F'0' File size in Kbytes @SC90037 00960000
.DONE ANOP @SC88120 00960500
MEND 00961000
*COPY KSYSVAR 00961500
MACRO 00962000
KSYSVAR 00962500
.* Define system-dependent globally-known variables 00963000
COMPTR DS 2A Common/storage ptrs @SC87015 00963500
APGPB GETLINE MF=L Parameter block for GETLINE @NW86330 00964000
STAXPLR STAX 0,MF=L Parameter block for STAX (replace)@NW86330 00964500
IOPLAREA DS 4F IOPL @TS86001 00965000
ORGPCMD DS CL8 Saved ECT PCMD field @SC89052 00965500
CPECB DS F GETLINE/PUTLINE/PUTGET ECB @TS86001 00966000
ECBREAD DS F @NW86330 00966500
TASKADD DS A Async task adr @NW86330 00967000
SYSPROC DS A Ptr to CLIST library DCB @SC89073 00967500
ECBTGET DS F @NW86330 00968000
KTGETT DS 2F Adr and length of read request @SC87015 00968500
PUTLINAD DS A Adr of PUTLINE routine @SC88026 00969000
GETLINAD DS A Adr of GETLINE routine @NW86330 00969500
DFMSGP DS A Ptr to DAIR message buffer @SC88119 00970000
CATDSPTR DS A Catalog buffer ptr @NW86330 00970500
NXSFPTR DS A Ptr to suffix comparand @SC87015 00971000
CIRPARM DS 0F @NW86330 00971500
CIROPT DS X'02' Get all matches @NW86330 00972000
DS 2AL1(0) Reserved by system @NW86330 00972500
CIRLOCRC DS AL1(0) Locate return code @NW86330 00973000
CIRSRCH DS A Search arg: adr of test DSN @NW86330 00973500
CIRCVOL DS F'0' Vol adr=0 - force cat lookup @NW86330 00974000
CIRWA DS A Ptr to user work area @NW86330 00974500
CIRSAVE DS A Ptr to save area for macro @NW86330 00975000
CIRPSWD DS F'0' Adr of password @NW86330 00975500
DESTL DS H'0' Length @SC86299 00976000
DEST DS CL44 Default PREFIX @SC86299 00976500
DESTP DS C' ' PDS indicator ('.' if so) @SC86299 00977000
RTXTSV DS F Saved register for prompt @SC89214 00977500
CAMLOC DS 4F Ptrs for locating dataset @SC86299 00978000
CAMOBT DS 4F Ptrs for getting DSCB @SC86299 00978500
CAMVOLS DS 0D,XL265 Storage for volume list @SC86299 00979000
CAMDEVT EQU CAMVOLS+2,4 1st device type @SC88106 00979500
ORG CAMVOLS+100 Do a little overlaying @SC88049 00980000
CAMDSCB DS 0F,XL101 Storage for DSCB @SC88014 00980500
ORG CAMDSCB+1 @SC88014 00981000
DS1VOL DS CL6,XL2 Volume serial @SC86299 00981500
DS1CRDT DS 2XL3,3X,XL8 Creation date @GH89270 00982000
DS1MDDT DS XL3 Modification date (ASM2) @GH89270 00982500
DS1MDTM DS XL2 Modification time of day (ASM2) @GH89270 00983000
DS1RFDT DS XL3,XL4 Reference date @SC86299 00983500
DS1DSO DS XL2 Dataset org @SC86299 00984000
DS1RCF DS X Record format @SC86299 00984500
DS1OPT DS X Error option @SC86299 00985000
DS1BLK DS H Block size @SC86299 00985500
DS1LRC DS H Logical record length @SC86299 00986000
LKPMEM DS CL8 Temporary for member name if mig. @SC89250 00986500
ORG , @SC86299 00987000
DS 0F @SC86299 00987500
DSKSTT EQU *-FDBD+FABD @SC86299 00988000
DS XL(FDBINFO) Room for FDB @SC86299 00988500
ORG DSKSTT+8*FABDWDS Rest of FAB to end @SC91017 00989000
NXFN DS CL(LFID) Pattern filespec for search @SC87015 00989500
DSNPFL DS H Prefix length for search @NW86330 00990000
DSNSFL DS H Suffix length for search @NW86330 00990500
ICPRGS DS 4F Saved registers for type-out @SC88026 00991000
ICPFL DS X Flag for type-out interception @SC87020 00991500
SCRLST DS X Flag for previous I/O op @SC88091 00992000
STMUCH DS XL2 Saved user profile values @SC86299 00992500
OLDUPTSW DS X Old UPTSWS field, saved for STCOM @TL89181 00993000
PTLLEN DS 0F,2H PUTLINE data descriptor @SC88026 00993500
PTLBUF DS CL133 @SC88026 00994000
STKDSN DS CL(LFID) DSN for STACK @SC88026 00994500
* 00995000
DSKFL DS X Flags for catalog scanning @SC90033 00995500
NXDON EQU X'40' Catalog search done @SC87015 00996000
WFN EQU X'08' Filename contains wild chars @SC88246 00996500
PDSBLK DS 0H,XL62 BLDL list @GH90139 00997000
ORG PDSBLK @GH90139 00997500
PDSCOUNT DS H'1' Number of entries @GH90139 00998000
PDSSIZE DS Y(58) Size of each entry @GH90139 00998500
PDSMEMBR DS CL8 Member name @GH90139 00999000
DS XL3,2XL1 TTRC, Linklist/STEPLIB @GH90139 00999500
PDSINDIC DS XL1 Indicators @GH90139 01000000
PDSUSER DS 0C User data field @GH90139 01000500
DS 2XL1,XL2,PL4 Version, level, reserved, CREDT @GH90139 01001000
ISPFMDDT DS PL4 ISPF mod date (00YYDDDF) @GH90139 01001500
ISPFMDTM DS PL2 ISPF mod time (HHMM) @GH90139 01002000
ORG , @GH90139 01002500
MEND 01003000
*COPY KSYSTF 01003500
MACRO 01004000
KSYSTF 01004500
.* Define system-dependent globally-known constants and init. variables 01005000
.* symb .DS + label &P.DEFS mark start of variables/init. values 01005500
GBLC &STORDS @SC89268 01006000
LCLC &P 01006500
PUSH PRINT 01007000
PRINT GEN 01007500
AIF ('&SYSECT' EQ '&STORDS').DS @SC89268 01008000
&P SETC 'I' For initial values 01008500
WTEXT STM 14,1,ICPRGS Save @SC88026 01009000
CLI ICPFL,2 Intercepting? @SC88026 01009500
BE WTXICP Yes, do it @SC88026 01010000
MVC PTLBUF,0(1) Copy to buffer @SC88026 01010500
A 0,F4 @SC88026 01011000
STH 0,PTLLEN And save length @SC88026 01011500
MVI CPECB,0 Clear ECB @SC88119 01012000
L 15,PUTLINAD @SC88026 01012500
PUTLINE PARM=PTPB,MF=(E,IOPLAREA),ENTRY=(15) @SC88026 01013000
B WTXRET @SC87020 01013500
WTXICP KCALL ICPTYP Call interception routine @SC87020 01014000
WTXRET LM 14,1,ICPRGS Restore @SC88026 01014500
BR 15 @SC87020 01015000
KSYSATOE DC A(0) Normal TTY E/A translation @SC88302 01015500
KSYSETOA DC A(0) @SC88302 01016000
SYSATR DC AL1(ADOT,ABL+2,AI,A2) ."I2 System type=TSO @SC88273 01016500
LSYSATR EQU *-SYSATR Length of stuff for A-packet @SC88273 01017000
LOGNAM DC C'KER.LOG' @SC86299 01017500
REPNAM DC C'KER.REPLY' @SC86299 01018000
SYSTAKE DC C'''SYS1' @SC88113 01018500
DKERMINI DC C'.KERMINI''' @SC88113 01019000
LSYST EQU *-SYSTAKE @SC86299 01019500
USRTAKE DC C'KERMINI' Init file @SC86299 01020000
LUSRT EQU *-USRTAKE @SC86299 01020500
KMAIL1 DC C'KERMAIL ' System cmd for invoking mail @SC90037 01021000
KMAIL2 DC C' LIST(' @SC90037 01021500
KMAIL3 DC C')' @SC90037 01022000
KPRNT1 DC C'KERMPRT ' System cmd for printing @SC90037 01022500
KPRNT2 DC C' OPTIONS(' @SC90037 01023000
KPRNT3 DC C')' @SC90037 01023500
KSUBM1 DC C'KERMSUB ' System cmd for submitting job @SC90037 01024000
KSUBM2 DC C' OPTIONS(' @SC90037 01024500
KSUBM3 DC C')' @SC90037 01025000
CIRWAL DC H'32004,0' Length of catalog work area @SC87015 01025500
KSYSNIT CSECT @SC89215 01026000
.DS ANOP 01026500
&P.DEFS DS 0D 01027000
* Timer exit routine @SC88299 01027500
USING *,15 Addressiblity for getting ECB @SC88299 01028000
&P.TMXIT STM 0,1,20(13) Save registers @SC88299 01028500
ICM 1,15,&P.TMXPT Get ptr to target ECB @SC88299 01029000
POST (1),1 @SC88299 01029500
LM 0,1,20(13) Restore registers @SC88299 01030000
BR 14 Return to system @SC88299 01030500
&P.TMXPT DS AL4 Ptr to ECB @SC88299 01031000
DROP 15 @SC88299 01031500
* 01032000
&P.KPRPL DC AL1(L'KPRPT) @SC89268 01032500
&P.KPRPT DC C'Kermit-TSO>' @SC87268 01033000
ORG &P.KPRPT+20 @SC87268 01033500
&P.LNDLM DC C' ' Initially no delimiter @SC88095 01034000
POP PRINT 01034500
&P.PTPB PUTLINE MF=L,OUTPUT=(0,TERM,SINGLE,DATA) @SC88026 01035000
MEND 01035500
*COPY KSYSBUF 01036000
MACRO 01036500
KSYSBUF 01037000
.* Store buffer ptrs from R1 and increment R1 for specific buffers 01037500
LA 0,4-1 @SC87015 01038000
AR 1,0 @SC87015 01038500
OR 1,0 @SC87015 01039000
XR 1,0 @SC87015 01039500
ST 1,CIRSAVE Catalog scan save area @SC87015 01040000
LA 1,72(1) @SC87015 01040500
ST 1,CIRWA Catalog info buffer @SC87015 01041000
AH 1,CIRWAL @SC87015 01041500
ST 1,CIRSRCH Catalog search comparand @SC87015 01042000
LA 1,44(1) @SC87015 01042500
ST 1,DFMSGP DAIR message buffer @SC88119 01043000
LA 1,512(1) @SC88119 01043500
MEND 01044000
*COPY SSYMS 01044500
MACRO 01045000
SSYMS 01045500
.* Set global symbols for conditional assembly 01046000
GBLC &KVRSN,&KSYS,&KDATE,&RTN,&TYPCMD,&S1CMD,&KCONT @SC88309 01046500
GBLC &KEDIT,&STORDS,&KTAG,&AEACMD,&CONOPTS,&S1CMD1 @SC91311 01047000
GBLA &MAXLR,&MAXBS @SC86268 01047500
GBLC &AAAAAOK,&AAAAVOL,&AAAUNIT,&AABLKSI,&BADFSPC @SC92300 01048000
GBLC &CWDERRM,&DCBSPAC,&DESTINA,&FILCLSN,&FMTFSPC @SC92300 01048500
GBLC &MIGRATD,&NOFSPEC,&NOTCPER,&QQWRITE,&SPACERR @SC92300 01049000
&KSYS SETC 'TSO' System name @SC86299 01049500
MNOTE '*** Kermit-&KSYS release &KVRSN..&KEDIT &KTAG (&KDATE) ***' 01050000
** BEGIN LANGUAGE-SPECIFIC DATA ** ** TSO-specific ** @SC92300 01050500
&AAAAAOK SETC 'OK' (see QQWRITE) @SC88076 01051000
&BADFSPC SETC 'Invalid DSN' @SC86299 01051500
&CWDERRM SETC 'Must be valid DSN prefix' @SC86299 01052000
&FILCLSN SETC ' File name collision' (2 leading blanks) @SC88049 01052500
&FMTFSPC SETC 'Enter d.s.n' @SC91224 01053000
&MIGRATD SETC ' Dataset not on-line' (2 leading blanks) @SC89250 01053500
&NOFSPEC SETC 'Missing DSN' @SC86299 01054000
&NOTCPER SETC 'Kermit-TSO must be a command processor' @SC86299 01054500
&QQWRITE SETC ' exists. Reply "OK" to overwrite:' @SC87015 01055000
&SPACERR SETC 'SPACE not implemented' (see AASPACE) @SC86299 01055500
* Subcommand keywords @SC92300 01056000
&AAAAVOL SETC 'VOLUME' kwd->AAAFILE, m=2 @SC87166 01056500
&AAAUNIT SETC 'UNIT' kwd->AAAFILE @SC87166 01057000
&AABLKSI SETC 'BLKSIZE' kwd->AAAFILE, m=2 @SC87166 01057500
&DCBSPAC SETC 'SPACE' kwd->AAAFILE, m=2 @SC87166 01058000
&DESTINA SETC 'PREFIX' kwd->AAAASET, m=3 @SC87166 01058500
** END LANGUAGE-SPECIFIC DATA ** @SC92300 01059000
&MAXLR SETA 32756 Max lrecl @SC86299 01059500
&MAXBS SETA 32760 Max blksize @SC86299 01060000
&AEACMD SETC 'X''F3''' AEA command prefix (X'F3'=WSF) @SC90173 01060500
&S1CMD SETC 'X''F1C2''' S/1 command prefix @SC90264 01061000
&S1CMD1 SETC 'X''F1C1''' S/1 command prefix for Status Req @SC91311 01061500
&CONOPTS SETC 'STCQNS1' SETCON options @SC91311 01062000
&KCONT SETC 'T' Default controller type (TTY) @SC88309 01062500
PUSH PRINT 01063000
PRINT GEN 01063500
MAXWT EQU 1024 Max TPUT buffer @SC86299 01064000
MAXRT EQU 1024 Max TGET buffer @SC86299 01064500
MAXWS EQU 1920 Max fullscreen output buffer @SC90277 01065000
MAXRS EQU 1920 Max fullscreen input buffer @SC90277 01065500
FSRDOF EQU 6 Offset of data in fullscreen read @SC92030 01066000
MAXDOF EQU 0 Offset of disk out buffer @SC90264 01066500
STMGT EQU 0 Overhead for storage mngmnt @SC90264 01067000
LFID EQU 60 Max length of filespec @SC88342 01067500
&TYPCMD SETC 'LIST' Host command for TYPE @SC86299 01068000
TYPMIN EQU 4 Min abbrv of system TYPE cmd or 2 @SC86299 01068500
FBRK1 EQU C'<' Starting character for options @SC89218 01069000
FBRK2 EQU C'>' Ending character for options @SC89218 01069500
KMAXE EQU 1920 < 9025 Kermit extended max pkt @SC90277 01070000
STKDWDS EQU 511 Size of save-area stack @SC87012 01070500
&STORDS SETC 'KSTORG' Storage DSECT for Kermit globals @SC89268 01071000
KWRKBASE EQU 11 Base register for work area @SC89268 01071500
KSUBBASE EQU 12 Base register for CSECT @SC89268 01072000
POP PRINT 01072500
MEND @SC86268 01073000
*COPY SYSMACS 01073500
MACRO 01074000
SYSMACS 01074500
.* Include system control block definition macros and list all macros 01075000
MNOTE '---MACROs: ATTACH, BLDL, CATALOG, CLOSE, DETACH, DEVTYPE,' 01075500
MNOTE '--- ESTAI, FIND, FREEMAIN,' 01076000
MNOTE '--- FREEPOOL, GETLINE, GETMAIN, GTSIZE, IDENTIFY,' 01076500
MNOTE '--- IKJCPPL, IKJECT, IKJGTPB, IKJIOPL, IKJUPT,' 01077000
MNOTE '--- LINK, LOAD, LOCATE, OBTAIN, OPEN, POST,' 01077500
MNOTE '--- PUTLINE, RDJFCB, SAVE, SCRATCH, STACK,' 01078000
MNOTE '--- STATUS, STAX, STCC,' 01078500
MNOTE '--- STCOM, STFSMODE, STIMER, STSIZE, SYNADAF,' 01079000
MNOTE '--- SYNADRLS, TGET, TPG, TPUT, TTIMER, WAIT' 01079500
IKJCPPL , @SC86299 01080000
IKJECT , @SC86299 01080500
IKJGTPB , @NW86330 01081000
IKJIOPL , @TS86001 01081500
IKJUPT , @SC86299 01082000
* DSECT for addressing catalog information work area 01082500
CATDSET DSECT @NW86330 01083000
TYPEBYTE DS XL1 Type byte we want only A's @NW86330 01083500
CATDNAME DS 44CL1 Data set name @NW86330 01084000
MEND @SC86268 01084500
*COPY STRTMSGS 01085000
MACRO 01085500
&LABEL STRTMSGS 01086000
.* Print system-dependent start-up messages 01086500
GBLC &HANDXON @SC92300 01087000
&LABEL CLI S1HND,XON @SC87338 01087500
BNE STRT1Z @SC87338 01088000
BAL 14,TTYCHK @SC92030 01088500
B STRT1Z TTY, suppress message @SC87338 01089000
WTEXT '&HANDXON' @SC87338 01089500
STRT1Z DS 0H @SC87338 01090000
MEND @SC87338 01090500
*COPY KMAIN 01091000
MACRO 01091500
&LABEL KMAIN &TYPE 01092000
.* Linkage conventions with system. 01092500
.* &1: ENTER if entering, RETURN if returning 01093000
AIF ('&TYPE' NE 'RETURN').ENT @SC89268 01093500
&LABEL L 13,4(13) Unlink @SC86295 01094000
ST 15,16(13) Save return code @SC86295 01094500
LA 0,STODWDS+STKDWDS @SC87012 01095000
LR 1,KWRKBASE @SC89268 01095500
DMSFRET DWORDS=(0),LOC=(1) @SC86295 01096000
LM 14,12,12(13) Restore registers @SC86295 01096500
BR 14 @SC86295 01097000
MEXIT , @SC89268 01097500
.ENT AIF ('&TYPE' NE 'ENTER').OTH @SC89268 01098000
SAVE (14,12),,&LABEL @SC90264 01098500
LR KSUBBASE,15 @SC89268 01099000
L 10,=A(COMMON) Common code addressibility @SC86316 01099500
LA 0,STODWDS+STKDWDS @SC87012 01100000
DMSFREE DWORDS=(0) Get storage for vars + stack @SC86295 01100500
LR KWRKBASE,1 Get addressibility @SC89268 01101000
LR 0,1 @SC86295 01101500
LA 1,8*STODWDS Length of storage @SC86295 01102000
SR 15,15 Zero fill @SC86295 01102500
MVCL 0,14 @SC86295 01103000
LR 15,0 Start of stack @SC86295 01103500
A 0,=A(8*STKDWDS) End of stack @SC87012 01104000
STM 15,0,STKPTR @SC86295 01104500
ST 15,STKLO @SC89089 01105000
LM 15,1,16(13) Restore registers @SC86295 01105500
MEXIT , @SC89268 01106000
.OTH MNOTE 12,'Invalid type &TYPE' @SC89268 01106500
MEND @SC89268 01107000