Columbia Kermit

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

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

Wrap

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