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