QRY TITLE 'DMSQRY (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMSQRY 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* QUERY COMMAND. TO DISPLAY AT THE USER'S TERMINAL THE STATUS 00010000
* OF VARIOUS CMS FUNCTIONS AND TABLES. 00011000
* 00012000
* ATTRIBUTES - 00013000
* 00014000
* TRANSIENT, NOT REENTRANT, CALLED VIA SVC 202 00015000
* 00016000
* ENTRY POINTS - 00017000
* 00018000
* 1. DMSQRY, QUERY - QUERY COMMAND 00019000
* 00020000
* ENTRY CONDITIONS - 00021000
* 00022000
* GPR1 = A(PLIST) 00023000
* PLIST = CL8'QUERY' 00024000
* CL8 - FUNCTION 00025000
* CLn - n = 8 * number of argument for cmd HRC101DS 00026290
* CL8 - ( or FENCE HRC101DS 00026580
* CL8 - STACK HRC101DS 00026870
* CL8 - FIFO/LIFO HRC101DS 00027160
* CL8 - FENCE HRC101DS 00027450
* 00028000
* FUNCTIONS = ABBREV, BLIP, DISK MODE|*|MAX|R/W,HRC003DS 00029490
* FILEDEF, IMPCP, IMPEX, INPUT, 00030000
* LDRTBLS, LIBRARY, MACLIB, OUTPUT, PROTECT, 00031000
* RDYMSG, REDTYPE, RELPAGE, SEARCH, 00032000
* SYNONYM SYSTEM|USER|ALL, TXTLIB 00033000
* SYSNAMES, DOSLIB, DOS, DOSPART, OPTION, 00034000
* UPSI, DLBL, DOSLNCNT, CMSLEVEL HRC322DS 00035000
* 00036000
* EXIT CONDITIONS - 00037000
* 00038000
* NORMAL - 00039000
* GPR15 = 0 00040000
* 00041000
* ERROR - 00042000
* GPR15 = 24 : INVALID PARAMETER 00043000
* 24 : NO FUNCTION SPECIFIED 00044000
* 24 : TOO MANY PARAMETERS SPECIFIED 00045000
* 24 : REQUIRED PARAMETER NOT SPECIFIED 00046000
* 24 : INVALID FUNCTION SPECIFIED 00047000
* 00048000
* EXTERNAL REFERENCES - 00049000
* 00050000
* ABDSECT - SYSTEM SYNONYM INFORMATION 00051000
* NUCON - NUCLEUS CONSTANTS AREA 00052000
* EXTSECT - EXTERNAL INTERRUPT INFORMATION 00053000
* CMSCB - FCB INFORMATION 00054000
* ADT - ACTIVE DISK TABLE INFORMATION 00055000
* 00056000
* CALLS TO OTHER ROUTINES - 00057000
* 00058000
* DMSLAD - FIND THE NEXT ACTIVE DISK TABLE 00059000
* DMSCWR - TYPE A MSG ON THE TERMINAL 00060000
* DMSERR - OUTPUT A MSG TO THE TERMINAL 00061000
* Diag83 - Issue CP command HRC322DS 00062000
* 00063000
* TABLES/WORKAREAS - 00064000
* 00065000
* ITRTABLE - STANDARD INPUT TRANSLATE TABLE 00066000
* OTRTABLE - STANDARD OUTPUT TRANSLATE TABLE 00067000
* 00068000
* REGISTER USAGE - 00069000
* 00070000
* GPR0, GPR1 = SETTING UP ENTRY CONDITIONS TO EXTERNAL ROUTINES 00071000
* GPR2 = A(DMSQRY PLIST) 00072000
* GPR5 = BRANCH TAKEN AFTER QUERIED OPTION HAS OUTPUT ITS STATUS 00073000
* GPR4, GPR12 = BASE REGISTERS 00074000
* GPR14 = LINK REGISTER FOR BALR 00075000
* GPR15 = ADDRESS REGISTER FOR BALR 00076000
* GPR3, GPR6, GPR7, GPR8, GPR9, GPR10, GPR11 00077000
* GPR13 = WORK REGS. 00078000
* 00079000
* NOTES - 00080000
* 00081000
* NONE 00082000
* 00083000
* OPERATION - 00084000
* 00085000
* 1. ADVANCE 8 BYTES IN PLIST TO OPTION 00086000
* QUERIED. IF IT IS A FENCE, EXIT. IF IT IS NOT A CMS 00087000
* QUERY, PASS IT UPT TO CP. IF IT IS A CMS QUERY, GO 00088000
* TO THE ROUTINE WHICH WILL FIND OUT THE STATUS OF THE 00089000
* FUNCTION. 00090000
* 00091000
* 2. THE STATUS OF THE QUERIED FUNCTION IS DETERMINED BY 00092000
* THE SETTING OF THE FOLLOWING REFERENCES: 00093000
* 00094000
* ABBREV - 'NOABBREV' FLAG OF OPTFLAGS (IN NUCON. 00095000
* BLIP - 'TIMCHAR', 'TIMCCW' IN EXISECT 00096000
* DOS - 'DOSMODE' FLAG OF DOAFLAGS IN NUCON 00097000
* DOSPART - 'DOSKPART' FIELD IN NUCON 00098000
* FILEDEF - FCB CHAIN 00099000
* DLBL - DOSCB CHAIN 00100000
* IMPCP - 'NOIMPCP' FLAG OF OPTFLAGS IN NUCON 00101000
* IMPEX - 'NOIMPEX' FLAG OF OPTFLAGS IN NUCON 00102000
* LDRTBLS - HIGH ORDER BYTE OF ALDRTBLS IN NUCON 00103000
* MACLIB - AMACLIBL IN NUCON 00104000
* TXTLIB - ATXTLIBS IN NUCON 00105000
* DOSLIB - DOSLIBL IN NUCON 00106000
* RDYMSG - 'NORDYMSG', 'NORDYTIM' FLAGS IN MSGFLAGS 00107000
* IN NUCON 00108000
* REDTYPE - 'REDERRID' FLAG OF MSGFLAGS IN NUCON 00109000
* RELPAGE - 'NOPAGREL' FLAG IN OPTFLAGS IN NUCON 00110000
* SYNONYM - 'NOSTDSYN' FLAG IN OPTFLAGS IN NUCON 00111000
* AND USABRV 00112000
* SEARCH - ACTIVE DISK TABLES 00113000
* SYSNAMES - CURRENT SEGMENT NAMES TABLE 00114000
* OPTION - BYTES 58 AND 59 OF DOS COMM. REGION 00115000
* UPSI - 'UPSI' BYTE IN DOS COMMUNICATION REGION 00116000
* DISK - ACTIVE DISK TABLES 00117000
* INPUT - AINTRTBL IN NUCON 00118000
* OUTPUT - AOUTRTBL IN NUCON 00119000
* PROTECT - 'PRFPOFF' OF PROTFLAG IN NUCON 00120000
* LIBRARY - SEE MACLIB AND TXTLIB OPTIONS 00121000
* DOSLNCNT - INTERROGATE DOS SYSLST LINES/PAGE VALUE 00122000
* 00123000
* 00124000
* 3. OUTPUT THE STATUS. 00125000
* 00126000
* 4. RETURN TO CALLER 00127000
*. 00128000
EJECT 00129000
DMSQRY START 0 ENTER @V305066 00130000
QUERY EQU * @V305066 00131000
ENTRY DMSQRY 00132000
USING *,R12,R4 ADDRESSABILITY FOR EVERYBODY 00133000
LA R4,4095(,R12) SET UP R4 00134000
LA R4,1(,R4) TO CORRECT ADDRESS 00135000
ST R14,SAVE14 SAVE R14 (FOR EVERYBODY) 00136000
USING NUCON,R0 REFERENCE NUCON & CONGEN DSECT 00137000
* 00138000
NI OPTSFLAG,255-(OPTFIFO+OPTSTACK+OPTLIFO) HRC101DS 00138500
LA R2,8(,R1) POINT TO THE QUERY FUNCTION WANTED 00139000
CLI 0(R2),FENCE ANY FUNCTION SPECIFIED HRC101DS 00140020
BE ERROR047 NO, SIGNAL ERROR TO USER HRC101DS 00140040
LA R9,8(,R2) POINT TO WHAT SHOULD BE FENCE HRC101DS 00140060
SPACE , HRC101DS 00140080
QRY100FF EQU * HRC101DS 00140100
CLI 0(R9),FENCE IS THIS THE FENCE ? HRC101DS 00140120
BE QRY100ND YES, ALL DONE HRC101DS 00140140
CLI 0(R9),C'(' BEGIN OF OPTION ? HRC101DS 00140160
BE QRY100OP YES, CHECK THEM OUT HRC101DS 00140180
LA R9,8(,R9) CHECK NEXT TOKEN HRC101DS 00140200
B QRY100FF LOOP AGAIN HRC101DS 00140220
SPACE , HRC101DS 00140240
QRY100OP EQU * HRC101DS 00140260
ST R9,SAVE9 SAVE FOR LATER HRC101DS 00140280
LA R9,8(,R9) CHECK NEXT TOKEN HRC101DS 00140300
SPACE , HRC101DS 00140320
QRY100FO EQU * HRC101DS 00140340
CLC 0(8,R9),=CL8'FIFO' HRC101DS 00140360
BE QRY100FI YES, SET FLAG AND CONTINUE HRC101DS 00140380
CLC 0(8,R9),=CL8'LIFO' HRC101DS 00140400
BE QRY100LI YES, SET FLAG AND CONTINUE HRC101DS 00140420
CLC 0(8,R9),=CL8'STACK' HRC101DS 00140440
BNE ERROR003 HRC101DS 00140460
SPACE , HRC101DS 00140480
QRY100FN EQU * HRC101DS 00140500
TM OPTSFLAG,OPTSTACK HAVE WE BEEN HERE BEFORE? HRC101DS 00140520
BO ERROR070 YES, INDICATE ERROR HRC101DS 00140540
OI OPTSFLAG,OPTSTACK+OPTFIFO HRC101DS 00140560
SPACE , HRC101DS 00140580
QRY100FX EQU * HRC101DS 00140600
LA R9,8(,R9) HRC101DS 00140620
CLI 0(R9),FENCE END OF OPTION HRC101DS 00140640
BE QRY100SF DEFAULT TO FIFO HRC101DS 00140660
CLI 0(R9),C')' END OF OPTION HRC101DS 00140680
BNE QRY100FO NO, CHECK FOR LIFO/FIFO HRC101DS 00140700
CLI 8(R9),FENCE FENCE ? HRC101DS 00140720
BNE ERROR070 ERROR 70 HRC101DS 00140740
SPACE , HRC101DS 00140760
QRY100SF EQU * HRC101DS 00140780
L R9,SAVE9 RESTORE R9 HRC101DS 00140800
MVI 0(R9),FENCE SET NEW FENCE HRC101DS 00140820
B QRY100ND CONTINUE HRC101DS 00140840
SPACE , HRC101DS 00140860
QRY100FI EQU * HRC101DS 00140880
OI OPTSFLAG,OPTSTACK+OPTFIFO HRC101DS 00140900
B QRY100FX HRC101DS 00140920
SPACE , HRC101DS 00140940
QRY100LI EQU * HRC101DS 00140960
OI OPTSFLAG,OPTSTACK+OPTLIFO HRC101DS 00140980
B QRY100FX HRC101DS 00141000
SPACE , HRC101DS 00141020
QRY100ND EQU * HRC101DS 00141040
LA R7,FIRSTCOM POINT TO FIRST COMMAND 00142000
LA R8,12 12 BYTES APIECE, PLEASE 00143000
LA R9,AFTRLAST POINT TO LAST COMMAND 00144000
LA R3,11 BASIC 11 CHAR OUTPUT MSG FOR MOST OPTIONS 00145000
LA R5,SR1515 AFTER TYPE OUT, EXIT 00146000
ST R5,NEXTLIB RESET NEXTLIB JUST IN CASE @V305001 00147000
MVC QSTATUS,QSTATUS-1 INITIALIZE THE STATUS FIELD 00148000
FINDCOM CLC 0(8,R2),0(R7) DOES THE FLAVOR MATCH ? 00149000
BE QRY100 SEE IF ANY EXTRA PARMS. 00150000
BXLE R7,R8,FINDCOM HOPEFULLY FIND THE COMMAND. 00151000
* 00152000
CPFUNC EQU * 00153000
TM OPTFLAGS,NOIMPCP HAS IMPCP BEEN TURNED OFF 00154000
BO ERROR014 YES, DON'T RECOGNIZE FUNCTION 00155000
TM OPTSFLAG,OPTSTACK DO WE STACK THE CP COMMANDS HRC101DS 00155300
BO CPQUERY yes, continue HRC101DS 00155600
LA R15,3 SET RETURN CODE FOR INT TO CALL @VA02653 00156000
* CP 00157000
LNR R15,R15 AND MAKE IT NEG (MAKE BELIEVE @VA02653 00158000
* ITS COULDNOT FIND) 00159000
OI MISFLAGS,NEGITS SET FLAG FOR DMSINT @V305132 00160000
B EXIT @VA02653 00161000
SPACE 2 00163000
QRY100 EQU * SEE IF ANY EXTRA PARMS. SPECIFIED 00164000
LA R9,8(,R2) POINT TO WHAT SHOULD BE FENCE HRC101DS 00165490
CLC CSYNONYM,0(R7) IS THIS THE SYNONYM FUNCTION 00166000
BE QRY110 YES, SEE IF PARM. ENTERED 00167000
CLC CDLBL,0(R7) DLBL LIST REQUEST? @VA05247 00170000
BE 8(,R7) YES, SPECIAL HANDLING @VA05247 00171000
CLC CDISK,0(R7) DISK FUNCTION HRC003DS 00171300
BE 8(,R7) YES, SPECIAL HANDLING HRC003DS 00171600
CLI 0(R9),FENCE IS A FENCE THERE ? HRC101DS 00172590
BNE ERROR070 NO, UNEXPECTED PARAMETER HRC101DS 00173180
B 8(,R7) YES, BRANCH TO ROUTINE FOR EXEC. 00174000
SPACE 00175000
QRY110 EQU * SEE IF POSITIONAL PARAMETER ENTERED 00176000
CLI 0(R9),X'FF' FENCE ? 00177000
BE ERROR005 FUNCTION PARAMETER NOT SPEC. P0705 00178000
LA R9,8(,R9) POINT TO WHAT SHOULD BE FENCE 00179000
CLI 0(R9),X'FF' FENCE ? 00180000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00181000
B 8(,R7) YES, PUT OUT THE STATUS 00182000
EJECT 00183000
FIRSTCOM DS 0F PRECEDES FIRST SET FLAVOR: 00184000
* 00185000
CCMSLEVL DC CL8'CMSLEVEL' CMSLEVEL HRC001DS 00186390
B CMSLEVEL HRC001DS 00186780
CABBREV DC CL8'ABBREV' ABBREV HRC001DS 00187170
B ABBREV HRC001DS 00187560
CABEND DC CL8'ABEND' ABEND HRC009DS 00187660
B ABEND HRC009DS 00187760
CBLIP DC CL8'BLIP' BLIP 00188000
B BLIP 00189000
CDISK DC CL8'DISK' DISK 00190000
B DISK 00191000
CFILEDEF DC CL8'FILEDEF' FILEDEF 00192000
B FILEDEF 00193000
CIMPCP DC CL8'IMPCP' IMPCP 00194000
B IMPCP 00195000
CIMPEX DC CL8'IMPEX' IMPEX 00196000
B IMPEX 00197000
CINPUT DC CL8'INPUT' INPUT 00198000
B INPUT 00199000
CLDRTBLS DC CL8'LDRTBLS' LDRTBLS 00200000
B LDRTBLS 00201000
CLIBRARY DC CL8'LIBRARY' LIBRARY 00202000
B LIBRARY 00203000
CMACLIB DC CL8'MACLIB' MACLIB 00204000
B MACLIB 00205000
COUTPUT DC CL8'OUTPUT' OUTPUT 00206000
B OUTPUT 00207000
CPROTECT DC CL8'PROTECT' PROTECT 00208000
B PROTECT 00209000
CRDYMSG DC CL8'RDYMSG' RDYMSG 00210000
B RDYMSG 00211000
CREDTYPE DC CL8'REDTYPE' REDTYPE 00212000
B REDTYPE 00213000
CRELPAGE DC CL8'RELPAGE' RELPAG 00214000
B RELPAGE 00215000
CSEARCH DC CL8'SEARCH' SEARCH 00216000
B SEARCH 00217000
CSYNONYM DC CL8'SYNONYM' SYNONYM 00218000
B SYNONYM 00219000
CSYSNAME DC CL8'SYSNAMES' SYSNAMES @V305614 00220000
B QRYSYSN @V305614 00221000
CTXTLIB DC CL8'TXTLIB' TXTLIB 00222000
B TXTLIB 00223000
CDOSLIB DC CL8'DOSLIB' DOSLIB @V305001 00224000
B DOSLIB @V305001 00225000
CDOS DC CL8'DOS' DOS @V305001 00226000
B DOS @V305001 00227000
CDOSPART DC CL8'DOSPART' DOSPART @VA04299 00228000
B DOSPART @VA04299 00229000
COPTION DC CL8'OPTION' OPTION @V305001 00230000
B OPTION @V305001 00231000
CLINECT DC CL8'DOSLNCNT' @V505098 00232000
B LINECT @V505098 00233000
CUPSI DC CL8'UPSI' UPSI @V305001 00234000
B UPSIBYTE @V505098 00235000
CDLBL DC CL8'DLBL' DLBL @VA04310 00236000
B DLBL @VA04310 00237000
AFTRLAST EQU *-12 POINTS TO LAST QUERY FUNCTION 00238000
EJECT 00239000
* 00240000
* DISK. IF 'DISK *' , TYPE OUT ALL INFORMATION ON ALL DISKS LOGGED 00241000
* IN. IF 'DISK MAX' , TYPE OUT ALL INFORMATION ON THE R/W DISK HRC003DS 00242190
* LOGGED IN WITH THE MOST SPACE AVAILABLE. IF 'DISK R/W', TYPE HRC003DS 00242380
* OUT ALL INFORMATION ON ALL THE R/W DISKS LOGGED IN. ELSE HRC003DS 00242570
* TYPE OUT ALL INFORMATION ON THE SPECIFIED DISK. HRC003DS 00242760
* 00243000
DISK EQU * 00244000
L R8,AFVS FILE SYSTEM INFORMATION 00245000
USING FVSECT,R8 ... 00246000
* 00247000
SR R3,R3 INDICATE NO SUCCESS YET, 00248000
STC R3,FRSTFLAG SHOW FIRST TIME TRUE HRC003DS 00248500
SH R1,=H'8' BACK OFF 8 BYTES SO MODE WILL BE 24(R1) 00249000
CLI 8(R2),FENCE DISK USER ENTER "QUERY DISK" ? HRC101DS 00249140
BE DISK20 YES, TREAT AS "QUERY DISK *" HRC003DS 00249200
CLC STRRW,8(R2) WAS "Q DISK R/W" REQUESTED ? HRC003DS 00249300
BE DISK19 YES, CONTINUE HRC003DS 00249400
CLC STRMAX,8(R2) WAS "Q DISK MAX" REQUESTED ? HRC003DS 00249500
BE DISK1 YES, CONTINUE HRC003DS 00249600
CLC =C'* ',8(R2) WAS '*' SPECIFIED HRC003DS 00249700
BE DISK20 YES, PUT STATUS OF ALL DISKS HRC003DS 00249800
L R15,VCADTLKP LOOK UP DISK, HRC003DS 00249900
LA R7,DSKTBL POINT TO BEGINNING OF SYM. NAMES 00250000
LA R8,2 CHECK 2 CHARACTERS 00251000
LA R9,ENDTBL POINT TO END OF TABLE 00252000
VALMODE EQU * SEE IF VALID MODE LETTER ENTERED 00253000
CLC 0(2,R7),8(R2) IS THIS THE MODE ? 00254000
BE DISK10 YES, PUT OUT IT'S STATUS 00255000
BXLE R7,R8,VALMODE NO, CHECK THE NEXT ONE 00256000
B ERROR026 DON'T KNOW MODE 00259000
DISK1 EQU * PUT OUT STATUS OF DISK HRC003DS 00260390
LA R1,STRQMRK-24 HRC003DS 00260780
L R15,VCADTLKW SEARCH R/W DISK HRC003DS 00261170
DISK10 EQU * PUT OUT STATUS OF DISK HRC003DS 00261560
BALR R14,R15 ... 00262000
BNZ NOTFOUND BNZ IF NOT FOUND. 00263000
BAL R14,PTSUB IF FOUND BY ACTLKP, THAT'S IT. 00264000
B SR1515 RESTORE R14, AND EXIT. 00265000
DISK19 EQU * PUT OUT STATUS OF ALL R/W DISKS HRC003DS 00266190
OI FRSTFLAG,QRWDSK SEARCH ONLY R/W DISKS HRC003DS 00266380
DISK20 EQU * PUT OUT STATUS OF ALL DISKS HRC003DS 00266570
SR R0,R0 START WITH 0 THE FIRST TIME 00267000
LOOKUP LR R1,R0 INITIALIZE R1 AND 00268000
L R15,VCADTNXT LOOK ONE UP, @VM03093 00269000
BALR R14,R15 ... 00270000
BNZ GIVMSG1 NONE LEFT, CONTINUE HRC003DS 00271290
* BCR 7,R5 NONE LEFT, RETURN TO CALLER HRC003DS 00271580
LR R0,R1 REMEMBER R1 FOR NEXT TIME, 00272000
USING ADTSECT,R1 REFERENCE ACTIVE-DISK-TABLE, 00273000
TM ADTFLG1,ADTFRO+ADTFRW ANYTHING THERE AT ALL ? 00274000
BNZ GIVMSG YES..GO SCAN ADT @V201101 00275000
TM ADTFLG2,ADTFROS IS IT AN O/S DISK ? @V201101 00276000
BZ LOOKUP NO..KEEP LOOKING @V201101 00277000
GIVMSG BAL R14,PTSUB GIVE MESSAGE IF CONDITIONS RIGHT 00278000
B LOOKUP AND KEEP LOOKING. 00279000
GIVMSG1 EQU * HRC003DS 00279200
TM FRSTFLAG,FRSTTIME DID WE TYPE ANY ?? HRC003DS 00279400
BOR R5 YES, RETURN TO CALLER HRC003DS 00279600
B ERROR006 HRC003DS 00279800
DROP R1 00280000
EJECT 00281000
* 00282000
* SEARCH. DISPLAY THE SEARCH ORDER CURRENTLY IN EFFECT 00283000
* 00284000
SEARCH EQU * 00285000
USING ADTSECT,R1 00286000
SR R0,R0 ZERO R0 00287000
LOOKUP2 EQU * 00288000
LR R1,R0 FIND FIRST OR NEXT DISK ACCESSED 00289000
L R15,VCADTNXT TO GET ADT INFORMATION @VM03093 00290000
BALR R14,R15 GET FIRST (OR NEXT) DISK IN ORDER 00291000
BCR 7,R5 IF NO MORE, RETURN TO CALLER 00292000
LR R0,R1 SAVE FOR NEXT ADTLOOKUP 00293000
TM ADTFLG1,ADTFRO+ADTFRW ANYTHING THERE ? 00294000
BNZ PSHORT YES..START WITH DEVICE ADDR @V201101 00295000
TM ADTFLG2,ADTFROS IS IT O/S DISK ? @V201101 00296000
BZ LOOKUP2 NO, KEEP LOOKING @V201101 00297000
PSHORT L R3,ADTDTA REFERENCE DEVICE-ADDRESS, 00298000
UNPK DECDEC(5),DTAD(3,R3) CONVERT TO HEX 00299000
TR DECDEC(4),HEXTBL-C'0' ... 00300000
MVC SHORT1(3),DECDEC+1 STORE JS 00301000
MVC SHORTMSG(6),ADTID MOVE DISK-LABEL TO MESSAGE JS 00302000
MVC SHORT2(1),ADTM MODE-LETTER TO TYPEOUT 00303000
MVC SHORT2+1(2),SHORT3 NEXT TWO CHARS. DEFAULT TO BLANK 00304000
MVI SHORTCNT,SHORTRO SET FOR LENGTH OF WHOLE MESSAGE 00305000
MVC SHORT3+2(L'RO),RO MOVE'R/O' TO MSG 00306000
CLI ADTMX,C' ' ANY EXTENSION-MODE-LETTER THERE ? 00307000
BNE PSHORT2 TRF IF YES. 00308000
TM ADTFLG1,ADTFRO IF NOT, IS DISK READ-ONLY ? 00309000
BO PSHORT1 TYPE OUT THE MESSAGE 00310000
MVC SHORT3+2(L'RW),RW SET 'R/W' IN MSG 00311000
PSHORT1 TM ADTFLG2,ADTFROS IS IT OS/DOS DISK ? @V305101 00312000
BZ PSHORT1B NO, TYPE OUT SEARCH MESSAGE @V305101 00313000
MVI SHORTCNT,SHORTOS SET NEW MESSAGE LENGTH @V305101 00314000
MVC OSMSG+3(L'OSL),OSL INITIALIZE AS O/S DISK @V305101 00315000
MVC SHORT3+2(L'RO),RO SET 'R/O' IN MESSAGE @V305101 00316000
TM ADTFLG2,ADTFDOS IS IT DOS DISK ? @V305101 00317000
BZ PSHORT1A NO, CHECK IF R/W @V305101 00318000
MVC OSMSG+3(L'DOSL),DOSL SET DOS DISK LITERAL @V305101 00319000
PSHORT1A TM ADTFLG3,ADTFRWOS IS DOS/OS DISK R/W ? @V305101 00320000
BZ PSHORT1B NO, TYPE OUT THE MESSAGE @V305101 00321000
MVC SHORT3+2(L'RW),RW SET 'R/W' IN MESSAGE @V305101 00322000
SPACE , HRC101DS 00323190
PSHORT1B EQU * HRC101DS 00323380
LA R1,SHORTMSG GIVE SHORT 'Q SEARCH' MSG HRC101DS 00323570
SR R3,R3 CLEAR R3 HRC101DS 00323760
IC R3,SHORTCNT GET LENGTH HRC101DS 00323950
LR R10,R5 SAVE R5 ACROSS CALL HRC101DS 00324140
BAL R5,TYPEOUT SEND OUT MESSAGE HRC101DS 00324330
LR R5,R10 RESTORE R5 HRC101DS 00324520
B LOOKUP2 AND GO LOOK UP MORE DISKS. 00325000
* 00326000
PSHORT2 CLC ADTM(1),ADTMX IS DISK EXTENSION OF ITSELF ? 00327000
BE PSHORT1 TRF IF YES. 00328000
MVI SHORT2+1,C'/' PLACE EXTENSION MARKER IN MSG 00329000
MVC SHORT2+2(1),ADTMX FOLLOWED BY EXTENSION-MODE-LETTER 00330000
B PSHORT1 AND GO TYPE THE SHORT-MESSAGE. 00331000
* 00332000
DROP R1 00333000
EJECT 00334000
* SUBROUTINE TO FILL IN INFORMATION IN 'PT-MESSAGE' 00335000
* R1 = ADDRESS OF APPROPRIATE ACTIVE-DISK-TABLE 00336000
* R14 = RETURN-REGISTER 00337000
* R9 THRU R11 AND R15 MAY BE USED FOR 'SCRATCH' 00338000
* 00339000
PTSUB LR R6,R1 ACCESS ACTIVE-DISK-TABLE INFO., 00340000
USING ADTSECT,R6 ... 00341000
TM FRSTFLAG,QRWDSK R/W WANTED ? HRC003DS 00342390
BZ PTSUB0 HRC003DS 00342780
TM ADTFLG1,ADTFRO R/O DISK ? HRC003DS 00343170
BOR R14 YES, RETURN TO CALLER HRC003DS 00343560
TM ADTFLG2,ADTFROS+ADTFDOS OS TO DOS DISK? HRC003DS 00343950
BNZR R14 YES, RETURN TO CALLER HRC003DS 00344340
PTSUB0 EQU * HRC003DS 00344730
L R7,ADTCYL GET NUMBER OF CYLINDERS, HRC003DS 00345120
LTR R7,R7 MAKE SURE IT IS NOT ZERO HRC003DS 00345510
BNP NOTFOUND HRC003DS 00345900
TM FRSTFLAG,FRSTTIME IS THIS FIRST TIME HERE? HRC003DS 00346290
BO PTSUB1 BR IF NOT FIRST. HRC003DS 00346680
LA R1,DTITLE GIVE TYPEOUT, HRC101DS 00347160
LA R3,L'DTITLE LENGTH HRC101DS 00347250
LR R10,R5 SAVE ACROSS CALL HRC101DS 00347340
BAL R5,TYPEOUT HRC101DS 00347430
LR R5,R10 SAVE ACROSS CALL HRC101DS 00347520
OI FRSTFLAG,FRSTTIME SHOW THAT WE HAVE BEEN HERE HRC003DS 00347850
PTSUB1 EQU * HRC003DS 00348240
MVI PTMSG,BLANK HRC003DS 00348630
MVC PTMSG+1(LPTMSG-1),PTMSG CLEAR LINE HRC003DS 00349020
MVC PTLABEL,ADTID VOLID HRC003DS 00349410
L R10,ADTDTA POINT TO ACTUAL-DEVICE-ADDRESS, HRC003DS 00349800
UNPK DECDEC(5),DTAD(3,R10) CONVERT P-DISK OR T-DISKHRC003DS 00350190
TR DECDEC(4),HEXTBL-C'0' TO PRINTABLE HEX HRC003DS 00350580
MVC PTUNIT(3),DECDEC+1 AND STORE IN THE MESSAGEHRC003DS 00350970
MVC PTMODE,ADTM MOVE MODE TO MESSAGE, HRC003DS 00351360
CLI ADTMX,BLANK ANY EXTENSION HRC003DS 00351750
BE PTSUB2 NO, CONTINUE HRC003DS 00352140
MVI PTSLASH,C'/' ELSE, PUT SEPERATOR HRC003DS 00352530
MVC PTMODEX,ADTMX AND EXTENSION MODE IN MESSAGE HRC003DS 00352920
PTSUB2 EQU * HRC003DS 00353310
MVC PTTYPE,=C'3330' MOVE CHARACTERS TO MESSAGE HRC003DS 00353700
CLI DTADT(R10),T3330 IS IT A 3330 ? @V304498 00357000
BE OK1 CONTINUE HRC003DS 00358790
MVC PTTYPE,=C'3350' MOVE CHARACTERS TO MESSAGE HRC003DS 00359580
CLI DTADT(R10),T3350 3350 ? HRC003DS 00360370
BE OK1 CONTINUE HRC003DS 00361160
MVC PTTYPE,=C'3380' MOVE CHARACTERS TO MESSAGE HRC003DS 00361950
CLI DTADT(R10),T3380 3380 ? HRC003DS 00362740
BE OK1 CONTINUE HRC003DS 00363530
MVC PTTYPE,=C'3340' MOVE CHARACTERS TO MESSAGE HRC003DS 00364320
CLI DTADT(R10),T3340 3340 ? @V304498 00366000
BE OK1 CONTINUE HRC003DS 00368990
CLI DTADT(R10),T2314 IS DISK A 2314 ? @V304498 00371000
BNE NOTFOUND NO, DISK NOT LOGGED IN @V304498 00372000
MVC PTTYPE,=C'2314' MOVE CHARACTERS TO MESSAGE HRC003DS 00373190
OK1 EQU * HRC003DS 00373380
L R7,ADTCYL GET NUMBER OF CYLINDERS, HRC003DS 00373570
CVD R7,DEC NUMCYLP OR NUMCYLT TO DECIMAL HRC003DS 00373760
MVC PTCYL,=X'402020202120' HRC003DS 00373950
ED PTCYL,DEC+5 HRC003DS 00374140
MVC PTSTAT,=C'R/W' FILL IN MESSAGE HRC003DS 00374330
TM ADTFLG1,ADTFRW IS IT READ-WRITE ? HRC003DS 00374520
BO OK2 BO IF YES (TYPEOUT OK AS IS). 00375000
MVI PTSTAT+2,C'O' IF NOT MAKE IT "R/O" THEN HRC003DS 00376490
OK2 TM ADTFLG2,ADTFROS IS IT AN O/S DISK ? @V201101 00377000
BO CLRZEROS YES..SKIP NEXT @V201101 00378000
LM R9,R11,ADTNUM R9=ADTNUM,R10=ADTUSED,R11=ADTLEFT 00387000
CVD R9,DEC NUMTRKS TO DECIMAL HRC003DS 00389990
MVC PTBLKTOT,=X'402020202020202020202120' HRC003DS 00391980
ED PTBLKTOT,DEC+2 MAKE IT DISPLAYABLE HRC003DS 00393970
LTR R11,R11 CHECK 'NUMBER LEFT' 00396000
BP R11OK MUST BE OK IF > 0 (HOPEFULLY) 00397000
LR R11,R9 IF NOT, COMPUTE IT FROM SCRATCH 00398000
SR R11,R10 NOW WE HAVE IT. 00399000
R11OK CVD R11,DEC CONVERT TO DECIMAL 00400000
MVC PTBLKFRE,=X'402020202020202020202120' HRC003DS 00401990
ED PTBLKFRE,DEC+2 MAKE IT DISPLAYABLE HRC003DS 00402980
* NOW COMPUTE PERCENTAGE OF TRACKS IN USE 00404000
LR R11,R10 NUMBER TRACKS IN USE INTO R11 FOR 'M' 00405000
M R10,=F'1000' MULTIPLY R11 BY 1000 FOR ROUNDED, 00406000
DR R10,R9 DIVIDE NO. TRACKS BY TOTAL NO. 00407000
A R11,=F'5' ADD 5 TO ROUND QUOTIENT 00408000
C R11,=F'1000' MAKE SURE 99. OR LESS 00409000
BL OK99 OK IF NOT MORE THAN 99 00410000
L R11,=F'990' MAKE IT 99. IF WAS MORE 00411000
OK99 CVD R11,DEC CONVERT TO DECIMAL 00412000
MVC PTPCTUSD,=X'F02120' HRC003DS 00413490
ED PTPCTUSD,DEC+6 HRC003DS 00413980
MVI PTPCTUSD,C'-' HRC003DS 00414470
L R10,ADTUSED HRC003DS 00414960
CVD R10,DEC NUMBER OF RECORDS IN USE... HRC003DS 00415450
MVC PTBLKUSD,=X'402020202020202020202120' HRC003DS 00415940
ED PTBLKUSD,DEC+2 MAKE IT DISPLAYABLE HRC003DS 00416430
L R7,ADTFSTC NUMBER OF FILES, HRC003DS 00416920
CVD R7,DEC HRC003DS 00417410
MVC PTFILES,=X'402020202020202020202120' HRC003DS 00417900
ED PTFILES,DEC+2 READABLE HRC003DS 00418390
MVC PTBLKS,=C' 800' CDF DISK SIZE HRC003DS 00418880
CLRZEROS EQU * HRC003DS 00419370
TM ADTFLG2,ADTFROS IS IT AN O/S DISK ? @V201101 00420000
BO OSLINE YES..DON'T CHECK ANYMORE @V201101 00421000
LINEDONE EQU * HRC003DS 00430990
LA R1,PTMSG MESSAGE TO PRINT HRC101DS 00441490
LA R3,LPTMSG MESSAGE LENGTH HRC101DS 00441980
LR R10,R5 SAVE ACROSS CALL HRC101DS 00442470
BAL R5,TYPEOUT GIVE TYPEOUT, HRC101DS 00442960
LR R5,R10 RESTORE IT NOW HRC101DS 00443450
BR R14 AND RETURN TO MAIN PART. 00444000
* 00445000
SPACE 00453000
OSLINE TM ADTFLG3,ADTFRWOS IS DISK R/W ? @V305101 00454000
BZ OSLINE2 NO, COMPRSS DISK LINE @V305101 00455000
MVI PTSTAT+2,C'W' SET MSG FOR R/W DISK HRC003DS 00456990
OSLINE2 EQU * HRC003DS 00457980
MVC PTFILES+5(2),=C'OS' HRC003DS 00458970
TM ADTFLG2,ADTFDOS IS IT DOS DISK ? @V305101 00463000
BZ LINEDONE NO, RETURN HRC003DS 00464990
MVI PTFILES+4,C'D' SET AS DOS DISK HRC003DS 00465980
B LINEDONE RETURN HRC003DS 00466970
EJECT , HRC009DS 00467050
* HRC009DS 00467130
* ABEND. TYPE OUT THE COMMAND NAME TO EXECUTE UPON ABEND. HRC009DS 00467210
* HRC009DS 00467290
ABEND EQU * HRC009DS 00467370
MVC QOPT,CABEND OPTION QUERIED HRC009DS 00467450
L R7,ABNCOMND R6=A(USER ABEND COMMAND) HRC009DS 00467530
LTR R7,R7 DOES ONE EXIST ? HRC009DS 00467610
BNZ ABEND1 YES, FIND OUT WHAT IT IS HRC009DS 00467690
MVC QSTATUS(4),NONE INDICATE NONE SET HRC009DS 00467770
LA R3,4(,R3) 4 CHARACTERS ADDED TO TYPEOUT LINHRC009DS 00467850
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00467960
ABEND1 EQU * HRC009DS 00468010
SR R6,R6 CLEAR FOR LENGTH HRC009DS 00468090
IC R6,0(R7) GET LENGTH OF ABEND COMMAND HRC009DS 00468170
BCTR R6,0 LESS ONE FOR EXECUTE HRC009DS 00468250
EX R6,MOVABN COMMAND LINE TO BUFFER HRC009DS 00468330
LA R3,1(R3,R6) ADD LEN OF STD QUERY RESPONSE HRC009DS 00468410
STH R3,QMSGL HRC009DS 00468490
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00468640
SPACE , HRC009DS 00468730
MOVABN MVC QSTATUS(0),1(R7) ABEND COMMAND TO BUFFER HRC009DS 00468810
EJECT 00469000
* 00470000
* ABBREV. IF ABBREV IS ON TYPE OUT THE ABBREVIATIONS IN EFFECT. 00471000
* 00472000
ABBREV EQU * 00473000
MVC QOPT,CABBREV OPTION QUERIED 00474000
TM OPTFLAGS,NOABBREV ABBREV=OFF? 00475000
BO OPTOFF YES, ABBREV=OFF 00476000
B OPTON NO, ABBREV=ON 00477000
SPACE 2 00478000
* 00479000
* BLIP. IF BLIP=ON, TYPE OUT THE BLIP CHARACTER. 00480000
* 00481000
BLIP EQU * 00482000
L R9,AEXTSECT A(INTERRUPT INFORMATION) 00483000
USING EXTSECT,R9 00484000
MVC QOPT,CBLIP OPTION QUERIED 00485000
CLI TIMCHAR,X'00' IS BLIP OFF? 00486000
BE OPTOFF YES, MESSAGE: BLIP=OFF 00487000
SR R6,R6 ZERO R6 00488000
IC R6,TIMCCW+7 R6=L'(BLIP CHARACTER) 00489000
AR R3,R6 ADD THE NUMBER OF BLIP CHARACTERS 00490000
BCTR R6,0 DECREMENT LENGTH BY 1 FOR MVC INST. 00491000
EX R6,MVC MOVE THE BLIP CHARACTER INTO THE MESSAGE 00492000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00493490
EJECT 00494000
* 00495000
* UPSI. DISPLAY THE USER DEFINED UPSI BYTE IN THE COMM. REGION 00496000
* 00497000
SPACE 1 00498000
UPSIBYTE TM DOSFLAGS,DOSMODE CMS/DOS MODE ACTIVE ? @V505098 00499000
BZ ERROR099 NO, ERROR @V305001 00500000
MVC QOPT,CUPSI SET FUNCTION NAME @V305001 00501000
SR R10,R10 CLEAR WORK @V305001 00502000
L R1,ASYSREF GET COMM. REGION ADDR. @V305001 00503000
SR R6,R6 CLEAR @V305001 00504000
IC R6,23(R1) GET UPSI BYTE @V305001 00505000
LA R7,ARGLEN LENGTH OF ARGUMENT @V305066 00506000
UPSILUP LA R8,QSTATUS-1 POINT TO BUFFER @V305001 00507000
STC R6,DEC SAVE BYTE IN WORK @V305001 00508000
NI DEC,HEX01 ISOLATE PROPER BIT @V305066 00509000
IC R10,DEC GET UPDATED VALUE @V305001 00510000
CVD R10,DEC CONVERT TO DECIMAL @V305001 00511000
AR R8,R7 POINT TO PROPER PLACE @V305001 00512000
UNPK 0(1,R8),DEC UNPACK VALUE TO BUFFER @V305001 00513000
OI 0(R8),ZONE SET DIGIT ZONE @V305066 00514000
SRL R6,1 UPDATE UPSI BYTE @V305001 00515000
BCT R7,UPSILUP LOOP 'TILL UPSI DONE @V305001 00516000
LA R3,8(,R3) UPDATE BUFFER LENGTH @V305001 00517000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00518490
EJECT 00519000
* 00520000
* OPTION. DISPLAY THE CMS/DOS NON-STD. OPTIONS IN COMM. REGION 00521000
* 00522000
SPACE 1 00523000
OPTION TM DOSFLAGS,DOSMODE CMS/DOS MODE ACTIVE ? @V305001 00524000
BZ ERROR099 NO, ERROR @V305001 00525000
MVC QOPT,COPTION SET FUNCTION NAME @V305001 00526000
SR R10,R10 CLEAR WORK @V305001 00527000
L R1,ASYSREF GET COMM. REGION ADDRESS @V305001 00528000
LA R6,OPTTAB POINT TO OPTIONS TABLE @V305001 00529000
LA R7,LOPTTAB GET TABLE LENGTH @V305001 00530000
LA R8,QSTATUS POINT TO OUTPUT BUFFER @V305001 00531000
OPTLUP MVC 0(2,R8),=C'NO' INITIALIZE TO 'NO' @V305001 00532000
IC R10,0(R6) GET MASK TO TEST OPTION BYTE @V305001 00533000
EX R10,EXTM SEE IF OPTION 'ON' @V305001 00534000
BO OPTYES BRANCH IF OPTION ACTIVE @V305001 00535000
LA R3,2(,R3) INCLUDE 'NO' IN LENGTH @V305001 00536000
LA R8,2(,R8) BUMP PAST 'NO' IN BUFFER @V305001 00537000
OPTYES MVC 0(6,R8),2(R6) MOVE OPTION TO BUFFER @V305001 00538000
IC R10,1(R6) GET OPTION LENGTH @V305001 00539000
LA R3,0(R10,R3) COMPUTE LAST LENGTH @V305001 00540000
LA R8,0(R10,R8) BUMP TO NEXT POSITION @V305001 00541000
LA R6,8(,R6) BUMP TO NEXT OPTION @V305001 00542000
BCT R7,OPTLUP KEEP LOOKING... @V305001 00543000
MVC 0(4,R8),=CL4'48C' SET CHARSET 48 @V305001 00544000
TM 58(R1),CHAR48C 48C SPECIFIED ? @V305066 00545000
BO OPTLAST YES, CHECK LAST OPTION @V305001 00546000
MVC 0(4,R8),=CL4'60C' SET CHARSET 60 @V305001 00547000
OPTLAST LA R3,4(,R3) LAST BUFFER LENGTH @V305001 00548000
LA R8,4(,R8) BUMP TO NEXT POSITION @V305001 00549000
MVC 0(2,R8),=C'NO' INITIALIZE BUFFER @V305001 00550000
TM 59(R1),DUMP DUMP OPTION IN EFFECT ? @V305066 00551000
BO OPTDONE YES, BRANCH @V305001 00552000
LA R8,2(,R8) BUMP PAST 'NO' @V305001 00553000
OPTDONE MVC 0(5,R8),0(R6) MOVE OPTION TO BUFFER @V305001 00554000
LA R3,8(,R3) FINAL LENGTH @V305001 00555000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00556490
SPACE 1 00557000
EXTM TM 58(R1),ZERO EXECUTED 'TM' @V305066 00558000
* 00559000
OPTTAB EQU * @V305001 00560000
DC X'80',X'05',CL6'DECK' @V305001 00561000
DC X'40',X'05',CL6'LIST' @V305001 00562000
DC X'20',X'06',CL6'LISTX' @V305001 00563000
DC X'10',X'04',CL6'SYM' @V305001 00564000
DC X'08',X'05',CL6'XREF' @V305001 00565000
DC X'04',X'05',CL6'ERRS' @V305001 00566000
LOPTTAB EQU (*-OPTTAB)/8 @V305001 00567000
DC CL5'DUMP' @V305001 00568000
DS 0H @V305001 00569000
EJECT 00570000
* 00571000
* FILEDEF. INDICATE USER FILEDEF'S IN EFFECT. 00572000
* 00573000
FILEDEF EQU * 00574000
LH R8,FCBNUM GET COUNT OF ENTRIES 00575000
LA R10,SEVEN LENGTH OF 'DLBL' @VA04310 00576000
LTR R8,R8 00577000
BC 8,FLDFMSG IF CONDITION=0, TYPEOUT MESSAGE 00578000
L R6,FCBFIRST GET PTR TO 1ST ENTRY 00579000
USING FCBSECT,R6 00580000
LIST1 MVC LISTMES(8),FCBDD PUT DDNAME INTO MESSAGE 00581000
SR R10,R10 ZERO R10 FOR SUBSEQUENT TABLE LOOKUP 00582000
IC R10,FCBDEV GET THE DEVICE 00583000
AR R10,R10 DOUBLE THE COUNT 00584000
LA R7,DUMMY ACCESS THE FIRST DEVICE 00585000
AR R7,R10 POINT TO THE SPECIFIED DEVICE 00586000
MVC LISTMES+9(8),0(R7) MOVE DEV NAME TO MSG 00587000
CLC LISTMES+9(8),TAP IS IT A TAPE DEVICE. 00588000
BNE LIST2 00589000
MVC LISTMES+12(1),FCBTAPID+3 PUT TAP NUMBER INTO MSG 00590000
* CMSTYPE '8 BLANKS' 00591000
LIST2 EQU * 00592000
CLC LISTMES+9(8),DSK IS IT DISK ? 00593000
BNE LIST3 NO 00594000
MVC LISTMES+18(8),FCBDSNAM MOVE IN DSNAME 00595000
MVC LISTMES+27(8),FCBDSTYP MOVE IN DSTYPE 00596000
LA R3,(L'LISTMES+L'LISTDSK) SET UP LENGTH HRC101DS 00597290
SPACE , HRC101DS 00597580
LIST3 EQU * HRC101DS 00597870
LA R1,LISTMES ADDRESS OF DESCRIPTION HRC101DS 00598160
LR R10,R5 SAVE R5 HRC101DS 00598450
BAL R5,TYPEOUT TYPE OUT MESSAGE HRC101DS 00598740
LR R5,R10 restore register 5 HRC324DS 00599030
L R6,0(,R6) GET PTR TO NEXT ENTRY 00600000
LA R3,L'LISTMES RESTORE DEFAULT LENGTH HRC101DS 00601190
MVI LISTMES,C' ' BLANK OUT FIRST CHAR HRC101DS 00601380
MVC LISTMES+1((L'LISTMES)-1),LISTMES CLEAR BUFFER HRC101DS 00601570
BCT R8,LIST1 CONTINUE FOR ALL ENTRIES 00602000
BR R5 ANY MORE QUERY REQUESTS ? 00603000
SPACE 2 00604000
* 00605000
* IMPCP. INDICATE WHETHER IMPCP=ON|OFF 00606000
* 00607000
IMPCP EQU * 00608000
MVC QOPT,CIMPCP OPTION QUERIED 00609000
TM OPTFLAGS,NOIMPCP IMPLIED CP OFF? 00610000
BO OPTOFF YES, IMPCP=OFF 00611000
B OPTON NO, IMPCP=ON 00612000
SPACE 2 00613000
* 00614000
* IMPEX. INDICATE WHETHER IMPEX=ON|OFF 00615000
* 00616000
IMPEX EQU * 00617000
MVC QOPT,CIMPEX OPTION QUERIED 00618000
TM OPTFLAGS,NOIMPEX IMPLIED EXEC OFF? 00619000
BO OPTOFF YES, IMPEX=OFF 00620000
B OPTON NO, IMPEX=ON 00621000
EJECT 00622000
* 00623000
* INPUT. DISPLAY THE USER DEFINED INPUT TRANSLATE TABLE. 00624000
* 00625000
INPUT EQU * 00626000
L R6,AINTRTBL R6=A(USER DEFINED INPUT TRANSLATE TABLE) 00627000
LTR R6,R6 DOES ONE EXIST ? 00628000
BNP INPMSG NO, OUTPUT A MESSAGE 00629000
LA R6,256(,R6) POINT TO 1 FOR 1 TABLE @VA05384 00630000
LA R13,CONVERT0 TRANSFER HERE AFTER OUTPUTTING MESSAGE 00631000
MVC QOPT,CINPUT MOVE NAME OF OPTION QUERIED TO OUTPUT MSG 00632000
LA R2,QSTATUS+2 PLACE FOR CHAR. TRANSLATED TO 00633000
LA R3,15 15 CHARACTERS TO BE TYPE OUT EACH TIME 00634000
STH R3,QMSGL STORE THE LENGTH OF THE MESSAGE 00635000
LA R8,OTRTABLE COMPARE USER - STANDARD TRANSLATE@VA05384 00636000
LA R7,256 LENGTH OF TRANSLATE TABLE 00637000
LA R9,256 LENGTH OF STANDARD TRANSLATE TABLE 00638000
CONVERT0 EQU * COMPARE EACH CHARACTER IN THE TRANSLATE T 00639000
CLCL R6,R8 FIND THE FIRST NON MATCHING CHARACTER 00640000
LTR R7,R7 AT END OF TABLE ? 00641000
BZ SR1515 YES, RETURN TO CALLER 00642000
LH R10,=H'256' DETERMINE PLACE OF NON-MATCHING CHAR. 00643000
SR R10,R7 NOW IN R10 00644000
STC R10,QSTATUS PUT IN OUTPUT MESSAGE 00645000
IC R10,0(,R6) GET THE CHARACTER USED IN THE TRANSLATION 00646000
CONV EQU * 00647000
LA R3,2 CONVERT TO PRINTABLE HEX 00648000
SRDL R10,8 PUT IN THE HIGH ORDER END OF R11 00649000
CONVERT1 EQU * CONVERT 4 BITS TO PRINTABLE HEX 00650000
SLDL R10,4 SLIDE THEM OVER TO LOW END OF R10 00651000
CH R10,=H'9' IS THE CHARACTER A - F 00652000
BNH CONVERT2 NO, IT'S 1 - 9 00653000
SH R10,=H'9' A - F = 1 - 6 RESPECTIVELY 00654000
O R10,PHEX2 OR IN THE UPPER 4 BITS FOR PRINTING 00655000
B CONVERT4 STORE IN THE OUTPUT MESSAGE 00656000
CONVERT2 EQU * CONVERT 1 - 9 TO PRINTABLE HEX 00657000
O R10,PHEX1 OR IN THE UPPER 4 BITS 00658000
CONVERT4 EQU * PUT THE CHARACTER IN THE OUTPUT MESSAGE 00659000
STC R10,0(,R2) AS SPECIFIED BY R2 00660000
LA R2,1(,R2) INCREMENT R2 FOR NEXT HEX CHARACTER 00661000
SR R10,R10 ZERO R10 00662000
BCTR R3,0 SEE IF ANY MORE CHARACTERS TO BE CONVERTE 00663000
LTR R3,R3 NO MORE IF R3 IS ZERO 00664000
BNZ CONVERT1 R3 IS NON-ZERO, DO THE SECOND CHARACTER 00665000
LA R1,QMSG SET UP ENTRY CONDITIONS FOR TYPLIHRC101DS 00666490
LH R3,QMSGL LENGTH OF MESSAGE HRC101DS 00666980
BAL R5,TYPEOUT TYPE OUT THE MESSAGE HRC101DS 00667470
MVC QOPT,BLANKS BLANK OUT THE QUERIED POSITION 00668000
MVC QSTATUS,QSTATUS-1 RE-INITIALIZE THE STATUS FIELD 00669000
LA R6,1(,R6) START COMPARE AT NEXT BYTE 00670000
BCTR R7,0 DECREMENT THE NUMBER COMPARED BY 1 00671000
LA R8,1(,R8) COMPARE AT NEXT BYTE 00672000
BCTR R9,0 DECREMENT THE NUMBER COMPARED BY 1 00673000
SH R2,=H'2' REDUCE R2 TO CORRECT ADDRESS 00674000
BR R13 TRANSFER 00675000
EJECT 00676000
* 00677000
* OUTPUT. DISPLAY THE USER DEFINED OUTPUT TRANSLATE TABLE. 00678000
* 00679000
OUTPUT EQU * 00680000
L R6,AOUTRTBL R6=A(USER DEFINED OUTPUT TRANSLATE TABLE) 00681000
MVC QOPT,COUTPUT MOVE NAME OF THE OPTION QUERIED TO MSG. 00682000
LA R13,OUTPUT10 RETURN HERE AFTER OUTPUTTING MESSAGE 00683000
LA R8,OTRTABLE COMPARE USER TR TABLE TO STANDARD 00684000
LA R3,15 15 CHARACTERS TO BE TYPED OUT EACH TIME 00685000
STH R3,QMSGL STORE THE LENGTH OF THE MESSAGE 00686000
LA R2,QSTATUS PLACE FOR CHAR. TRANSLATED TO 00687000
LTR R6,R6 DOES USER DEFINED OUTPUT TR TABLE EXIST ? 00688000
BNP OUTMSG NO, OUTPUT A MESSAGE 00689000
LA R7,256 LENGTH OF THE TRANSLATE TABLE 00690000
LA R9,256 LENGTH OF THE TRANSLATE TABLES 00691000
OUTPUT10 EQU * COMPARE THE TWO TABLES 00692000
CLCL R6,R8 00693000
LTR R7,R7 ALL THRU ? 00694000
BZ SR1515 YES, RETURN TO CALLER 00695000
IC R10,0(,R6) GET THE TRANSLATION CHARACTER 00696000
STC R10,QSTATUS+3 STORE IN THE OUTPUT MESSAGE 00697000
LH R10,=H'256' DETERMINE LOCATION OF NON-MATCH 00698000
SR R10,R7 00699000
B CONV CONVERT THE LOC. TO PRINTABLE HEX 00700000
EJECT 00701000
* 00702000
* LDRTBLS. INDICATE THE NUMBER OF LDRTBLS. 00703000
* 00704000
LDRTBLS EQU * 00705000
MVC QOPT,CLDRTBLS QUERIED OPTION 00706000
SR R6,R6 ZERO R6 00707000
IC R6,ALDRTBLS GET THE NUMBER OF LOADER TABLES 00708000
* 00709000
* THE FOLLOWING CONVERTS THE NUMBER OF LDRTBLS TO PRINTABLE CHARACTERS 00710000
* 00711000
CVD R6,DEC CONVERT THE NUMBER TO DECIMAL 00712000
UNPK DECDEC,DEC UNPACK IT 00713000
OI DECDEC+7,X'F0' CLEAR THE SIGN FROM THE LAST BYTE 00714000
* 00715000
* 00716000
MVC QSTATUS(3),DECDEC+5 MOVE THE NUMBER INTO THE MSG 00717000
LA R3,3(,R3) 3 CHARACTERS ADDED TO THE OUTPUT MSG 00718000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00719490
SPACE 3 00720000
* 00721000
* DOSPART. INDICATE THE SIZE OF THE DOS PARTITION. 00722000
* 00723000
DOSPART TM DOSFLAGS,DOSMODE CMS/DOS MODE ACTIVE ? @VA04299 00724000
BZ ERROR099 NO, ERROR @VA04299 00725000
MVC QOPT,CDOSPART QUERIED FUNCTION @VA04299 00726000
SR R6,R6 ZERO R6 @VA04299 00727000
ICM R6,3,DOSKPART GET SIZE IN K-BYTES @VA04299 00728000
BZ DOSPART2 IF NONE SPECIFIED, TELL USER. @VA04299 00729000
* 00730000
* THE FOLLOWING CONVERTS THE SIZE OF DOSPART TO PRINTABLE CHARACTERS 00731000
* 00732000
CVD R6,DEC CONVERT THE NUMBER TO DECIMAL @VA04299 00733000
UNPK DECDEC,DEC UNPACK IT @VA04299 00734000
OI DECDEC+7,X'F0' CLEAR THE SIGN FROM LAST BYTE @VA04299 00735000
* 00736000
* 00737000
MVC QSTATUS(5),DECDEC+3 MOVE THE SIZE INTO THE MSG @VA04299 00738000
MVI QSTATUS+5,C'K' MOVE THE CHARACTER 'K' @VA04299 00739000
LA R3,6(,R3) 6 CHARACTERS ADDED TO THE MSG @VA04299 00740000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00741490
SPACE 2 00742000
DOSPART2 MVC QSTATUS(4),NONE MOVE 'NONE' INTO THE MSG @VA04299 00743000
LA R3,4(,R3) 4 CHARACTERS ADDED TO THE MSG @VA04299 00744000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00745490
EJECT 00746000
* 00747000
* LIBRARY. INDICATE THE TEXT AND MACRO LIBRARIES BEING SEARCHED TO 00748000
* RESOLVE REFERENCES. 00749000
* 00750000
LIBRARY EQU * 00751000
LA R5,DOSLIB AFTER TXTLIB, GO TO DOSLIB @V305001 00752000
ST R5,NEXTLIB ... @V305001 00753000
LA R5,TXTLIB AFTER TYPEOUT, RETURN TO TXTLIB 00754000
MACLIB EQU * OUTPUT MACLIB NAMES CURRENTLY IN EFFECT 00755000
MVC QOPT,CMACLIB OPTION QUERIED 00756000
LA R7,MACLIBL A(MACLIB NAMES CURRENTLY IN EFFECT) 00757000
LIBENTRY EQU * CHECK EXISTENCE OF LIBRARY NAMES 00758000
LA R6,QSTATUS MOVE LIBRARY STATUS HERE 00759000
CLI 0(R7),FENCE ARE ANY LIBRARY NAMES IN EFFECT? HRC101DS 00760490
BE TYPENONE NO, INSERT 'NONE' AND TYPEOUT 00761000
LA R8,9 NUMBER OF POSSIBLE LIBRARIES 00762000
NEXTNAME EQU * GET NEXT (OR FIRST) LIBRARY NAME 00763000
MVC 0(8,R6),0(R7) MOVE LIBRARY NAME TO TYPEOUT BUFFER 00764000
MVI 8(R6),C' ' DELIMITER 00765000
LA R3,9(,R3) 9 CHARACTERS MOVED TO TYPEOUT BUFFER 00766000
LA R6,9(,R6) ADVANCE TO NEXT POSITION IN TYPEOUT BUFF. 00767000
LA R7,8(,R7) ADVANCE TO NEXT LIBRARY NAME 00768000
CLI 0(R7),FENCE END OF LIBRARY NAME LIST HRC101DS 00769590
BE TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00770180
BCT R8,NEXTNAME MOVE NEXT NAME TO TYPE OUT LINE 00771000
TXTLIB EQU * OUTPUT TXTLIB NAMES CURRENTLY IN EFFECT 00772000
MVC QSTATUS,QSTATUS-1 BLANK OUT THE STATUS LINE 00773000
L R5,NEXTLIB GET RETURN POINT @V305001 00774000
MVC QOPT,CTXTLIB OPTION QUERIED 00775000
LA R3,ELEVEN RESTORE R3 TO ELEVEN @VA06340 00776000
LA R7,TXTLIBS A(TXTLIB NAMES CURRENTLY IN EFFECT) 00777000
B LIBENTRY MOVE NAMES TO TYPEOUT LINE 00778000
DOSLIB EQU * OUTPUT DOSLIB NAMES IN EFFECT @V305001 00779000
MVC QSTATUS,QSTATUS-1 BLANK OUT STATUS LINE @V305001 00780000
LA R5,SR1515 RETURN TO CALLER AFTER TYPEOUT @V305001 00781000
MVC QOPT,CDOSLIB OPTION QUERIED @V305001 00782000
LA R7,DOSLIBL DOSLIB NAMES CURRENT GLOBALED @V305001 00783000
LA R3,ELEVEN RESTORE R3 TO ELEVEN @VA06340 00784000
B LIBENTRY MOVE NAMES TO TYPEOUT LINE @VA06340 00785000
TYPENONE EQU * NO TXTLIB OR MACLIB ENTRIES 00786000
MVC 0(4,R6),NONE NO LIBRARY NAMES 00787000
LA R3,4(,R3) 4 CHARACTERS ADDED TO TYPEOUT LINE 00788000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00789490
EJECT 00790000
* 00791000
* LINECT. IF DOS ENVIRONMENT ACTIVE, TYPE OUT SYSLST LINES PER 00792000
* PAGE VALUE 00793000
* 00794000
LINECT DS 0H @V505098 00795000
TM DOSFLAGS,DOSMODE IS CMS/DOS ACTIVE?? @V505098 00796000
BZ ERROR099 NO, ERROR @V505098 00797000
CLI 8(R2),FENCE ANY ARGUMENTS SPECIFIED?? HRC101DS 00798490
BNE ERROR070 YES, INVALID PARAMETER @V505098 00799000
MVC QOPT,CLINECT OPTION QUERIED @V505098 00800000
L R10,ABGCOM GET ADDRES OF COMM. REGIO @V505098 00801000
USING BGCOM,R10 SET UP ADDRESSABILITY TO COMM. REG@V505098 00802000
SR R6,R6 CLEAR OUT VALUE REGISTER @V505098 00803000
IC R6,SYSLINE GET DEFAULT SYSLST LINES/PAGE NO. @V505098 00804000
DROP R10 GET RID OF ADDRESSABILITY @V505098 00805000
CVD R6,DEC CONVERT LINES/PAGE VALUE TO DEC. @V505098 00806000
OI DEC+7,15 MAKE SURE SIGN IS A 'F' @V505098 00807000
UNPK QSTATUS(3),DEC(8) UNPACK FOR TRANSLATION @V505098 00808000
LA R3,3(,R3) ADD LINES/PAGE LENGTH TO LENGTH @V505098 00809000
* OF MESSAGE TO BE PRINTED 00810000
B TYPEQMSG GO TYPE OUT THE MESSAGE HRC101DS 00811490
EJECT 00812000
* 00813000
* RDYMSG. INDICATE RDYMSG=LMSG|SMSG|OFF 00814000
* 00815000
RDYMSG EQU * 00816000
MVC QOPT,CRDYMSG OPTION QUERIED 00817000
TM MSGFLAGS,NORDYTIM RDYMSG=SMSG? 00818000
BO RDYSHORT YES 00819000
MVC QSTATUS(4),LMSG RDYMSG=LMSG 00820000
LA R3,4(,R3) 4 CHARACTERS ADDED TO THE OUTPUT MESSAGE 00821000
B TYPEQMSG TYPE OUT THE MESSAGE HRC101DS 00822490
RDYSHORT EQU * 00823000
MVC QSTATUS(4),SMSG RDYMSG=SMSG 00824000
LA R3,4(,R3) 4 CHARACTERS ADDED TO THE OUTPUT MESSAGE 00825000
B TYPEQMSG TYPE OUT THE MESSAGE HRC101DS 00826490
SPACE 2 00827000
* 00828000
* REDTYPE. INDICATE WHETHER REDTYPE=ON|OFF 00829000
* 00830000
REDTYPE EQU * 00831000
MVC QOPT,CREDTYPE OPTION QUERIED 00832000
TM MSGFLAGS,REDERRID REDTYPE ON? 00833000
BO OPTON YES, REDTYPE=ON 00834000
B OPTOFF NO, REDTYPE=OFF 00835000
SPACE 2 00836000
* 00837000
* RELPAGE. INDICATE WHETHER RELPAGE=ON|OFF 00838000
* 00839000
RELPAGE EQU * 00840000
MVC QOPT,CRELPAGE OPTION QUERIED 00841000
TM OPTFLAGS,NOPAGREL PAGE RELEASE OFF? 00842000
BO OPTOFF YES, RELPAGE=OFF 00843000
B OPTON NO, RELPAGE=ON 00844000
EJECT 00845000
* 00846000
* SYNONYM. DISPLAY USER|SYSTEM|ALL SYNONYMS IN EFFECT. 00847000
* 00848000
SYNONYM EQU * 00849000
L R11,AUSABRV GET SYNONYM INFORMATION 00850000
USING ABDSECT,R11 00851000
CLC =C'ALL ',8(R2) ALL SYNONYMS IN EFFECT WANTED DISPLAYED ? 00852000
BNE TSTSYS NO, SEE IF SYSTEM SYNONYMS WANTED 00853000
B SYSSYN DISPLAY SYSTEM SYNONYMS FIRST 00855000
TSTSYS EQU * SEE IF SYSTEM SYNONYMS WANTED 00856000
CLC =C'USER ',8(R2) USER SYSNONYMS ONLY WANTED 00857000
BE USRSYN YES, DISPLAY USER SYNONYMS 00858000
CLC =C'SYSTEM ',8(R2) SYSTEM SYNONYMS WANTED 00859000
BNE ERROR026 NO, TYPE OUT ERROR MESSAGE 00860000
SYSSYN EQU * 00861000
LA R1,ONEIDLE CARRIAGE-RETURN AFTERWARDS HRC101DS 00862490
LA R3,1 LENGTH OF ONE HRC101DS 00862980
BAL R5,TYPEOUT HRC101DS 00863470
TM OPTFLAGS,NOSTDSYN STANDARD SYNOYMS=OFF? 00864000
BO SYNMSG TYPE OUT MESSAGE 00865000
SPACE , HRC101DS 00866490
OKPS EQU * HRC101DS 00866980
LA R1,FIRST FIRST MESSAGE HRC101DS 00867470
LA R3,L'FIRST LENGTH MESSAGE HRC101DS 00867960
BAL R5,TYPEOUT TYPE IT OUT HRC101DS 00868450
LA R1,FIRST1 SECOND MESSAGE HRC101DS 00868940
LA R3,L'FIRST1 LENGTH MESSAGE HRC101DS 00869430
BAL R5,TYPEOUT TYPE IT OUT HRC101DS 00869920
LA R1,FIRST2 THIRD MESSAGE HRC101DS 00870410
LA R3,L'FIRST2 LENGTH MESSAGE HRC101DS 00870900
BAL R5,TYPEOUT TYPE IT OUT HRC101DS 00871390
LA R1,SYSCOM SET UP R1 FOR TYPEOUTS HRC101DS 00871880
SR R6,R6 CLEAR R6 (FOR 'IC' BELOW) 00873000
LM R7,R9,REGTABA PREPARE TO ACCESS SYSTEM ABBREVIATIONS 00874000
* 00875000
SYSLOOP MVC SYSABB,BLANKS BLANK OUT ABBREVIATION 00876000
MVC SYSCOM(8),0(R7) MOVE IN SYSTEM COMMAND 00877000
IC R6,8(,R7) GET COUNT OF SHORTEST 00878000
LR R3,R6 SAVE FOR HRC101DS 00878500
BCTR R6,0 FORM (LESS 1) 00879000
EX R6,DMVC MOVE SHORTEST-FORM TO TYPEOUT, 00880000
LA R1,SYSCOM MESSAGE TO DISPLAY HRC101DS 00881090
LA R3,(L'SYSCOM+L'SYSABB) HRC101DS 00881180
LR R6,R5 SAVE R5 HRC101DS 00881270
BAL R5,TYPEOUT CALL TYPLIN (DELETES TERMINAL BLAHRC101DS 00881360
LR R5,R6 RESTORE R5 HRC101DS 00881450
BXLE R7,R8,SYSLOOP ITERATE FOR ALL SYSTEM COMMANDS 00882000
CRAFTER EQU * 00883000
LA R1,ONEIDLE CARRIAGE-RETURN AFTERWARDS HRC101DS 00884590
LA R3,1 LENGTH OF ONE HRC101DS 00885180
LA R5,USRSYN YES, AFTER SYSTEM SYNONYM TYPEOUTHRC101DS 00885770
B TYPEOUT HRC101DS 00886360
* (NOTE -- NOT AN 'ERROR') 00887000
EJECT 00888000
* 00889000
* 00890000
* COMES HERE TO TYPE OUT USER SYNONYMS (IF ANY) 00891000
USRSYN EQU * TYPE OUT USER SYNONYMS 00892000
LA R5,SR1515 AFTER TYPEOUT RETURN TO CALLER HRC372DS 00893000
LM R7,R9,USABRV+4 PREPARE TO ACCESS USER SYNONYMS 00894000
LTR R7,R7 (IF ANY) 00895000
BC 8,SYNMSG2 TELL USER THAT NONE EXISTS 00896000
LA R1,SECOND PRELIMINARY HEADER FOR USER SYN'SHRC101DS 00897590
LA R3,L'SECOND ... HRC101DS 00898180
BAL R5,TYPEOUT ... HRC101DS 00898770
LA R1,SECOND1 ... HRC101DS 00899360
LA R3,L'SECOND1 ... HRC101DS 00899950
BAL R5,TYPEOUT ... HRC101DS 00900540
LA R1,SECOND2 ... HRC101DS 00901130
LA R3,L'SECOND2 ... HRC101DS 00901720
BAL R5,TYPEOUT ... HRC101DS 00902310
LA R1,SYSCOM2 SET UP R1 FOR TYPEOUTS HRC101DS 00902900
SR R6,R6 (FOR 'IC' BELOW) 00904000
* 00905000
USRLOOP MVC USERABB2,BLANKS BLANK OUT ABBREVIATION (IF ANY) 00906000
MVC SYSCOM2(8),0(R7) MOVE IN SYSTEM-COMMAND, 00907000
MVC USERSYN2(8),8(R7) USER SYNONYM, 00908000
CLI 16(R7),00 DOES 'SHORT FORM' OF USER-SYN 00909000
BE NOSHRT EXIST ? 00910000
CLI 16(R7),07 ONLY YES I NUMBER FROM 1 TO 7 00911000
BH NOSHRT ... 00912000
IC R6,16(,R7) LOOK AT (N+1)TH BYTE OF 00913000
LA R15,8(R7,R6) POINT TO END OF SHORT FORM @VA02593 00914000
CLI 0(R15),C' ' IS IT BLANK? @VA02593 00915000
BE NOSHRT IF YES, IT CAN'T BE A SHORT-FORM 00916000
BCTR R6,0 IF NON-BLANK, MOVE IN SHORT-FORM HRC101DS 00917490
EX R6,DMVC2 OF USER-SYNONYM. 00918000
SPACE , HRC101DS 00919190
NOSHRT EQU * HRC101DS 00919380
LA R3,(L'SYSCOM2+L'USERSYN2+L'USERABB2) HRC101DS 00919570
BAL R5,TYPEOUT HRC101DS 00919760
BXLE R7,R8,USRLOOP ITERATE FOR ALL USER ABBREVIATIONS 00920000
LA R1,ONEIDLE CARRIAGE-RETURN AFTERWARDS HRC101DS 00921590
LA R3,1 LENGTH OF ONE HRC101DS 00922180
LA R5,SR1515 AFTER TYPEOUT RETURN TO CALLER HRC101DS 00922770
B TYPEOUT RETURN TO CALLER HRC101DS 00923360
EJECT 00924000
* DISPLAY THE CONTENTS OF THE SYSNAMES TABLE FOR SAVED SYSTEMS 00925000
* 00926000
QRYSYSN EQU * @V305614 00927000
CLI 8(R2),FENCE NO OTHER PARAMETERS @V305066 00928000
BNE ERROR026 VALID @V305614 00929000
SPACE 1 00930000
L R11,ASYSNAMS GET SYSNAMES TABLE @V305614 00931000
USING SYSNAMES,R11 ADDRESSABILITY @V305614 00932000
LA R1,ONEIDLE HRC101DS 00933490
LA R3,1 HRC101DS 00933980
BAL R5,TYPEOUT HRC101DS 00934470
LA R1,SYSN1 POINT TO 1ST LINE HRC101DS 00934960
LA R3,L'SYSN1 HRC101DS 00935450
BAL R5,TYPEOUT HRC101DS 00935940
SPACE 1 00937000
LA R6,FOUR GET NUMBER OF ENTRIES @V305066 00938000
LA R7,CMSSEG POINT TO 1ST ENTRY @V305614 00939000
LA R8,SYSN2+11 POINT TO OUTPUT AREA @V305614 00940000
SPACE 1 00941000
SYSNLOOP MVC 0(8,R8),0(R7) PLUG SYSNAMES ENTRY @V305614 00942000
LA R7,8(,R7) BUMP SYSNAMES POINTER @V305614 00943000
LA R8,10(,R8) AND OUTPUT POINTER @V305614 00944000
BCT R6,SYSNLOOP FILL IT UP @V305614 00945000
SPACE 1 00946000
LA R1,SYSN2 POINT TO 2ND LINE HRC101DS 00947590
LA R3,L'SYSN2 HRC101DS 00948180
BAL R5,TYPEOUT HRC101DS 00948770
LA R1,ONEIDLE HRC101DS 00949360
LA R3,1 HRC101DS 00949950
LA R5,SR1515 RETURN TO CALLER HRC101DS 00950540
B TYPEOUT HRC101DS 00951130
EJECT 00952000
* 00953000
* PROTECT. INDICATE WHETHER PROTECT = ON|OFF 00954000
* 00955000
SPACE 00956000
PROTECT EQU * 00957000
MVC QOPT,CPROTECT NAME OF FUNCTION 00958000
TM PROTFLAG,PRFPOFF IS FLAG ON 00959000
BO OPTOFF YES, STATUS = OFF 00960000
B OPTON NO, STATUS = ON 00961000
SPACE 2 00962000
* 00963000
* DOS. INDICATE WHETHER DOS = ON|OFF 00964000
* 00965000
SPACE 1 00966000
DOS EQU * @V305001 00967000
MVC QOPT,CDOS NAME OF FUNCTION @V305001 00968000
TM DOSFLAGS,DOSMODE+DOSSVC ARE FLAGS ON ? @V305001 00969000
BNZ OPTON ONE MUST HAVE BEEN ON @VA09636 00972000
SPACE 2 00974000
* 00975000
* DISPLAY THE STATUS OF THE FLAG (ON | OFF) 00976000
* 00977000
SPACE 00978000
SPACE 2 00979000
OPTOFF EQU * THE STATUS OF THE QUERIED OPTION IS OFF 00980000
MVC QSTATUS(3),=C'OFF' MOVE THE STATUS INTO THE MESSAGE 00981000
LA R3,3(,R3) 3 CHARACTERS ADDED TO THE MESSAGE 00982000
B TYPEQMSG TYPEOUT THE MESSAGE HRC101DS 00983490
* 00984000
OPTON EQU * THE STATUS OF THE QUERIED OPTION IS ON 00985000
MVC QSTATUS(2),=C'ON' MOVE THE STATUS INTO THE MESSAGE 00986000
LA R3,2(,R3) 2 CHARACTERS ADDED TO THE MESSAGE 00987000
* 00988000
TYPEQMSG EQU * TYPE OUT THE MESSAGE HRC101DS 00989090
LA R1,QMSG ADDRESS OF BUFFER HRC101DS 00989180
TYPEOUT EQU * TYPE OUT THE MESSAGE HRC101DS 00989270
TM OPTSFLAG,OPTSTACK STACK RESULTS ? HRC101DS 00989360
BO STACKOUT YES, CONTINUE HRC101DS 00989450
ST R1,PTYPBUF SET THE ADDRESS OF THE MESSAGE HRC101DS 00989540
STH R3,QMSGL LENGTH OF THE MESSAGE FOR TYPLIN 00990000
LA R1,PTYPLIN ADDRESS OF TYPLIN PLIST 00991000
SVC 202 TYPE IT OUT 00992000
L R1,PTYPBUF RESTORE R1 HRC101DS 00992500
BR R5 SEE IF USER QUERIES MORE OPTIONS ? 00993000
SPACE , HRC101DS 00993060
STACKOUT DS 0H HRC101DS 00993120
TM OPTSFLAG,OPTLIFO HRC101DS 00993180
BNO STACKFIF HRC101DS 00993240
MVC PSTKDIR,=CL8'LIFO' HRC101DS 00993300
SPACE , HRC101DS 00993360
STACKFIF EQU * HRC101DS 00993420
ST R1,PSTKBUF ADDRESS OF BUFFER HRC101DS 00993480
STC R3,PSTKBUF LENGTH OF MESSAGE HRC101DS 00993540
LA R1,PSTKLIN ADDRESS OF STACK PLIST HRC101DS 00993600
SVC 202 STACK IT NOW HRC101DS 00993660
DC AL4(ERR109S) ERROR FROM SVC HRC101DS 00993720
L R1,PSTKBUF RESTORE R1 HRC101DS 00993780
BR R5 RETURN TO CALLER HRC101DS 00993840
EJECT 00994000
* HRC322DS 00994010
* CP QUERY with STACK option. Issue the CP command and place HRC322DS 00994020
* the result on the stack. HRC322DS 00994030
CPQUERY DS 0H HRC322DS 00994040
S R2,=F'8' R2 now points to QUERY command HRC322DS 00994050
LA R3,CPCMND point to buffer for CP command HRC322DS 00994060
SLR R5,R5 zero buffer length HRC322DS 00994070
* Loop to build up the CP command. HRC322DS 00994080
CPPARMLP DS 0H copy CMS tokens to CP command HRC322DS 00994090
MVC 0(8,R3),0(R2) copy token HRC322DS 00994100
MVI 8(R3),C' ' add a blank HRC322DS 00994110
LA R2,8(R2) bump to next token HRC322DS 00994120
LA R3,9(R3) update CP command pointer HRC322DS 00994130
LA R5,9(R5) accumulate length HRC322DS 00994140
CLI 0(R2),X'FF' all done? HRC322DS 00994150
BE CPQUERY1 yes, go issue the CP command HRC322DS 00994160
CLI 0(R2),C'(' is it the start of options? HRC322DS 00994170
BNE CPPARMLP no, so process next token HRC322DS 00994180
CPQUERY1 DS 0H issue the CP command HRC322DS 00994190
LA R0,1024 buffer for CP output (in DWORDs) HRC322DS 00994200
DMSFREE DWORDS=(0),MSG=NO,ERR=ERR109S,TYPCALL=BALR HRC322DS 00994210
LR R9,R1 save buffer address HRC322DS 00994220
LA R2,CPCMND address of CP command HRC322DS 00994230
LR R3,R9 address of buffer for CP output HRC322DS 00994240
SLL R0,3 convert to bytes HRC322DS 00994250
LR R6,R0 size of output buffer HRC322DS 00994260
LR R1,R5 save CP command length HRC322DS 00994270
ICM R5,8,=X'40' set flag for output to buffer HRC322DS 00994280
* Issue the CP command, with output directed to our buffer. HRC322DS 00994290
DIAG R2,R5,8 at last we issue the CP command HRC322DS 00994300
BC 4,CPQUERY4 buffer overflow HRC322DS 00994310
LTR R8,R5 save return code from CP HRC322DS 00994320
BNZ CPQUERY6 don't stack results if error HRC322DS 00994330
LTR R6,R6 any output from CP? HRC322DS 00994340
BZ CPQUERY5 no, set return code and exit HRC322DS 00994350
LR R3,R9 CP output buffer HRC322DS 00994360
BCTR R3,0 prime the pump HRC322DS 00994370
* Loop to place each output line from CP on the stack. HRC322DS 00994380
CPNXTLIN DS 0H HRC322DS 00994390
LA R3,1(R3) skip previous linend character HRC322DS 00994400
LR R1,R3 start of this line HRC322DS 00994410
* Loop to find the end of this line. HRC322DS 00994420
CPNXTCHR DS 0H HRC322DS 00994430
CLI 0(R3),X'15' are we at the end of this line? HRC322DS 00994440
BE CPQUERY2 yes, go stack it HRC322DS 00994450
LA R3,1(R3) no, on to next character HRC322DS 00994460
BCT R6,CPNXTCHR continue loop until buffer end HRC322DS 00994470
* We have a line, now stack it. HRC322DS 00994480
CPQUERY2 DS 0H HRC322DS 00994490
LR R7,R3 save scan pointer HRC322DS 00994500
SR R3,R1 length of this line of output HRC322DS 00994510
BCTR R6,0 account for linend character HRC322DS 00994520
LA R5,CPQUERY3 return address HRC322DS 00994530
B STACKOUT stack the line HRC322DS 00994540
CPQUERY3 DS 0H HRC322DS 00994550
L R1,PSTKBUF restore our buffer address HRC322DS 00994560
LR R3,R7 restore scan pointer HRC322DS 00994570
LTR R6,R6 more lines to process? HRC322DS 00994580
BP CPNXTLIN yes, go scan and stack them HRC322DS 00994590
B CPQUERY5 no, we are finished HRC322DS 00994600
* Wrap up and exit. HRC322DS 00994610
CPQUERY4 DS 0H HRC322DS 00994620
LA R8,88 return code of 88 HRC322DS 00994630
CPQUERY5 DS 0H HRC322DS 00994640
LA R0,1024 buffer size HRC322DS 00994650
LR R1,R9 get address of buffer HRC322DS 00994660
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR HRC322DS 00994670
LR R15,R8 set return code HRC322DS 00994680
B EXIT return to caller HRC322DS 00994690
CPQUERY6 DS 0H HRC322DS 00994700
DIAG R2,R1,8 reissue CP cmd to show error msg HRC322DS 00994710
LR R15,R1 set return code HRC322DS 00994720
B EXIT return to caller HRC322DS 00994730
EJECT HRC322DS 00994740
* 00995000
* INFORMATIONAL AND ERROR MESSAGES 00996000
* 00997000
SPACE 2 HRC322DS 00997100
CMSLEVEL EQU * HRC322DS 00997200
LA R1,LEVELMSG address of CMSLEVEL message HRC322DS 00997300
L R3,=F'44' length of CMSLEVEL message HRC371DS 00997400
B TYPEOUT type or stack the message HRC322DS 00997500
LEVELMSG DC CL44'VM/370 Release 6, PLC 629, "SixPack" ver 1.2' 371DS 00997600
SPACE 2 00998000
NOTFOUND EQU * 00999000
CLC STRMAX,8(R2) WAS THAT Q DISK MAX ? HRC003DS 00999300
BE ERROR006 YES, SAY NO R/W DISK ACCESSED HRC003DS 00999600
LA R2,8(,R2) POINT TO THE MODE 01000000
LINEDIT SUB=(CHARA,(R2)),RENT=NO,TEXT='Disk ''........'' not a+01001000
ccessed',DISP=NONE,BUFFA=MSGBUFL HRC322DS 01001500
LA R1,MSGBUF address of message text HRC322DS 01002000
SR R3,R3 HRC322DS 01002500
IC R3,MSGBUFL length of message text HRC322DS 01003000
B TYPEOUT type or stack the message HRC322DS 01003500
SPACE 2 01004000
FLDFMSG EQU * 01005000
ERR324I DMSERR NUM=324,LET=I,SUB=(CHARA,(R7)),DISP=NONE,BUFFA=MSGBUFL,*01006000
TEXT='No user defined ........''s in effect' HRC322DS 01006500
LA R1,MSGBUF address of message text HRC322DS 01007000
SR R3,R3 HRC322DS 01007500
IC R3,MSGBUFL length of message text HRC322DS 01008000
B TYPEOUT type or stack the message HRC322DS 01008500
SPACE 2 01009000
SYNMSG EQU * 01010000
LA R1,SYNMSGNS address of message text HRC322DS 01011000
L R3,=F'28' length of message text HRC322DS 01011500
B TYPEOUT type or stack the message HRC322DS 01012000
SYNMSGNS DC CL28'No system synonyms in effect' HRC322DS 01012500
EJECT 01013000
SYNMSG2 EQU * 01014000
LA R1,SYNMSGNU address of message text HRC322DS 01015000
L R3,=F'26' length of message text HRC322DS 01015500
B TYPEOUT type or stack the message HRC322DS 01016000
SYNMSGNU DC CL26'No user synonyms in effect' HRC322DS 01016500
INPMSG EQU * 01017000
LA R1,INPMSGM address of message text HRC322DS 01018000
L R3,=F'44' length of message text HRC322DS 01018500
B TYPEOUT type or stack the message HRC322DS 01019000
INPMSGM DC CL44'No user defined input translate table in use' 01019500
SPACE 2 01020000
OUTMSG EQU * 01021000
LA R1,OUTMSGM address of message text HRC322DS 01022000
L R3,=F'45' length of message text HRC322DS 01022400
B TYPEOUT type or stack the message HRC322DS 01022800
OUTMSGM DC CL45'No user defined output translate table in use' 01023200
DS 0H HRC322DS 01023600
EJECT 01024000
ERROR003 EQU * HRC101DS 01025690
DMSERR NUM=3,LET=E,SUB=(CHARA,(R2)), P0705*01026380
TEXT='Invalid option: ........ specified' HRC322DS 01027070
LA R15,24 COMPLETION CODE P0705 01028000
B EXIT RETURN TO CALLER P0705 01029000
SPACE 2 HRC101DS 01029100
ERROR005 EQU * HRC101DS 01029200
DMSERR NUM=5,LET=E,SUB=(CHARA,(R2)), P0705*01029300
TEXT='No ''........ parameter'' specified' HRC322DS 01029400
LA R15,24 COMPLETION CODE HRC101DS 01029500
B EXIT RETURN TO CALLER HRC101DS 01029600
SPACE 2 01030000
ERROR006 EQU * HRC003DS 01030100
DMSERR NUM=6,LET=E,TEXT='No read/write disk accessed' HRC322DS 01030200
LA R15,24 RETURN CODE HRC003DS 01030300
B EXIT HRC003DS 01030400
SPACE 2 , HRC003DS 01030500
ERROR014 EQU * 01031000
DMSERR NUM=14,LET=E,SUB=(CHARA,(R2)),TEXT='Invalid function ''+01032000
........''' HRC322DS 01033000
LA R15,24 COMPLETION CODE 01034000
B EXIT 01035000
EJECT 01036000
ERROR026 EQU * 01037000
LA R3,8(,R2) POINT TO THE INVALID ARGUMENT 01038000
DMSERR NUM=26,LET=E,SUB=(CHARA,(R3),CHARA,(R2)),RENT=NO,TEXT='+01039000
Invalid parameter ''........'' for ''........'' function+01040000
' HRC322DS 01041000
LA R15,24 RETURN CODE 01042000
B EXIT RETURN TO CALLER 01043000
SPACE 2 01044000
ERROR047 EQU * 01045000
DMSERR NUM=47,LET=E,TEXT='No function specified' HRC322DS 01046000
LA R15,24 RETURN CODE 01047000
B EXIT 01048000
EJECT 01049000
ERROR070 EQU * 01050000
DMSERR NUM=70,LET=E,SUB=(CHARA,(R9)),TEXT='Invalid parameter '+01051000
'........''' HRC322DS 01052000
LA R15,24 RETURN CODE 01053000
B EXIT RETURN TO CALLER 01054000
SPACE 1 01055000
ERROR099 EQU * @V305001 01056000
DMSERR TEXT='CMS/DOS environment not active',NUM=99,LET=E 01057000
LA R15,RC40 RETURN CODE HRC322DS 01058000
B EXIT RETURN TO CALLER @V305001 01059000
SPACE 2 01060000
ERR109S EQU * @VA05247 01061000
DMSERR NUM=109,LET=S,TEXT='Virtual storage capacity exceeded' 01062000
LA R15,109 HRC322DS 01063000
B EXIT @VA05247 01064000
SPACE 2 @VA05247 01065000
* 01066000
* EXIT 01067000
* 01068000
SR1515 EQU * EXIT SUCCESSFULLY, R15=0 01069000
SR R15,R15 01070000
EXIT EQU * EXIT UNSUCCESSFULLY, R15>0 01071000
MVI MISCFLAG,ZERO RESET MODULE FLAG @VM05247 01072000
L R14,SAVE14 RESTORE R14 01073000
BR R14 RETURN TO CALLER 01074000
EJECT 01075000
* 01076000
* CONSTANTS AND STORAGE AREA 01077000
* 01078000
DS 0D 01079000
* 01080000
* STANDARD TRANSLATE TABLE FOR USER TERMINAL INPUT AND OUTPUT 01081000
* 01082000
OTRTABLE DC 256AL1(*-OTRTABLE) STANDARD OUTPUT TRANS. TABLE 01083000
ITRTABLE DC 129AL1(*-ITRTABLE) STANDARD INPUT TRANS. TABLE 01084000
UPA DC X'C1C2C3C4C5C6C7C8C9' TR LOWER ALHPA TO UPPER 01085000
UPAB DC 7AL1(*-UPAB+138) 01086000
UPJ DC X'D1D2D3D4D5D6D7D8D9' 01087000
UPJB DC 8AL1(*-UPJB+154) 01088000
UPS DC X'E2E3E4E5E6E7E8E9' 01089000
UPSB DC 86AL1(*-UPSB+170) 01090000
* 01091000
MVCINST MVC 0(*-*,R9),1(R9) TO MOVE PORTION OF TYPEOUT FORWARD 1 01092000
* 01093000
* TABLE OF FILEDEF DEVICES - MUST BE IN ORDER SPECIFIED 01094000
* 01095000
DUMMY DC CL8'DUMMY' 01096000
PRT DC CL8'PRT' 01097000
RDR DC CL8'RDR' 01098000
TERM DC CL8'TERMINAL' 01099000
TAP DC CL8'TAP' 01100000
DSK DC CL8'DISK' 01101000
PUN DC CL8'PUN' 01102000
CRT DC CL8'CRT' 01103000
FENCE EQU X'FF' @V305066 01104000
FOUR EQU 4 @V305066 01105000
ARGLEN EQU 8 @V305066 01106000
HEX01 EQU X'01' @V305066 01107000
ZONE EQU X'F0' @V305066 01108000
DUMP EQU X'40' @V305066 01109000
CHAR48C EQU X'02' @V305066 01110000
ZERO EQU X'00' @V305066 01111000
RC40 EQU 40 @V305066 01112000
SEVEN EQU 7 @VA04310 01113000
W EQU C'W' @V305066 01114000
ELEVEN EQU 11 @VA06340 01115000
* 01116000
T3340 EQU X'07' @V2A2014 01117000
T3350 EQU X'0B' @V304498 01118000
T2314 EQU X'08' @V2A2014 01119000
T3330 EQU X'09' @V2A2014 01120000
T3380 EQU X'0E' HRC003DS 01120500
* 01121000
DEC DS 1D USED FOR NUMBER CONVERSION 01122000
NEXTLIB DS 1F NEXT LIBRARY WHEN QUERY LIBRARY @V305001 01123000
* 01124000
PHEX1 DC X'000000F0' CONVERT 1 - 9 TO PRINTABLE HEX 01125000
PHEX2 DC X'000000C0' CONVERT A - F TO PRINTABLE HEX 01126000
DECDEC DS 1D USED FOR NUMBER CONVERSION 01127000
SPACE , HRC101DS 01128790
OPTSFLAG DC X'00' HRC101DS 01129580
OPTSTACK EQU X'80' STACK REQUESTED HRC101DS 01130370
OPTFIFO EQU X'08' FIFO REQUESTED HRC101DS 01131160
OPTLIFO EQU X'04' LIFO REQUESTED HRC101DS 01131950
SPACE , HRC101DS 01132740
DS 0F 01134000
SHORTCNT DC AL1(*-*) MSG-LENGTH FILLED IN 01138000
* 01139000
SHORTMSG DC CL8' ' DISK-LABEL AND TWO BLANKS JS 01140000
SHORT1 DC C'000 ' DEVICE-ADDRESS JS 01141000
SHORT2 DC C'Y,Z' E.G. "P " OR "A,P" ETC. 01142000
SHORT3 DC C' R/O' TWO BLANKS; R/O = READ-ONLY 01143000
* 01144000
SHORTRO EQU *-SHORTMSG LENGTH OF WHOLE SHORT MESSAGE 01145000
OSMSG DC C' - ???' APPEND FOR OS/DOS DISK @V305101 01146000
SHORTOS EQU SHORTRO+L'OSMSG LENGTH OF SHORT MSG + O/S @V201101 01147000
RO DC C'R/O' 01148000
RW DC C'R/W' 01149000
OSL DC CL3'OS' O/S DISK LITERAL @V305101 01150000
DOSL DC CL3'DOS' DOS DISK LITERAL @V305101 01151000
* 01152000
DS 0F ALIGN. 01153000
LISTLEN DC AL3(L'LISTMES) 01156000
LISTMES DC CL18' ' FOR DDNAMES AND DEVICE NAMES 01157000
LISTDSK DC CL18' ' FOR DSNAMES AND DSTYPES 01158000
GENLEN DC AL3(L'LISTMES) 01159000
DSKLEN DC AL3(L'LISTMES+L'LISTDSK) 01160000
* 01161000
* MESSAGE TO PRINT FOR P- OR T-DISK... 01162000
* 01163000
PTMSG EQU * HRC003DS 01164390
PTLABEL DC CL6' ',CL1' ' HRC003DS 01164780
PTUNIT DC CL3'000',CL1' ' HRC003DS 01165170
PTMODE DC CL1' ' HRC003DS 01165560
PTSLASH DC CL1' ' HRC003DS 01165950
PTMODEX DC CL1' ',CL1' ' HRC003DS 01166340
PTSTAT DC CL3' ' HRC003DS 01166730
ORG *-1 HRC003DS 01167120
PTCYL DC CL6' 0000',CL1' ' HRC003DS 01167510
PTTYPE DC CL4'0000',CL1' ' HRC003DS 01167900
PTBLKS DC CL4'0000' HRC003DS 01168290
ORG *-1 HRC003DS 01168680
PTFILES DC CL12'000000000000' HRC003DS 01169070
ORG *-1 HRC003DS 01169460
PTBLKUSD DC CL12'000000000000' HRC003DS 01169850
PTPCTUSD DC CL3'-00' HRC003DS 01170240
ORG *-1 HRC003DS 01170630
PTBLKFRE DC CL12'000000000000' HRC003DS 01171020
ORG *-1 HRC003DS 01171410
PTBLKTOT DC CL12'000000000000' HRC003DS 01171800
LPTMSG EQU *-PTMSG HRC003DS 01172190
* 01174000
FRSTFLAG DC X'00' HRC003DS 01175990
FRSTTIME EQU X'80' FIRST TIME THRU HRC003DS 01176980
QRWDSK EQU X'01' R/W DISK WANTED HRC003DS 01177970
* HRC003DS 01178960
DTITLE DC C'Label CUU M Stat Cyl Type Blksize Files Blks UseX01180940
d-(%) Blks Left Blk Total' HRC322DS 01181930
* 01184000
SAVE14 DS 1F R14 SAVED HERE 01185000
SAVE9 DS 1F R9 SAVED HERE HRC101DS 01185500
* 01186000
HEXTBL DC C'0123456789ABCDEF' 01187000
* 01204000
FIRST DC C'System Shortest' HRC322DS 01205000
FIRST1 DC C'Command Form' HRC322DS 01206000
FIRST2 DC C'-------- --------' 01207000
SYSCOM DC CL10' ' E.G. 'ALTER' GOES HERE 01208000
SYSABB DC CL8' ' E.G. 'AL' GOES HERE 01209000
BLANKS DC CL8' ' (FOR INITIALIZING SYSABB ETC.) 01210000
* 01211000
DMVC MVC SYSABB(*-*),0(R7) MOVES THE ABBREV. IN 01212000
MVC MVC QSTATUS(*-*),TIMCHAR STATUS =BLIP CHARACTERS 01213000
* 01214000
* CONSTANTS AND STORAGE FOR OUTPUTTING THE QUERY MESSAGE 01215000
* 01216000
PTYPLIN DS 0D PARAMETER LIST FOR TYPLIN 01217000
DC CL8'TYPLIN' MMODULE INVOKED 01218000
PTYPBUF DC A(QMSG) A(OUTPUT MESSAGE) HRC101DS 01219490
DC C'B',X'02' @VA06217 01220000
QMSGL DS 1H LENGTH OF THE OUTPUT MESSAGE 01221000
QMSG EQU * OUTPUT MESSAGE 01222000
QOPT DS CL8 OPTION QUERIED 01223000
QEQU DC C' = ' 01224000
QSTATUS DS CL118 STATUS OF OPTION QUERIED 01225000
NONE DC C'NONE' 01226000
SPACE 01227000
SMSG DC C'SMSG' SHORT MESSAGE(ERRMSG,RDYMSG) 01228000
LMSG DC C'LMSG' LONG MESSAGE(ERRMSG,RDYMSG) 01229000
SPACE , HRC101DS 01229100
PSTKLIN DS 0F STACK THE OUTPUT HRC101DS 01229200
DC CL8'ATTN' ATTN FUNCTION HRC101DS 01229300
PSTKDIR DC CL4'FIFO' HRC101DS 01229400
PSTKBUF DC A(0) LENGTH,ADDRESS HRC101DS 01229500
DS 0F 01230000
MSGBUFL DS CL1 length of text from LINEDIT HRC322DS 01231000
MSGBUF DS CL79 msg buffer: type or stack this HRC322DS 01232000
* 01234000
SECOND DC C'System User Shortest' HRC322DS 01235000
SECOND1 DC C'Command Synonym Form (if any)' HRC322DS 01236000
SECOND2 DC C'-------- -------- --------' 01237000
SYSCOM2 DC CL9' ' E.G. 'ERASE' GOES HERE 01238000
USERSYN2 DC CL9' ' E.G. 'DELETE' GOES HERE 01239000
USERABB2 DC CL8' ' E.G. 'DELET' GOES HERE 01240000
EUSERT EQU * (END OF THIS TYPEOUT) 01241000
* 01242000
ONEIDLE DC X'17' (TO TYPE ONE CARRIAGE-RETURN) 01243000
* 01244000
DMVC2 MVC USERABB2(*-*),8(R7) TO MOVE SHORT-FORM OF USER-SYN. 01245000
* 01246000
CPCMND DS CL132 COMMAND LINE 01249000
DC 4XL1'FF' END OF DMSCPF PLIST 01250000
* 01251000
DSKTBL EQU * TABLE OF VALID MODE LETTERS 01252000
DC C'A ' ADISK 01253000
DC C'B ' BDISK 01254000
DC C'C ' CDISK 01255000
DC C'D ' DDISK 01256000
DC C'E ' EDISK 01257000
DC C'F ' FDISK 01258000
DC C'G ' GDISK 01259000
DC C'H ' HDISK HRC002DS 01259080
DC C'I ' IDISK HRC002DS 01259160
DC C'J ' JDISK HRC002DS 01259240
DC C'K ' KDISK HRC002DS 01259320
DC C'L ' LDISK HRC002DS 01259400
DC C'M ' MDISK HRC002DS 01259480
DC C'N ' NDISK HRC002DS 01259560
DC C'O ' ODISK HRC002DS 01259640
DC C'P ' PDISK HRC002DS 01259720
DC C'Q ' QDISK HRC002DS 01259800
DC C'R ' RDISK HRC002DS 01259880
DC C'S ' SYSTEM DISK 01260000
DC C'T ' TDISK HRC002DS 01260100
DC C'U ' UDISK HRC002DS 01260200
DC C'V ' VDISK HRC002DS 01260300
DC C'W ' WDISK HRC002DS 01260400
DC C'X ' XDISK HRC002DS 01260500
DC C'Y ' YDISK 01261000
DC C'Z ' ZDISK 01262000
ENDTBL EQU *-2 END OF DISKTBL 01263000
* 01264000
* CONSTANTS FOR SYSNAMES OUTPUT 01265000
* 01266000
SPACE 1 01269000
SYSN1 DC C'SYSNAMES: CMSSEG CMSVSAM CMSAMS CMSDOS' 01270000
SYSN2 DC CL49' Entries:' HRC322DS 01271000
EJECT @VA05247 01272000
***************************************************************@VA05247 01273000
* @VA05247 01274000
* THE USER HAS REQUESTED A LIST OF ALL CURRENT DOSCBS @VA05247 01275000
* @VA05247 01276000
***************************************************************@VA05247 01277000
SPACE 1 @VA05247 01278000
DLBL EQU * LIST ALL DOSCB'S @VA05247 01279000
CLI 0(R9),FENCE 'LIST ALL' REQUEST? @VA05247 01280000
BE LISTALL YES... @VA05247 01281000
CLI 0(R9),C'(' HRC101DS 01281200
BNE DLBL100 HRC101DS 01281400
SPACE , HRC101DS 01281600
DLBL100 EQU * HRC101DS 01281800
CLI 8(R9),FENCE NO, BETTER HAVE FENCE HERE @VA05247 01282000
BE CKEXTNT OK, CHEK ONLY PARM ALLOWED @VA05247 01283000
CLI 0(R9),C'(' HRC101DS 01283300
BNE ERROR070 HRC101DS 01283600
LA R9,8(,R9) TOO MANY APRMS ENTERED... @VA05247 01284000
B ERROR070 ERROR. @VA05247 01285000
CKEXTNT CLC EXTENT,0(R9) 'EXTENT' ENTERED? @VA05247 01286000
BNE CKMULT NO, CHEK FOR MULT REQ... @VA05247 01287000
OI MISCFLAG,XEXTENT REMEMBER EXTENTS WANTED @VA05247 01288000
B LIST2D GO LOOK FOR THEM... @VA05247 01289000
CKMULT CLC MULT,0(R9) 'MULT' ENTERED? @VA05247 01290000
BNE ERROR070 NEITHER...ERROR @VA05247 01291000
OI MISCFLAG,XMULT REMEMBER MULT WANTED... @VA05247 01292000
B LIST2D GO LOOK FOR 'EM... @VA05247 01293000
SPACE 1 @VA05247 01294000
LISTALL EQU * LIST ALL DOSCB CONTENTS @VA05247 01295000
LA R0,LSTLEND GET DWORDS FOR LIST AREA @VA05247 01296000
LA R10,LISTHDR SUBRTN RETURN ADDR @VA05247 01297000
LISTPREP LH R2,DOSNUM GET NO. DOSCBS @VA05247 01298000
LTR R2,R2 ANY THERE? @VA05247 01299000
BZ ERR324I NO...EARLY OUT. @VA05247 01300000
LA R6,DOSFIRST LOAD A(DOSCB CHAIN ANCHOR) @VA05247 01301000
USING DOSSECT,R6 @VA05247 01302000
DMSFREE DWORDS=(0),ERR=ERR109S GET LIST AREA @VA05247 01303000
LR R3,R1 USE R3 FOR LIST @VA05247 01304000
USING DOSCBLST,R3 @VA05247 01305000
LR R8,R0 USE R8 FOR LINE CLEAR LENGTH@VA05247 01306000
SLL R8,3 CONVERT DWORDS TO BYTES @VA05247 01307000
BCTR R8,R0 MINUS 1 FOR CLEAR MVC @VA05247 01308000
BCTR R8,R0 MINUS 1 FOR CLEAR EXECUTE @VA05247 01309000
MVI 0(R3),BLANK CLEAR THE WORK AREA @VA05247 01310000
EX R8,EXCLR ... @VA05247 01311000
BR R10 RETURN TO CALLER (OR DROP) @VA05247 01312000
EXCLR MVC 1(*-*,R3),0(R3) ... @VA05247 01313000
SPACE 2 @VA05247 01314000
LISTHDR MVC 0(HEADLEN,R3),LISTHEAD HEADER TO WORK AREA @VA05247 01315000
LA R7,HEADLEN AND LENGTH OF SAME @VA05247 01316000
BAL R10,WRTERM GO DISPLAY THE HEADER @VA05247 01317000
SPACE 1 @VA05247 01318000
LISTLOOP EQU * LOOP FOR EACH DOSCB @VA05247 01319000
L R6,0(,R6) POINT TO NEXT DOSCB @VA05247 01320000
MVC LDDNAME,DOSDD GET DDNAME @VA05247 01321000
CLI DOSDEV,DOSDUM IS THIS ONE 'DUMMY'? @VA05247 01322000
BNE LISTMODE NO @VA05247 01323000
MVC LMODE,DUMMY YES, DISPLAY IT SO @VA05247 01324000
B LISTLOGU GO GET 'SYSXXX' @VA05247 01325000
LISTMODE MVC LMODE(L'DOSDSMD),DOSDSMD GET CMS DISKMODE @VA05247 01326000
SPACE 1 @VA05247 01327000
LISTLOGU TM DOSINIT,DOSOS 'OS' DLBL ISSUED? @VA05247 01328000
BO LISTYPE YES, SKIP SYSXXX PROCESS @VA05247 01329000
MVC LLOGUNIT,SYSXXX MOVE IN 'SYS' @VA05247 01330000
XR R8,R8 USE R8 FOR LUB CODE @VA05247 01331000
ICM R8,ONE,DOSXXX INSERT LUB CODE @VA05247 01332000
CLI DOSSYS,SYSLOG IS IT 'SYSTEM' UNIT? @VA05247 01333000
BNE LISTLOGP NO, PROCESS AS PROG... @VA05247 01334000
LA R7,UNITTAB SYSTEM...LOOK FOR 3 ALPHAS @VA05247 01335000
MH R8,THREE INDX TO TABLE ENTRY @VA05247 01336000
AR R7,R8 ... @VA05247 01337000
MVC LLOGXXX,0(R7) MOVE IT TO LIST @VA05247 01338000
B LISTYPE GOTO 'TYPE' FIELD... @VA05247 01339000
LISTLOGP CVD R8,PACKFLD GET CODE READY FOR LIST @VA05247 01340000
UNPK LLOGXXX,PACKFLD+6(L'LLOGXXX-1) LIST SYS CODE @VA05247 01341000
OI LLOGXXX+2,ZONE 'OR' FOR NUMERIC @VA05247 01342000
SPACE 1 @VA05247 01343000
LISTYPE CLI DOSTYPE,SAMDS SAM DATASET? @VA05247 01344000
BNE LISTVSAM NO, MUST BE VSAM... @VA05247 01345000
MVC LTYPE,SEQNTL 'SEQ' INTO LIST @VA05247 01346000
B LISTPERM SKIP BY ALL VSAM FIELDS... @VA05247 01347000
SPACE 1 @VA05247 01348000
LISTVSAM MVC LTYPE,VSAM 'VSAM' INTO LIST @VA05247 01349000
CLI DOSUCNAM,ZERO ANY USER CATALOG? @VA05247 01350000
BE LISTMCAT NO, DEFAULT TO MASTER @VA05247 01351000
MVC LCATALOG,DOSUCNAM PUT USER CAT NAME @VA05247 01352000
B LISTEXT AND CONTINUE... @VA05247 01353000
LISTMCAT MVC LCATALOG,MCAT 'IJSYSCT' INTO LIST @VA05247 01354000
LISTEXT XR R8,R8 USE R8 FOR EXT, VOL NOS. @VA05247 01355000
ICM R8,ONE,DOSEXTNO GET NO. EXTENTS @VA05247 01356000
CVD R8,PACKFLD PREP NUM FOR EDIT @VA05247 01357000
MVC EDIT,PATTERN SETUP PATTERN FIELD @VA05247 01358000
ED EDIT(L'LEXT+2),PACKFLD+6 FORMAT NO. EXTENTS @VA05247 01359000
MVC LEXT,EDIT+2 INTO LIST WITH IT.. @VA05247 01360000
LISTVOL ICM R8,ONE,DOSVOLNO GET NO. VOLUMES @VA05247 01361000
CVD R8,PACKFLD PREP NUM FOR EDIT @VA05247 01362000
MVC EDIT,PATTERN SETUP PATTERN @VA05247 01363000
ED EDIT(L'LVOL+2),PACKFLD+6 FORMAT NO. VOLS @VA05247 01364000
MVC LVOL,EDIT+2 INTO THE LIST @VA05247 01365000
LISTBUFS L R8,DOSBUFSP GET BUFFER SPACE @VA05247 01366000
CVD R8,PACKFLD PREP FOR EDIT @VA05247 01367000
MVC EDIT,PATTERN SETUP PATTERN @VA05247 01368000
ED EDIT(L'LBUFSPC+2),PACKFLD+4 FORMAT BUFSP PARM @VA05247 01369000
MVC LBUFSPC,EDIT+2 INTO THE LIST... @VA05247 01370000
SPACE 1 @VA05247 01371000
LISTPERM TM DOSINIT,DOSPERM DOSCB MARKED 'PERM'? @VA05247 01372000
BZ LISTNO NO, CONTINUE @VA05247 01373000
MVC LPERM,YES MOVE 'YES' TO LIST @VA05247 01374000
B LISTDISK AND CONTINUE @VA05247 01375000
LISTNO MVC LPERM,NO 'NO' TO LIST @VA05247 01376000
SPACE 1 @VA05247 01377000
LISTDISK TM DOSINIT,DOSDOS 'DOS' DISK DATASET? @VA05247 01378000
BZ LISTCMS NO, MUST BE CMS.. @VA05247 01379000
MVC LDISK,ZDOS 'DOS' DISK DATASET @VA05247 01380000
L R7,DOSOSDSN GET DOS(OS) DSNAME... @VA05247 01381000
LTR R7,R7 DO WE HAVE ONE? @VA05247 01382000
BZ LISTLIST NO, GOTO WRAP-UP... @VA05247 01383000
MVC LFILEID,0(R7) MOVE ENTIRE DOS FILEID @VA05247 01384000
B LISTLIST CONTINUE... @VA05247 01385000
LISTCMS MVC LDISK,CMS 'CMS' DISK DATASET @VA05247 01386000
MVC LFILENAM,DOSDSNAM LIST CMS FILENAME, @VA05247 01387000
MVC LFILETYP,DOSDSTYP AND CMS FILETYPE @VA05247 01388000
LISTLIST LA R7,LSTLEND*8 BYTE-LENGTH FOR DISPLAY @VA05247 01389000
BAL R10,WRTERM DISPLAY THE LINE @VA05247 01390000
BCT R2,LISTLOOP LOOP THRU DOSCB CHAIN... @VA05247 01391000
SPACE 1 @VA05247 01392000
LA R0,LSTLEND LIST AREA IN DWORDS @VA05247 01393000
LEND LR R1,R3 @VA05247 01394000
DMSFRET DWORDS=(0),LOC=(1) FRET WORK AREA @VA05247 01395000
TM MISCFLAG,XEXTENT+XMULT EXTENTS OR MULT WANTED? @VA05247 01396000
BZR R5 NO, CLOSE THE SHOP... @VA05247 01397000
TM MISCFLAG,XFOUND EXTENT OR MULT WANTED,FOUND?@VA05247 01398000
BOR R5 YES, END IN PEACE... @VA05247 01399000
LA R7,EXTENT ASSUME EXTENTS WANTED @VA05247 01400000
TM MISCFLAG,XEXTENT EXTENTS NOT FOUND? @VA05247 01401000
BO ERR324I YES...TELL THE USER. @VA05247 01402000
LA R7,MULT MULT.VOL LIST WANTED, @VA05247 01403000
B ERR324I SO SAY NONE FOUND. @VA05247 01404000
***************************************************************@VA05247 01405000
* 'WRTERM' SUBRTN TO DISPLAY LINE: @VA05247 01406000
* ENTRY - R3 = A(LINE) @VA05247 01407000
* R7 = LINE LENGTH (BYTES) @VA05247 01408000
***************************************************************@VA05247 01409000
WRTERM EQU * @VA05247 01410000
WRTERM (R3),(R7) @VA05247 01411000
BCTR R7,R0 MINUS 1 FOR CLEAR TECHNIQUE @VA05247 01412000
BCTR R7,R0 AND ONE MORE FOR MVC @VA05247 01413000
MVI 0(R3),BLANK BLANK THE WORK AREA AGAIN @VA05247 01414000
EX R7,EXCLR2 ... @VA05247 01415000
BR R10 RETURN TO CALLER @VA05247 01416000
EXCLR2 MVC 1(*-*,R3),0(R3) ... @VA05247 01417000
EJECT @VA05247 01418000
***************************************************************@VA05247 01419000
* @VA05247 01420000
* 'DLBL EXTENT' OR 'DLBL MULT' ENTERED: @VA05247 01421000
* USER WISHES EXTENTS OR VOLUMES LISTED. @VA05247 01422000
* @VA05247 01423000
***************************************************************@VA05247 01424000
LIST2D DS 0D EITHER EXTENTS OR VOLS WANTE@VA05247 01425000
LA R0,EXTLEND DWORDS FOR WORK AREA @VA05247 01426000
BAL R10,LISTPREP GET STORAGE AND INIT. STUFF @VA05247 01427000
USING EXTLIST,R3 @VA05247 01428000
MVC EHDR,LISTHEAD PROVIDE MOST OF HEADER @VA05247 01429000
TM MISCFLAG,XEXTENT EXTENTS WANTED? @VA05247 01430000
BZ L2LOOP IF NOT SKIP... @VA05247 01431000
MVC EEXTEND+1(L'EXTENT),EXTENT EXTENT HEADER @VA05247 01432000
SPACE 1 @VA05247 01433000
L2LOOP EQU * LOOP THRU ALL DOSCBS @VA05247 01434000
L R6,0(,R6) POINT TO NEXT DOSCB @VA05247 01435000
XR R11,R11 FOR LATER... @VA05247 01436000
TM MISCFLAG,XEXTENT LOOKING FOR EXTENTS? @VA05247 01437000
BZ LMLTPREP NO, CHEK MULT VOLS @VA05247 01438000
LA R7,DOSEXTNO POINT TO NO. EXTENTS @VA05247 01439000
L R9,DOSEXTTB AND EXTENT TABLE... @VA05247 01440000
LA R0,EXTLEN SIZE OF EXT TABLE ENTRY @VA05247 01441000
B ICMNUM SKIP TO CHEK ENTRIES @VA05247 01442000
LMLTPREP LA R7,DOSVOLNO POINT TO NO. VOLUMES @VA05247 01443000
L R9,DOSVOLTB AND VOLUME TABLE... @VA05247 01444000
LA R0,MULTLEN SIZE OF VOL TABLE ENTRY @VA05247 01445000
ICMNUM ICM R11,ONE,0(R7) LOAD NUM OF ENTRIES @VA05247 01446000
BZ L2END NEXT DOSCB IF NO ENTRIES @VA05247 01447000
CLI 0(R3),BLANK HAVE WE LISTED HDR YET? @VA05247 01448000
BE LDDMOVE YES, SKIP THRU... @VA05247 01449000
LA R7,EXTLEND*8 PROVIDE HDR LENGTH @VA05247 01450000
BAL R10,WRTERM DISPLAY THE HEADER @VA05247 01451000
OI MISCFLAG,XFOUND REMEMBER WE FOUND SOMETHING @VA05247 01452000
LDDMOVE MVC EDDNAME,DOSDD LIST DDNAME OF DOSCB @VA05247 01453000
SPACE 1 @VA05247 01454000
LBLKLOOP EQU * LOOP THRU TABLE ENTRIES @VA05247 01455000
MVC EMODE(L'EMODE-1),DMODE(R9) MOVE MODE TO LIST @VA05247 01456000
TM DOSINIT,DOSOS 'OS' DOSCB ? @VA05247 01457000
BO LEXTCHK2 YES, SKIP SYSXXX PROCESS @VA05247 01458000
MVC ELOGUNIT,SYSXXX MOVE IN 'SYS' @VA05247 01459000
XR R8,R8 USE R8 FOR LUB CODE @VA05247 01460000
ICM R8,ONE,DSYSCODE(R9) INSERT LUB CODE @VA05247 01461000
CLI DSYS(R9),SYSLOG IS IT 'SYSTEM' UNIT? @VA05247 01462000
BNE LSTLOGP2 NO, PROCESS AS PROG... @VA05247 01463000
LA R7,UNITTAB SYSTEM...LOOK FOR 3 ALPHAS @VA05247 01464000
MH R8,THREE INDX TO TABLE ENTRY @VA05247 01465000
AR R7,R8 ... @VA05247 01466000
MVC ELOGXXX,0(R7) MOVE IT TO LIST @VA05247 01467000
B LEXTCHK2 GO CHEK FOR EXTENTS... @VA05247 01468000
LSTLOGP2 CVD R8,PACKFLD GET CODE READY FOR LIST @VA05247 01469000
UNPK ELOGXXX,PACKFLD+6(L'ELOGXXX-1) LIST SYS CODE @VA05247 01470000
OI ELOGXXX+2,ZONE 'OR' FOR NUMERIC @VA05247 01471000
SPACE 1 @VA05247 01472000
LEXTCHK2 TM MISCFLAG,XEXTENT EXTENTS WANTED? @VA05247 01473000
BZ LDISPLAY NO, SKIP THRU... @VA05247 01474000
L R8,DEXTB(R9) GET BEGIN. OF EXTENT @VA05247 01475000
CVD R8,PACKFLD BINARY TO DECIMAL @VA05247 01476000
MVC EDIT,PATTERN PROVIDE EDIT PATTERN @VA05247 01477000
ED EDIT(L'EEXTBEG+2),PACKFLD+2 EDIT THE VALUE @VA05247 01478000
MVC EEXTBEG,EDIT+2 AND MOVE IT TO DISPLAY AREA @VA05247 01479000
L R8,DEXTE(R9) GET END OF EXTENT @VA05247 01480000
CVD R8,PACKFLD BINARY TO DECIMAL @VA05247 01481000
MVC EDIT,PATTERN PROVIDE EDIT PATTERN @VA05247 01482000
ED EDIT(L'EEXTEND+2),PACKFLD+2 EDIT THE VALUE @VA05247 01483000
MVC EEXTEND,EDIT+2 AND MOVE IT TO DISPLAY AREA @VA05247 01484000
LDISPLAY LA R7,EXTLEND*8 PROVIDE LINE LENGTH @VA05247 01485000
BAL R10,WRTERM DISPLAY THE GOODIES @VA05247 01486000
AR R9,R0 POINT TO NEXT TAB ENTRY @VA05247 01487000
BCT R11,LBLKLOOP GET NEXT ENTRY IN TABLE @VA05247 01488000
SPACE 1 @VA05247 01489000
L2END BCT R2,L2LOOP GET NEXT DOSCB @VA05247 01490000
LA R0,EXTLEND DWORDS TO DMSFRET @VA05247 01491000
B LEND GO FREE WORK AREA , QUIT @VA05247 01492000
SPACE 3 @VA05247 01493000
LTORG @VA05247 01494000
EJECT @VA05247 01495000
***************************************************************@VA05247 01496000
* @VA05247 01497000
* STORAGE FIELDS PECULIAR TO 'DISK' PROCESSING... HRC003DS 01498490
* @VA05247 01499000
***************************************************************@VA05247 01500000
SPACE 1 , HRC003DS 01500090
STRQMRK DC CL2'??' HRC003DS 01500180
STRMAX DC CL4'MAX ' HRC003DS 01500270
STRRW DC CL4'R/W ' HRC003DS 01500360
EJECT HRC003DS 01500450
***************************************************************HRC003DS 01500540
* HRC003DS 01500630
* STORAGE FIELDS PECULIAR TO 'LIST' PROCESSING... HRC003DS 01500720
* HRC003DS 01500810
***************************************************************HRC003DS 01500900
YES DC CL3'YES' @VA05247 01501000
NO DC CL3'NO' @VA05247 01502000
SEQNTL DC CL3'SEQ' @VA05247 01503000
PATTERN DC XL12'402020202020202020202020' @VA05247 01504000
ZDOS DC CL3'DOS' @VA05247 01505000
CMS DC CL3'CMS' @VA05247 01506000
THREE DC H'3' @VA05247 01507000
VSAM DC CL4'VSAM' @VA05247 01508000
MCAT DC CL8'IJSYSCT' VSAM MASTER CAT NAME @VA05247 01509000
PACKFLD DS D @VA05247 01510000
EDIT DC CL12' ' @VA05247 01511000
EXTENT DC CL8'EXTENT' @VA05247 01512000
MULT DC CL8'MULT' @VA05247 01513000
SPACE 1 @VA05247 01514000
MISCFLAG DC X'00' @VA05247 01515000
XEXTENT EQU X'80' ON IF 'EXTENT' DLBL LIST @VA05247 01516000
XMULT EQU X'40' ON IF 'MULT' DLBL LIST REQ @VA05247 01517000
XFOUND EQU X'20' ON IF SOME EXTNTS OR VOLS @VA05247 01518000
SPACE 1 @VA05247 01519000
SYSXXX DC CL8'SYS000' @VA05247 01520000
UNITTAB EQU * KEEP TABLE ENTRIES IN ORDER @VA05247 01521000
DC CL3'RDR' @VA05247 01522000
DC CL3'IPT' @VA05247 01523000
DC CL3'PCH' @VA05247 01524000
DC CL3'LST' @VA05247 01525000
DC CL3'LOG' @VA05247 01526000
DC CL3'LNK' @VA05247 01527000
DC CL3'RES' @VA05247 01528000
DC CL3'SLB' @VA05247 01529000
DC CL3'RLB' @VA05247 01530000
DC CL3'XXX' (FILLER) @VA05247 01531000
DC CL3'XXX' (FILLER) @VA05247 01532000
DC CL3'CLB' @VA05247 01533000
DC CL3'XXX' (FILLER) @VA05247 01534000
DC CL3'CAT' @VA05247 01535000
SPACE 1 @VA05247 01536000
* FOLLOWING ARE DISPLACEMENTS IN EXTENT, VOLUME TABLES @VA05247 01537000
DMODE EQU 0 DISK MODE (BOTH) @VA05247 01538000
DSYS EQU 1 SYS/PROG CODE (BOTH) @VA05247 01539000
DSYSCODE EQU 2 LOG UNIT CODE (BOTH) @VA05247 01540000
DEXTB EQU 3 BEGIN. EXTENT (EXT ONLY) @VA05247 01541000
DEXTE EQU 7 END EXTENT (EXT TAB ONLY) @VA05247 01542000
SPACE 1 @VA05247 01543000
BLANK EQU X'40' @VA05247 01544000
SAMDS EQU C'S' SEQ DATASET INDICATOR @VA05247 01545000
MULTLEN EQU 3 MULT TABLE ENTRY SIZE @VA05247 01546000
EXTLEN EQU 11 EXTENT TABLE ENTRY SIZE @VA05247 01547000
SYSLOG EQU 0 INDIC. SYSTEM LOGICAL UNIT @VA05247 01548000
PROG EQU 1 INDIC. PROGRAMMER LOG UNIT @VA05247 01549000
ONE EQU 1 @VA05247 01550000
EJECT @VA05247 01551000
LISTHEAD DS 0D ***DOSCB LIST HEADER*** @VA05247 01552000
DC C'DDNAME ' @VA05247 01553000
DC C'MODE ' @VA05247 01554000
DC C'LOGUNIT ' @VA05247 01555000
DC C'TYPE ' @VA05247 01556000
DC C'CATALOG ' @VA05247 01557000
DC C'EXT ' @VA05247 01558000
DC C'VOL ' @VA05247 01559000
DC C'BUFSPC ' @VA05247 01560000
DC C'PERM ' @VA05247 01561000
DC C'DISK ' @VA05247 01562000
DC C'DATASET.NAME' @VA05247 01563000
DS 0D @VA05247 01564000
HEADLEN EQU *-LISTHEAD @VA05247 01565000
SPACE 2 @VA05247 01566000
DOSCBLST DSECT @VA05247 01567000
DS 0D ***DOSCB LIST WORK AREA*** @VA05247 01568000
LDDNAME DS CL7 @VA05247 01569000
DS CL2 @VA05247 01570000
LMODE DS CL3 CMS DISK MODE OR 'DUM' @VA05247 01571000
DS CL1 @VA05247 01572000
LLOGUNIT DS CL3 ALWAYS 'SYS' @VA05247 01573000
LLOGXXX DS CL3 DOS LOGICAL UNIT CODE @VA05247 01574000
DS CL3 @VA05247 01575000
LTYPE DS CL4 'VSAM' OR 'SEQ' @VA05247 01576000
DS CL1 @VA05247 01577000
LCATALOG DS CL7 'IJSYSCT','IJSYSUC',ETC. @VA05247 01578000
DS CL1 @VA05247 01579000
LEXT DS CL2 NO. EXTENTS @VA05247 01580000
DS CL2 @VA05247 01581000
LVOL DS CL2 NO. VOLUMES @VA05247 01582000
DS CL2 @VA05247 01583000
LBUFSPC DS CL6 BUFFER SPACE SIZE @VA05247 01584000
DS CL2 @VA05247 01585000
LPERM DS CL3 'YES' OR 'NO' @VA05247 01586000
DS CL2 @VA05247 01587000
LDISK DS CL3 'CMS' OR 'DOS' @VA05247 01588000
DS CL2 @VA05247 01589000
LFILEID DS CL44 DATASET NAME @VA05247 01590000
ORG *-44 @VA05247 01591000
LFILENAM DS CL8 CMS FILENAME @VA05247 01592000
DS CL1 @VA05247 01593000
LFILETYP DS CL8 CMS FILETYPE @VA05247 01594000
ORG , @VA05247 01595000
DS 0D @VA05247 01596000
LSTLEND EQU (*-DOSCBLST)/8 LENGTH IN DWORDS @VA05247 01597000
EJECT @VA05247 01598000
EXTLIST DSECT @VA05247 01599000
DS 0D EXTENT, VOLUME INFO. @VA05247 01600000
EHDR DS 0CL22 @VA05247 01601000
EDDNAME DS CL7 DDNAME @VA05247 01602000
DS CL2 @VA05247 01603000
EMODE DS CL2 DISK MODE @VA05247 01604000
DS CL2 @VA05247 01605000
ELOGUNIT DS CL3 ALWAYS 'SYS' @VA05247 01606000
ELOGXXX DS CL3 LOGICAL UNIT CODE @VA05247 01607000
DS CL3 @VA05247 01608000
EEXTBEG DS CL10 BEGIN OF EXTENT @VA05247 01609000
EEXTEND DS CL10 END OF EXTENT @VA05247 01610000
DS 0D @VA05247 01611000
EXTLEND EQU (*-EXTLIST)/8 LENGTH IN DWORDS @VA05247 01612000
SPACE 1 @VA05247 01613000
DOSCB @VA05247 01614000
DMSQRY CSECT @VA05247 01615000
EJECT @VA05247 01616000
ABDSECT DSECT TO REFERENCE TABLES IN 'ABBREV @VA05247 01617000
* @VA05247 01618000
* TABLE GIVING WHEREABOUTS OF USER-DEFINED-ABBREVIATIONS@VA05247 01619000
* KEEP THE FOLLOWING SEVEN AD-CONS IN ORDER @VA05247 01620000
* @VA05247 01621000
USABRV DC F'0' NO. DBL-WORDS FREE-STORAGE IN USER-TABLE. 01622000
DC A(*-*) ADDRESS OF 1ST ITEM IN USER-ABRV-TABLE 01623000
DC F'17' (FOR BXLE) 01624000
DC A(*-*) ADDRESS OF LAST ITEM IN USER-ABRV-TABLE. 01625000
* 01626000
REGTABA DS A A(FIRSTAB):STANDARD SYNONYM TABLE 01627000
DC F'9' (FOR BXLE) 01628000
DS A A(LASTAB):END OF STANDARD SYNONYM TABLE 01629000
EJECT 01630000
SYSNAMES , @V305614 01631000
EJECT 01632000
NUCON 01633000
BGCOM 01634000
EXTSECT 01635000
REGEQU 01636000
CMSCB 01637000
FVS 01638000
EJECT 01639000
ADT 01640000
END 01641000