ibm:vm370-lib:cms:dmsqry.assemble_src
Table of Contents
DMSQRY Source
References
- Fixes Applied : 12
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC372DS]
Source Listing
- DMSQRY.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmsqry.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator