CQG TITLE 'DMKCQG (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000
*. 00003000
* 00004000
* MODULE NAME - 00005000
* DMKCQG 00006000
* 00007000
* FUNCTION - 00008000
* TO RETURN TO THE REQUESTOR INFORMATION FOR YHE FOLLOWING 00009000
* QUERY FUNCTIONS : 00010000
* QUERY VIRTUAL (DASD TAPE UR ETC. ) 00011000
* 00013000
* ATTRIBUTES - 00014000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00015000
* 00016000
* ENTRY POINTS - 00017000
* DMKCQGEN - TO INTERROGATE THE VIRTUAL 00018000
* MACHINE AS PER THE USERS REQUEST. 00019000
* DMKCQGFI - TO GET NUMBER OF READER, PRINTER, AND 00020000
* PUNCH FILES. 00021000
* DMKCQGLG - TO OUTPUT THE MESSAGES IN THE LOG MESSAGE BLOKS. 00022000
* 00023000
* 00024000
* ENTRY CONDITIONS - 00025000
* GPR6 - BRANCH TABLE INDEX VALUE 00026000
* GPR9 - ADDRESS OF THE COMMAND LINE BUFFER 00027000
* GPR11 - ADDRESS OF THE VMBLOK 00028000
* GPR12 - ADDRESS OF THE ENTRY POINT 00029000
* GPR13 - ADDRESS OF THE STANDARD SAVE AREA 00030000
* 00031000
* EXIT CONDITIONS - 00032000
* NORMAL - 00033000
* GPR2 = 0 00034000
* 00035000
* ERROR - 00036000
* GPR2 = ERROR MESSAGE CODE NUMBER 00037000
* 00038000
* CALLS TO OTHER ROUTINES - 00039000
* DMKSCNFD - TO LOCATE THE NEXT ARGUMENT IN THE COMMAND BUFFER 00040000
* DMKSCNAU - TO FIND THE VMBLOK FOR A SPECIFIC USERID 00041000
* DMKSCNVU - TO FIND CONTROL BLOKS FOR A VIRTUAL DEVICE 00042000
* DMKCVTHB - TO CONVERT HEXADECIMAL ADDRESS TO BINARY 00043000
* DMKCVTDB - TO CONVERT A DECIMAL NUMBER TO BINARY 00044000
* DMKCVTBD - TO CONVERT A BINARY NUMBER TO DECIMAL 00045000
* DMKCVTBH - TO CONVERT A BINARY NUMBER TO HEXADECIMAL 00046000
* DMKFREE - TO OBTAIN STORAGE FOR REGISTER SAVE 00047000
* DMKFRET - TO RETURN STORAGE TO THE SYSTEM 00048000
* DMKQCNWT - TO OUTPUT MESSAGES TO THE TERMINAL 00049000
* DMKSCNRN - TO GET REAL DEVICE NAME 00050000
* DMKERMSG - TO OUTPUT ERROR MESSAGES TO THE TERMINAL. 00051000
* DMKSCNRD - TO GET THE ADDRESS OF A DEVICE. 00052000
* DMKSCNVN - TO GET A DEVICE NAME. 00053000
* DMKCVTDT - TO GET THE DATE AND TIME. 00054000
* DMKCFCSC - SCAN OPERAND FOR RANGE OF ADDRESSES 00054100
* 00055000
*EXTERNAL REFERENCES - 00056000
* NONE 00057000
* 00058000
* TABLES/WORKAREAS - 00059000
* NONE 00060000
* 00061000
* REGISTER USAGE - 00062000
* GPR0 - LENGTH OF ARGUMENT IN LINE BUFFER(RETURNED BY DMKSCNFD 00063000
* GPR1 - ADDRESS OF NEXT ARGUMENT(RETURNED BY DMKSCNFD) 00064000
* GPR2 - PARAMETERS PASSED TO CALLED ROUTINES 00065000
* GPR3 - WORK REG AND INDEX FOR BXLE'S 00066000
* GPR4 - WORK REG AND INCREMENT REG FOR BXLE'S 00067000
* GPR5 - WORK REGISTER AND COMPARAND REG FOR BXLE'S 00068000
* GPR6 - ADDRESS OF RCHBLOK OR VCUBLOK 00069000
* GPR7 - ADDRESS OF RCUBLOK OR VCUBLOK 00070000
* GPR8 - ADDRESS OF RDEVBLOK OR VDEVBLOK 00071000
* GPR9 - ADDRESS OF COMMAND LINE BUFFER 00072000
* GPR10 - WORK REGISTER 00073000
* GPR11 - ADDRESS OF THE VMBLOK 00074000
* GPR12 - MODULE BASE REGISTER 00075000
* GPR13 - SAVEAREA BASE 00076000
* GPR14 - LINKAGE REGISTER 00077000
* GPR15 - LINKAGE REGISTER 00078000
* 00079000
EJECT 00080000
* COMMAND FORMAT - 00081000
* 00082000
* 00083000
* CLASS G 00084000
* 00085000
* 00086000
* +---------+-----------------------------------+ 00087000
* | QUERY | VIRTUAL DASD | 00088000
* | Q | TAPES | 00091000
* | | LINES | 00094000
* | | UR | 00095000
* | | GRAF | 00096000
* | | STORAGE | 00097000
* | | ALL | 00098000
* | | VADDR | 00099000
* | | VADDR1-VADDR2 | 00099100
* | | CHANNELS | 00100000
* | | | 00101000
* | | DASD | 00102000
* | | TAPES | 00103000
* | | LINES | 00104000
* | | UR | 00105000
* | | GRAF | 00106000
* | | STORAGE | 00107000
* | | ALL | 00108000
* | | VADDR | 00109000
* | | VADDR1-VADDR2 | 00109100
* | | CHANNELS | 00110000
* | | | 00111000
* | | CONS | 00112000
* | | | 00113000
* +---------+-----------------------------------+ 00114000
* 00115000
* 00125000
* OPERATION - 00126000
* 00127000
* 1. ISSUE SVC 16 TO RETURN THE SAVEAREA, THUS, WHEN EXIT 00128000
* WILL RETURN DIRECTLY TO DMKCFM COMMAND PROCESSING INSTEAD 00129000
* OF RETURNING TO DMKCFMQU. 00130000
* 2. THE PROPER ROUTINE IS ENTERED VIA A BRANCH TABLE. 00131000
* REGISTER 6 IS SET UP BY DMKCFMQU TO INDEX TO THE PROPER 00132000
* BRANCH INSTRUCTION. 00133000
* 3. EACH ROUTINE SCANS THE APPROPRIATE CONTROL BLOKS TO 00134000
* PICK UP THE INFORMATION NEEDED FOR THE REQUEST AND FORMATS 00135000
* THE MESSAGE TO BE RETURNED TO THE USER. 00136000
* STEPS 4,5,6,7,8, AND 9 DELETED. MOVED TO DMKCQR. 00136100
* 10. VIRTUAL - CALL DMKSCNFD TO LOCATE THE TYPE OF VIRTUAL 00138000
* REQUEST. IF NONE FOUND, ASSUME ALL. MATCH THE REQUEST TO 00139000
* A LIST OF VALID VIRTUAL REQUEST. THE CLASS CODE IN THE 00140000
* LIST WILL BE USED IN SETTING UP THE VARIOUS MESSAGES. 00141000
* IF STORAGE WAS REQUESTED, THE STORAGE SIZE FROM THE 00142000
* VMBLOK IS CONVERTED TO PRINTABLE CHARACTERS AND DMKQCNWT 00143000
* IS CALLED TO OUTPUT THE STORAGE MESSAGE. FOR THE I/O 00144000
* REQUESTS, THE VIRTUAL DEVICE BLOKS ARE SCANNED. WHEN THE 00145000
* CLASS OF DEVICE MATCHES THE REQUEST, THE FORMAT ROUTINE 00146000
* BUILDS AN APPROPRIATE MESSAGE ACCORDING TO THE DEVICE 00147000
* TYPE AND ITS STATUS. THEN A CALL TO DMKQCNWT IS MADE TO 00148000
* SEND THE MESSAGE TO THE TERMINAL. THIS CONTINUES UNTIL ALL 00149000
* DEVICES HAVE BEEN SCANNED. IF THE ARGUMENT DOESN'T COMPARE 00150000
* TO ANY ENTRY IN THE LIST, IT IS ASSUMED TO BE A VIRTUAL 00151000
* ADDRESS. A CALL IS MADE TO DMKCFCSC TO SCAN OPERAND TO 00152000
* SEE IF IT IS A RANGE OF ADDRESSES. IF YES, THE 00152100
* ADDRESSES ARE VALIDITY CHECKED, CONVERTED TO BINARY 00152200
* (DMKCVTHB) AND SAVED FOR LATER USE. IF ONLY A SINGLE 00152300
* ADDRESS HAS BEEN SPECIFIED, A CALL TO DMKCVTHB IS 00152400
* MADE TO CONVERT THE ADDRESS TO BINARY. IF THE CONVERT 00152500
* IS BAD, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCQG022E. 00152600
* FOR A GOOD CONVERT, CALL DMKSCNVU TO LOCATE THE VIRTUAL 00152700
* DEVICE BLOCKS. IF THE BLOCKS ARE NOT FOUND, CALL 00152800
* DMKERMSG TO SEND ERROR MESSAGE DMKCQG040E. IF THE 00152900
* DEVICE IS FOUND, FORMAT THE RESPONSE ACCORDING TO THE 00153000
* DEVICE TYPE, CALL DMKQCNWT TO SEND THE RESPONSE AND EXIT. 00153100
* 12. STEP 12 DELETED, MOVED TO CQH 00160000
* 13. IF THE REQUEST IS NOT FOUND IN THE LIST, ASSUME THE 00175000
* REQUEST TO BE A VADDR OR USERID. FIRST CHECK IF IT IS 00176000
* A VALID DEVICE ADDRESS. A CALL IS MADE TO DMKCFCSC TO 00177000
* SCAN OPERAND TO SEE IF IT IS A RANGE OF ADDRESSES. 00177100
* IF YES, THE ADDRESSES ARE VALIDITY CHECKED, CONVERTED 00177200
* TO BINARY (DMKCVTHB) AND SAVED FOR LATER USE. IF ONLY 00177300
* A SINGLE ADDRESS HAS BEEN SPECIFIED, A CALL TO DMKCVTHB 00177400
* IS MADE TO CONVERT THE ADDRESS TO BINARY. IN BOTH CASES, 00177500
* THE RESPONSE IS FORMATTED ACCORDING TO THE DEVICE TYPE, 00177600
* AND A CALL IS MADE TO DMKQCNWT TO SEND THE RESPONSE. 00177700
* IF NOT A DEVICE ADDRESS, ASSUME A USERID. CALL DMKSCNAU 00177800
* TO LOCATE THE USERID VMBLOK ADDRESS. IF NOT FOUND, CALL 00177900
* DMKERMSG TO SEND ERROR MESSAGE DMKCQG045E. IF OK, FORMAT 00178000
* THE USERID AND LINE ADDRESS, CALL DMKQCNWT TO SEND THE 00178100
* RESPONSE AND EXIT. WHEN PROCESSING A RANGE OF ADDRESSES, 00178200
* A SEPARATE RESPONSE IS FORMATTED AND ISSUED FOR EACH 00178300
* ADDRESS IN THE RANGE. 00178400
* 00184000
* RESPONSES - 00185000
* 00186000
* THE FOLLOWING ARE TYPICAL RESPONSES FOR THE QUERY COMMANDS 00187000
* COVERED IN THIS MODULE. XXX DENOTES A VIRTUAL ADDRESS AND 00188000
* YYY A REAL ADDRESS. 00189000
* 00190000
* QUERY DASD 00191000
* DASD XXX ON DASD YYY 00192000
* DASD XXX 2314 VOLID R/O NNN CYL 00193000
* DASD XXX 3330 (TEMP) R/W NNN CYL 00194000
* 00195000
* QUERY LINES 00196000
* LINE XXX ON LINE YYY 00197000
* LINE XXX ENABLED 00198000
* LINE XXX DISABLED 00199000
* 00200000
* QUERY GRAF 00201000
* GRAF XXX ON GRAF YYY 00202000
* 00203000
* QUERY VIRTUAL ALL - 00204000
* STORAGE = NNNNNK 00205000
* TAPE XXX ON TAPE YYY 00206000
* TYPE XXX ON TYPE YYY 00207000
* CONS XXX ON TYPE YYY TERM STOP 00208000
* GRAF XXX ON GRAF YYY 00209000
* RDR XXX CL X CONT HOLD READY NOEOF 00210000
* PRT XXX CL X CONT HOLD READY COPY NN 00211000
* XXX TO XXXXXXXX DIST DDDDDDDD FLASHC FF 00211300
* XXX FLASH FFFF CHAR CCCC MDFY CCCC FCB FFFF 00211600
* PUN XXX CL X CONT HOLD READY COPY NN 00212000
* PUN XXX TO USERID DIST DISTCODE 00213000
* DASD XXX 2314 VOLID R/O NNN CYL 00214000
* LINE XXX ENABLED 00215000
* DEV XXX PSEUDO TIMER 00216000
* DASD XXX 3330 (TEMP) R/W NNN CYL 00217000
* CHANNELS XXX 00218000
* MSC XXX ON DEV YYY 00218100
* 00219000
* 00220000
* 00235000
* 00236000
* 00237000
* 00238000
* 00239000
* ERROR MESSAGES - 00240000
* DMKCQG022E VADDR MISSING OR INVALID 00242000
* DMKCQG026E OPERAND MISSING OR INVALID 00242100
* DMKCQG040E DEV (ADDR) DOES NOT EXIST 00244000
* DMKCQG045E (USERID) NOT LOGGED ON 00246000
* 00247000
*. 00248000
EJECT 00249000
DMKCQG CSECT 00250000
MODID DC CL8'DMKCQG' @V200930 00251000
USING PSA,R0 00252000
USING VMBLOK,R11 00253000
USING SAVEAREA,R13 00254000
SPACE 00255000
EXTRN DMKCVTDT 00256000
EXTRN DMKCVTDB 00257000
EXTRN DMKSCNVU 00258000
EXTRN DMKCVTBD 00259000
EXTRN DMKCVTBH 00260000
EXTRN DMKSCNAU 00261000
EXTRN DMKCVTHB 00262000
EXTRN DMKSCNFD 00263000
EXTRN DMKERMSG 00264000
EXTRN DMKSCNVN 00265000
EXTRN DMKSCNRN @V200930 00266000
EXTRN DMKSCNRD 00267000
EXTRN DMKCFCSC RANGE SCAN @V407466 00267100
SPACE 00268000
ENTRY DMKCQGEN 00269000
EJECT 00270000
* THIS ROUTINE IS CALLED BY DMKCFMQU. SINCE THERE IS NO NEED 00271000
* TO RETURN TO CFMQU, THE SAVEAREA POINTED TO BY REGISTER 13 00272000
* WILL BE RELEASED. THUS, WHEN THIS ROUTINE RETURNS IT WIL 00273000
* GO DIRECTLY BACK TO CFM TO SCAN FOR THE NEXT COMMAND. 00274000
* UPON ENTRY GPR6 HAS BEEN SET UP BY CFMQU TO INDEX INTO THE 00275000
* LIST OF BRANCHES ACCORDING TO ARGUMENT FOUND,THEREFORE THE 00276000
* ORDER OF BRANCHES MUST BE THE SAME AS THE LIST IN CFMQU. 00277000
SPACE 2 00278000
USING *,R12 00279000
DMKCQGEN SVC 16 GIVE UP SAVEAREA - USE CFMQU SAVEAREA 00280000
SL R12,=A(DMKCQGEN-DMKCQG) SET ADDRESSING @V200930 00281000
USING DMKCQG,R12 @V200930 00282000
STM R0,R1,SAVER0 SAVE REG 0-1 IN NEW SAVE AREA. 00283000
MVC SAVEWRK1(4),ZEROES ZERO FLAG AREA 00284000
SLR R2,R2 CLEAR R2 @V407466 00284100
ST R2,SAVER2 ZERO RETURN CODE @V407466 00284200
EX 0,QUERYGN(R6) GR6 = TABLE INDEX SET BY DMKCFM @VM08820 00285000
B QRYSCAN GO FORMAT DEVICE-CLASS QUERY @VM08820 00286000
SPACE 2 00287000
QUERYGN DS 0H ACTION TABLE FOR DMKCQGEN @VM08820 00288000
B QRYADDR QUERY VADDR / USERID @VM08820 00289000
B QRYEXIT RESERVED @VA13360 00290000
B QRYEXIT RESERVED @VA13360 00291000
B QRYEXIT RESERVED @VA13360 00292000
B QRYVIRT QUERY VIRTUAL XXX @VM08820 00293000
MVI SAVEWRK1,CLASDASD QUERY DASD @VM08820 00294000
MVI SAVEWRK1,CLASTAPE QUERY TAPE @VM08820 00295000
MVI SAVEWRK1,CLASTERM QUERY LINES @VM08820 00296000
MVI SAVEWRK1,CLASURI+CLASURO QUERY UR @VM08820 00297000
B QRYCORE QUERY STORAGE @VM08820 00298000
B QRYVALL QUERY ALL @VM08820 00299000
MVI SAVEWRK1,CLASGRAF QUERY GRAF @VM08820 00300000
MVI SAVEWRK1,CLASTERM+X'01' QUERY CONSOLE @VM08820 00301000
B QRYCHAN QUERY CHANNELS @VA01771 00302000
SPACE 3 00303000
QRYWRIT EQU * WRITE A SINGLE RESPONSE LINE @VM08820 00304000
CALL DMKQCNWT,PARM=NORET GR0, GR1 ALL SET @VM08820 00305000
SPACE 00306000
QRYEXIT EQU * RETURN TO DMKCFM @VM08820 00307000
EXIT @VM08820 00308000
EJECT 00309000
QRYVIRT EQU * QUERY VIRTUAL XXX @VM08820 00310000
CALL DMKSCNFD SCAN FOR ANOTHER OPERAND @VM08820 00311000
BNZ QRYVALL 'QUERY VIRTUAL ALL' = DEFAULT @VM08820 00312000
CL R0,F8 IS THE OPERAND VALID ? @VM08820 00313000
BH CQG022 NO -- ERROR MESSAGE @VM08820 00314000
LR R2,R0 OPERAND LENGTH TO GR2 @VM08820 00315000
BCTR R2,0 DECREMENT FOR COMPARE @VM08820 00316000
LA R3,QRYTABL START OF OPERAND TABLE @VM08820 00317000
LA R4,QRYTLEN . . .ENTRY LENGTH @VM08820 00318000
LA R5,QRYTEND . . .END OF TABLE @VM08820 00319000
QRYTYPE EQU * VALIDATE SECOND OPERAND @VM08820 00320000
CLM R2,1,8(R3) LONG ENOUGH FOR THIS ONE ? @VM08820 00321000
BL QRYBXLE NO -- SKIP TO NEXT ENTRY @VM08820 00322000
EX R2,QRYCOMP COMPARE FOR OPERAND MATCH @VM08820 00323000
BNE QRYBXLE NO -- SKIP TO NEXT ENTRY @VM08820 00324000
SLR R2,R2 @VM08820 00325000
IC R2,9(0,R3) PICK UP ACTION TABLE INDEX @VM08820 00326000
EX 0,QUERYGN(R2) SET FLAGS OR BRANCH @VM08820 00327000
B QRYSCAN FORMAT CLASS QUERY OUTPUT @VM08820 00328000
SPACE 00329000
QRYBXLE EQU * @VM08820 00330000
BXLE R3,R4,QRYTYPE SEARCH THE OPERAND TABLE @VM08820 00331000
SPACE 2 00332000
QRYADDR EQU * QUERY VIRTUAL XXX / QUERY XXX @VM08820 00333000
TM VMCLEVEL,VMCLASSG CLASS G USER 00334000
BZ CQG026 NO - NOT ALLOWED 00335000
STM R0,R1,SAVEWRK8 SAVE POINTERS FOR ERROR MSG @VM08820 00336000
CL R0,F7 MORE THAN 7 CHARACTERS @V407466 00337000
BH QRYUSER YES, TRY USERID @V407466 00337010
LA R2,DASH PREPARE FOR RANGE SCAN @V407466 00337020
CALL DMKCFCSC SEE IF RANGE SPECIFIED @V407466 00337030
BZ NORANGE NO '-' FOUND IN OPERAND @V407466 00337040
CR R1,R2 INVALID IF '-' FIRST CHAR. @V407466 00337050
BNL QRYUSER TREAT AS USERID @V407466 00337060
LR R3,R2 ... @V407466 00337070
SR R3,R1 LENGTH OF RADDR1 FIELD @V407466 00337080
LR R4,R0 ENTIRE OPERAND LENGTH @V407466 00337090
LR R0,R3 RADDR1 LENGTH @V407466 00337100
MVI 0(R2),BLANK REPLACE '-' WITH BLANK @V407466 00337110
CALL DMKCVTHB CONVERT TO BINARY @V407466 00337120
LR R0,R4 OPERAND LENGTH @V407466 00337130
MVI 0(R2),CHARDASH PUT DASH BACK IN OPERAND @V407466 00337140
BNZ QRYUSER TREAT AS USERID @V407466 00337150
STH R1,RADDR1 SAVE FIRST ADDR IN RANGE @V407466 00337160
LA R1,1(,R2) PT TO SECOND RADDR IN RANGE @V407466 00337170
LR R2,R4 ENTIRE OPERAND LENGTH @V407466 00337180
SR R2,R3 RADDR2 LENGTH @V407466 00337190
BCTR R2,0 MINUS ONE FOR '-' @V407466 00337200
CL R2,F3 MORE THAN THREE CHARACTERS @VA09175 00337203
BH QRYUSER NOT A VALID ADDRESS @VA09175 00337206
LR R0,R2 TO R0 @V407466 00337210
CALL DMKCVTHB CONVERT SEC. ADDR IN RANGE @V407466 00337220
LR R0,R4 ENTIRE OPERAND LENGTH @V407466 00337230
BNZ QRYUSER TREAT AS USERID @V407466 00337240
LH R4,RADDR1 FIRST ADD IN RANGE @V407466 00337250
CR R1,R4 RADDR2 > RADDR1 @V407466 00337260
BNH QRYUSER TREAT AS USERID @V407466 00337270
STH R1,RADDR2 STORE RADDR2 IN SAVEWRK7+2 @V407466 00337280
OI QRYBITS,RANGE INDICATE PROCESSING RANGE @V407466 00337290
LH R1,RADDR1 FIRST RADDR IN RANGE @V407466 00337300
ST R1,SAVEWRK6 SAVE FOR LATER @V407466 00337310
B MAXDEVB SEE IF EXCEED MAX VIRT. DEVICE @V407466 00337320
NORANGE CL R0,F3 ARG. TOO BIG FOR ADDR? @V407466 00337330
BH QRYUSER . . .BUT IT MIGHT BE A USERID @VM08820 00338000
CALL DMKCVTHB IF NOT IN LIST, MUST BE VADDR @VM08820 00339000
BNZ QRYUSER NOT AN ADDRESS - TRY USERID @VM08820 00340000
MAXDEVB LR R3,R1 SAVE DEVICE ADDRESS FOR NOW @V407466 00341000
LA R0,15(0) ACQUIRE 15 DWDS WORK AREA @V407466 00341050
CALL DMKFREE ACQUIRE STORAGE @V407466 00341100
LR R9,R1 BUFFER ADDR TO R9 @V407466 00341150
LR R1,R3 RESTORE DEVICE ADDRESS @V407466 00341200
TM QRYBITS,RANGE RANGE PROCESSING? @V407466 00341250
BZ MAXDEV NO, DON'T SET RANGE BIT @V407466 00341300
OI QRYBITS,PASS1 INDICATE STORAGE ACQUIRED @V407466 00341350
MAXDEV MAXDV R15 GET MAX VALID ADDR IN GR15 @V407466 00341400
CR R1,R15 IS THIS A VALID ADDRESS ? @VM08820 00342000
LA R2,22 ERROR MESSAGE NUMBER = 22E @V407466 00343000
BH CQG022A TST FOR RANGE BEFORE MSG @V407466 00343100
LR R3,R1 SAVE THE BINARY VALUE @VM08820 00344000
CALL DMKSCNVU TRY TO FIND THE VDEVBLOK @VM08820 00345000
LA R2,40 ERROR MESSAGE NUMBER = 40E @V407466 00346000
BNZ CQG040A VIRTUAL DEVICE DOES NOT EXIST @V407466 00346100
MVI SAVEWRK1+1,X'FF' DEVICE BLOCKS ALREADY FOUND @VM08820 00347000
B SKIPSTOR STORAGE ALREADY ACQUIRED @V407466 00348000
SPACE 00349000
QRYCOMP CLC 0(*-*,R1),0(R3) QUERY VIRTUAL COMPARE @VM08820 00350000
DASH DC C'-' RANGE DELIMITER @V407466 00350100
CHARDASH EQU C'-' RANGE DELIMITER @V407466 00350200
EJECT 00351000
QRYUSER NI QRYBITS,X'FF'-RANGE TURN OFF RANGE @V407466 00352000
LTR R6,R6 WAS IT QUERY VIRTUAL XXX ? @VM08820 00353000
BNZ CQG022 YES - VADDR MISSING OR INVALID @VM08820 00354000
LM R0,R1,SAVEWRK8 PICK UP OPERAND POINTERS @VM08820 00355000
CALL DMKSCNAU IS THE USER LOGGED ON NOW ? @VM08820 00356000
BNZ CQG045 NOPE - ERROR MESSAGE @VM08820 00357000
LR R11,R1 TEMPORARILY SWITCH VMBLOK'S @VM08820 00358000
MVC SAVEWRK2(8),VMUSER MOVE IN THE USERID @VM08820 00359000
MVC SAVEWRK4(6),=C' - DSC' PERHAPS DISCONNECTED @VM08820 00360000
TM VMOSTAT,VMDISC HOW DO WE STAND NOW ? @VM08820 00361000
BO QRYUDSC ALL SET AS IS @VM08820 00362000
ICM R8,B'1111',VMTERM IS THERE ANYTHING? @VA10569 00363300
BZ QRYUDSC NO...BRANCH. @VA10569 00363600
CLI RDEVTYPC-RDEVBLOK(R8),CLASTERM IS CLASS TERMINAL 00364000
BNE *+12 NO, BYPASS TEST FOR BISYNC LINE 00365000
CLI RDEVTYPE-RDEVBLOK(R8),TYPBSC IS THIS A LINE 00366000
BE QRYUNCP YES, GET RESOURCE ID. 00367000
CLI RDEVTYPC-RDEVBLOK(R8),CLASSPEC NCP TERM ? @VM08820 00368000
BE QRYUNCP YES -- @VM08820 00369000
TM RDEVADD-RDEVBLOK(R8),RDEVLDEV Is this an LDEV? HRC065DK 00369100
BO QRYLDEV Yes HRC065DK 00369200
CALL DMKSCNRD GET 'CCU' ADDRESS IN GR1 @VM08820 00370000
CALL DMKCVTBH CONVERT IT FOR OUTPUT @VM08820 00371000
STCM R1,B'0111',SAVEWRK4+3 INSERT ADDRESS IN MSG @VM08820 00372000
B QRYUDSC GO TYPE THE MESSAGE @VM08820 00373000
SPACE 00374000
QRYLDEV EQU * HRC065DK 00374100
LH R1,RDEVADD-RDEVBLOK(,R8) Get the LDEV address HRC065DK 00374200
N R1,F4095 Keep only the dev num HRC065DK 00374300
CALL DMKCVTBH Make it displayable HRC065DK 00374400
STCM R1,7,SAVEWRK4+3 Put dev addr in message HRC065DK 00374500
MVI SAVEWRK4+2,C'L' Move in LDEV indicator HRC065DK 00374600
B QRYUDSC Go display msg HRC065DK 00374700
* 00374800
QRYUNCP EQU * FORMAT OUTPUT FOR NCP TERMINAL @VM08820 00375000
LH R1,VMTRMID NCP RESOURCE REFERENCE @VM08820 00376000
CALL DMKCVTBH CONVERT IT FOR OUTPUT @VM08820 00377000
STCM R1,15,SAVEWRK4+2 INSERT ADDRESS IN MSG @VM08820 00378000
SPACE 00379000
QRYUDSC EQU * SETUP FOR MESSAGE OUTPUT @VM08820 00380000
L R11,SAVER11 BACK TO CALLER'S VMBLOK @VM08820 00381000
LA R1,SAVEWRK2 START OF RESPONSE LINE @VM08820 00382000
LA R0,14(0) . . .AND IT'S LENGTH @VM08820 00383000
B QRYWRIT SEND SINGLE MESSAGE AND EXIT @VM08820 00384000
EJECT 00385000
QRYVALL EQU * QUERY ALL / QUERY VIRTUAL ALL @VM08820 00386000
OI SAVEWRK1,VIRTALL FORMAT ALL DEVICES @VM08820 00387000
SPACE 00388000
QRYCORE EQU * QUERY (VIRTUAL) STORAGE @VM08820 00389000
L R1,VMSTOR VIRTUAL MACHINE STOR SIZE @V304635 00390000
SRL R1,10 MAKE SIZE = K 00391000
CALL DMKCVTBD CONVERT SIZE TO DECIMAL 00392000
STCM R1,15,SAVEWRK4+3 STORE LOW FOUR BYTES 00393000
STC R0,SAVEWRK4+2 STORE HIGH BYTE 00394000
MVC SAVEWRK2(7),STORAGE SET UP REST OF MESSAGE 00395000
MVC SAVEWRK3+3(3),=C' = ' . . . 00396000
MVI SAVEWRK5+3,C'K' . . . 00397000
LA R0,16 MESSAGE SIZE 00398000
LA R1,SAVEWRK2 SET BUFFER ADDRESS @V200930 00399000
BAL R3,STACK STACK OUTPUT @V200930 00400000
TM SAVEWRK1,VIRTALL WAS 'ALL' REQUESTED ? @VM08820 00401000
BZ QRYEXIT NO -- ALL DONE @VM08820 00402000
SPACE 1 00403000
QRYCHAN MVC SAVEWRK2(14),=C'CHANNELS = BMX' ASSUME BMX CHAN.@VA01771 00404000
LA R0,14 MESSAGE LENGTH @VA01771 00405000
LA R1,SAVEWRK2 SET BUFFER ADDRESS @VA01771 00406000
TM VMFSTAT,VMFBMX ARE THEY BMX CHANNELS @VA01771 00407000
BO *+10 YES - MESSAGE ALL SET. @VA01771 00408000
MVC SAVEWRK2+11(3),=C'SEL' CHANGE TO SELECTOR @VA01771 00409000
BAL R3,STACK STACK OUTPUT LINE. @VA01771 00410000
TM SAVEWRK1,VIRTALL WAS 'ALL' REQUESTED ? @VA01771 00411000
BZ QRYEXIT NO - ALL DONE @VA01771 00412000
SPACE 2 00413000
* THE FOLLOWING CODE SCANS FOR ACTIVE VIRTUAL DEVICES FOR BOTH 00414000
* VIRTUAL ALL REQUEST AND SPECIFIC CLASS REQUEST. QRYVSCAN IS 00415000
* THE ENTRY FOR SPECIFIC CLASS REQUEST. IF ALL HAS BEEN 00416000
* REQUESTED, WOULD HAVE COME HERE VIA LABEL QRYVALL. 00417000
* 00418000
SPACE 2 00419000
QRYSCAN EQU * QUERY BY DEVICE CLASS @VM08820 00420000
TM QRYBITS,RANGE RANGE PROCESSING? @V407466 00421000
BZ GETSTOR NO, ACQUIRE MSG BUFFER STORAGE @V407466 00421100
TM QRYBITS,PASS1 FIRST PASS @V407466 00421200
BO SKIPSTOR NO, STORAGE ALREADY ACQUIRED @V407466 00421300
OI QRYBITS,PASS1 INDICATE NOT FIRST PASS @V407466 00421400
GETSTOR LA R0,15(0) GET 15 DBL-WD WORK BUFFER @V407466 00421500
CALL DMKFREE GET CORE FOR REGISTER SAVE 00422000
LR R9,R1 POINT R9 TO GOTTEN CORE 00423000
USING REGSAVE,R9 00424000
SKIPSTOR XC REGSAVE(32),REGSAVE ZERO FIRST PART OF MSG BUFF @V407466 00424100
CLI SAVEWRK1+1,X'00' IS A FULL SCAN REQUIRED ? @VM08820 00425000
BE SRCHAN YES - START WITH CHANNELS @VM08820 00426000
BAL R10,QRYVFMT YES, FORMAT DEVICE LINE @V200930 00427000
TM QRYBITS,RANGE RANGE PROCESSING @V407466 00428000
BZ QRYVFRET NO, FRET BUFFER AND EXIT @V407466 00428100
USING REGSAVE,R9 ESTABLISH ADDRESSABILITY @V407466 00428200
NEXTADDR XC REGSAVE(32),REGSAVE CLEAR FIRST PART OF BUFFER @V407466 00428300
L R1,SAVEWRK6 CURRENT ADDRESS @V407466 00428400
LA R1,1(,R1) UP BY ONE @V407466 00428500
CH R1,RADDR2 END OF RANGE? @V407466 00428600
BH QRYVFRET YES, RELEASE STORAGE BUFFER @V407466 00428700
ST R1,SAVEWRK6 SAVE NEW CURRENT ADDRESS @V407466 00428800
B MAXDEV VER NEXT ADDR NOT > MAX VIRT ADDR@V407466 00428900
EJECT 00429000
SRCHAN DS 0H @V200930 00430000
SR R1,R1 ZERO CHANNEL INDEX 00431000
LA R4,2 LOAD INCREMENT REGISTER 00432000
LA R5,30 LOAD END OF INDEX TABLE 00433000
QRYVNCH LH R6,VMCHTBL(R1) LOAD INDEX TO NEXT VIRT CHANNEL 00434000
LTR R6,R6 CHANNEL EXIST ? 00435000
BM QRYVCHI NO, TRY NEXT 00436000
A R6,VMCHSTRT POINT R6 TO VCHBLOK 00437000
USING VCHBLOK,R6 00438000
SR R2,R2 ZERO CU TABLE INDEX 00439000
QRYVNCU LH R7,VCHCUTBL(R2) LOAD INDEX TO NEXT VIRT CU 00440000
LTR R7,R7 DOES IT EXIST ? 00441000
BM QRYVCUI NO TRY NEXT 00442000
A R7,VMCUSTRT LOAD VCUBLOK IN R7 00443000
USING VCUBLOK,R7 00444000
SR R3,R3 ZERODEVICE TABLE INDEX 00445000
QRYVNDV LH R8,VCUDVTBL(R3) LOAD INDEX TO NEXT VDEVBLOK 00446000
LTR R8,R8 DOES DEVICE EXIST ? 00447000
BM QRYVDVI NO TRY NEXT 00448000
A R8,VMDVSTRT POINT R8 TO VDEVBLOK 00449000
USING VDEVBLOK,R8 00450000
TM SAVEWRK1,VIRTALL IS THIS VIRT ALL REQUEST ? @VM08820 00451000
BO QRYVSAVE YES GO FORMAT AND SEND REPLY 00452000
SLR R0,R0 @VM08820 00453000
ICM R0,8,SAVEWRK1 PICK UP DEVICE CLASS @VM08820 00454000
N R0,VDEVTYPC IS THIS THE CORRECT CLASS ? @VM08820 00455000
BZ QRYVDVI NO -- SKIP TO NEXT DEVICE @VM08820 00456000
TM SAVEWRK1,X'01' LOOKING FOR CONSOLE @VA02423 00457000
BZ QRYVSAVE NO, GO ON @VA02423 00458000
CLI VDEVTYPE,TYP3210 YES, IS THIS IT @VA02423 00459000
BNE QRYVDVI NO, THEN KEEP LOOKING @VA02423 00460000
QRYVSAVE STM R1,R8,REGSAVE SAVE INDEX REGISTERS @V200930 00461000
MVI SAVEWRK1+1,X'FF' HAVE FOUND AN ACTIVE UNIT @VM08820 00462000
BAL R10,QRYVFMT GO FORMAT MESSAGE AND SEND REPLY 00463000
LM R1,R8,REGSAVE RESTORE INDEX REGISTERS @V200930 00464000
QRYVDVI BXLE R3,R4,QRYVNDV INCREMENT THRU DEVICES 00465000
QRYVCUI BXLE R2,R4,QRYVNCU INCREMENT THRU CONTROL UNITS 00466000
QRYVCHI BXLE R1,R4,QRYVNCH INCREMENT THRU CHANNELS 00467000
SPACE 00468000
* WHEN FALL THRU HAVE SCANNED ALL DEVICES 00469000
EJECT 00470000
QRYVFRET LA R0,15 BUFFER SIZE @V200930 00471000
LR R1,R9 SET UP R1 FOR FRET 00472000
CALL DMKFRET GIVE BACK CORE 00473000
DROP R6,R7,R8,R9 00474000
SPACE 00475000
CLI SAVEWRK1+1,X'00' WAS A DEVICE FOUND ? @VM08820 00476000
BNE QRYEXIT YES - ALL DONE @VM08820 00477000
TM QRYBITS,RANGE RANGE BEING PROCESSED? @V407466 00477100
BO QRYEXIT YES, ALL DONE @V407466 00477200
MVC SAVEWRK3(16),=C' DO NOT EXIST ' RESPONSE @VM08820 00478000
LA R0,18(0) LENGTH OF FAILURE RESPONSE @VM08820 00479000
LA R1,SAVEWRK2 START FOR MESSAGE OUTPUT @VM08820 00480000
MVC SAVEWRK2(5),DASD MAYBE IT WAS DASD @VM08820 00481000
CLI SAVEWRK1,CLASDASD CORRECT ? @VM08820 00482000
BE QRYWRIT YES -- @VM08820 00483000
MVC SAVEWRK2(5),TAPES MAYBE IT WAS TAPES @VM08820 00484000
CLI SAVEWRK1,CLASTAPE CORRECT ? @VM08820 00485000
BE QRYWRIT YES -- @VM08820 00486000
MVC SAVEWRK2(5),GRAF MAYBE IT WAS GRAF @VM08820 00487000
CLI SAVEWRK1,CLASGRAF CORRECT ? @VM08820 00488000
BE QRYWRIT YES -- @VM08820 00489000
MVC SAVEWRK2(5),SPOOL MAYBE IT WAS UR @VM08820 00490000
CLI SAVEWRK1,CLASURI+CLASURO CORRECT ? @VM08820 00491000
BE QRYWRIT YES -- @VM08820 00492000
MVC SAVEWRK2(5),LINES MAYBE IT WAS LINES @VM08820 00493000
CLI SAVEWRK1,CLASTERM CORRECT ? @VM08820 00494000
BE QRYWRIT YES -- @VM08820 00495000
MVC SAVEWRK2(4),CONS MAYBE IT WAS CONSOLE @VM08820 00496000
MVI SAVEWRK3,X'40' . . . @VM08820 00497000
CLI SAVEWRK1,CLASTERM+X'01' CORRECT ? @VM08820 00498000
BE QRYWRIT YES -- @VM08820 00499000
MVC SAVEWRK2(4),=C'DEVS' MUST HAVE BEEN 'ALL' @VM08820 00500000
B QRYWRIT . . . @VM08820 00501000
EJECT 00502000
* 00503000
* THE FOLLOWING IS THE SUBROUTINE TO FORMAT THE MESSAGES 00504000
* ACCORDING TO THE CLASS OF THE DEVICE 00505000
* 00506000
* 00507000
SPACE 2 00508000
USING VCHBLOK,R6 00509000
USING VCUBLOK,R7 00510000
USING VDEVBLOK,R8 00511000
USING REGSAVE,R9 @V200930 00512000
QRYVFMT MVC DATAREC(8),BLANKS CLEAR @V200930 00513000
MVC DATAREC+1(DATARECL-1),DATAREC @V200930 00514000
LH R1,VDEVADD LOAD DEVICE ADDRESS 00515000
LH R0,VCUADD LOAD CONTOL UNIT ADDRESS 00516000
OR R1,R0 COMBINE CU AND DEV ADDRESSES 00517000
AH R1,VCHADD COMPLETE ADDRESS 00518000
CALL DMKCVTBH CONVERT TO PRINT FORM 00519000
STCM R1,7,DATAREC+5 DEV ADDR @V200930 00520000
CALL DMKSCNVN GET DEVICE NAME IN EBCDIC 00521000
ST R1,DATAREC MSG HEADER @V200930 00522000
TM VDEVSTAT,VDEVDED IS THE DEVICE DEDICATED ? 00523000
BO DEDICATE YES - 'DEV CCU ON DEV CCU' 00524000
TM VDEVTYPC,CLASURI+CLASURO UNIT REC. DEVICE 00525000
BNZ QRYVURIO YES,, TAKE THE BR. 00526000
CLI VDEVTYPC,CLASDASD IS IT A DASD 00527000
BE QRYVDASD YES 00528000
CLI VDEVTYPC,CLASTERM IS IT A TERMINAL ? 00529000
BE QRYVTERM YES 00530000
B QRYVSPEC 00531000
SPACE 2 00532000
QRYVURIO TM VDEVTYPC,CLASURO IS IT OUTPUT DEVICE ?? @V200930 00533000
BO QRYVURI YES, SKIP TIMER TEST @V200930 00534000
TM VDEVTYPE,TYPTIMER IS IT PSEUDO TIMER ? 00535000
BZ QRYVURI NO,, BRANCH 00536000
MVC DATAREC+9(12),=C'PSEUDO TIMER' @V200930 00537000
LA R0,21 GET LNG ON LINE 00538000
B WRTVIRT PRINT IT 00539000
EJECT 00540000
QRYVURI MVC DATAREC+9(2),=C'CL' @V200930 00541000
MVC DATAREC+12(1),VDEVCLAS SET CLASS @V200930 00542000
MVC DATAREC+15(6),=CL6'NOCONT' @V200930 00543000
TM VDEVSFLG,VDEVCONT CONTINUOUS SPOOLING ?? 00544000
BZ NOCONT NO,, BRANCH 00545000
MVC DATAREC+15(2),BLANKS @V200930 00546000
NOCONT MVC DATAREC+22(6),=CL6'NOHOLD' @V200930 00547000
TM VDEVSFLG,VDEVHOLD IS UR BEING BEING HELD ?? 00548000
BZ NOHOLD IF NOT,, BRANCH 00549000
MVC DATAREC+22(2),BLANKS @V200930 00550000
NOHOLD MVC DATAREC+37(8),=C'NOTREADY' FLAG NOT READY @V200930 00551000
TM VDEVSTAT,VDEVNRDY TST IF NOT READY @V200930 00552000
BO NOTRDY YES, OK @V200930 00553000
MVC DATAREC+37(3),BLANKS MARK READY @V200930 00554000
NOTRDY DS 0H @V200930 00555000
TM VDEVTYPC,CLASURI READER ????? 00556000
BO NOHOLDRD YES -- BYPASS COPIES-- 00557000
LH R1,VDEVCOPY PICK UP COPIES ASKED FOR 00558000
CALL DMKCVTBD CONVERT 00559000
STCM R1,3,DATAREC+34 SET COPIES @V200930 00560000
MVC DATAREC+29(4),=C'COPY' MOVE IN LITERAL @VA09683 00561010
L R1,VDEVEXTN XBLOK ADDRESSIBILITY @VMI0058 00561100
USING VSPXBLOK,R1 ADDRESSIBILITY @VMI0058 00561200
TM VSPXFLG1,VSPXCPYF SPEC. COPY FLAG ON? @VMI0058 00561300
BZ NOTON XFER IF NOT @VMI0058 00561400
MVC DATAREC+29(5),=C'CPY *' SQUEEZE IN INLINE DUP@VA09683 00561510
DROP R1 NO LONGER NEEDED @VMI0058 00561600
NOTON LA R0,50 DATA SIZE @VMI0058 00561700
LA R1,DATAREC DATA AREA POINTER @V407466 00562100
TM QRYBITS,RANGE RANGE PROCESSING? @V407466 00562200
BZ STACKIT2 NO, DO NOT ADJUST DATA POINTER @V407466 00562300
LA R1,DATAREC-1 ADJUST FOR SPECIAL FLAG @V407466 00562400
STACKIT2 BAL R3,STACK PLACE MSG BUFFER ON STACK @V407466 00562500
MVC DATAREC(4),BLANKS FORMAT NEXT LINE @V200930 00565000
MVI DATAREC+9,C' ' CLEAR AREA @V200930 00566000
MVC DATAREC+10(50),DATAREC+9 .. @V200930 00567000
MVC DATAREC+9(3),=C'FOR' SET FOR @V200930 00568000
MVC DATAREC+13(8),VMUSER SET USERID @V200930 00569000
L R1,VDEVEXTN XBLOK ADDRESS @V293598 00570000
TM VDEVSFLG,VDEVXFER+VDEVFOR IS IT TO OR FOR @V200930 00571000
BZ NOTXFER NO, CONT @V200930 00572000
MVC DATAREC+13(8),VSPXXUSR-VSPXBLOK(R1) SET USERID @V293598 00573000
TM VDEVSFLG,VDEVFOR IS IT FOR USERID ?? @V200930 00574000
BO NOTXFER YES, CONT @V200930 00575000
MVC DATAREC+9(3),=C'TO ' SET TO USERID @V200930 00576000
NOTXFER MVC DATAREC+22(4),=C'DIST' SET DIST @V200930 00577000
MVC DATAREC+27(8),VMDIST ASSUME 'FOR' OFF @V293598 00578000
TM VDEVSFLG,VDEVFOR IS IT OFF ?? @V293598 00579000
BZ FLCNT IF YES, BRANCH @V60B9BA 00580000
MVC DATAREC+27(8),VSPXDIST-VSPXBLOK(R1) MOVE IN @VA10878 00581010
* DIST CODE 00581020
FLCNT TM VDEVTYPE,TYPPRT PRINTER ? @V60B9BA 00581050
BZ SETWRT XFER IF NOT @V60B9BA 00581100
MVC DATAREC+37(6),=C'FLASHC' FLASH COUNT FOR 3800 @V60B9BA 00581150
LR R2,R1 NEW POINTER FOR VSPXBLOK @V60B9BA 00581200
USING VSPXBLOK,R2 ADDRESSIBILITY @V60B9BA 00581250
SR R1,R1 GET THE FLASH COUNT @V60B9BA 00581300
IC R1,VSPXFLSH ... @V60B9BA 00581350
CALL DMKCVTBD CONVERT TO EBCDIC @V60B9BA 00581400
STCM R1,B'0011',DATAREC+44 PUT IT IN DATA AREA @V60B9BA 00581450
LA R0,55 DATA SIZE @V60B9BA 00581500
LA R1,DATAREC DATA AREA POINTER @V60B9BA 00581550
TM QRYBITS,RANGE RANGE PROCESSING ? @V60B9BA 00581600
BZ STACKIT3 XFER IF NOT @V60B9BA 00581650
LA R1,DATAREC-1 ADJUST FOR SPECIAL FLAG @V60B9BA 00581700
STACKIT3 BAL R3,STACK PLACE MSG BUFFER ON STACK @V60B9BA 00581750
L R2,VDEVEXTN RETORE VSPXBLOK ADDRESS @V60B9BA 00581800
MVI DATAREC+9,C' ' CLEAR THE MESSAGE AREA @V60B9BA 00581850
MVC DATAREC+10(60),DATAREC+9 .... @V60B9BA 00581900
MVC DATAREC+9(5),=C'FLASH' FLASH NAME @V60B9BA 00581950
MVC DATAREC+15(4),VSPXOVLY ... @V60B9BA 00582000
OC DATAREC+15(4),BLANKS MAKE IT PRINTABLE @V60B9BA 00582050
MVC DATAREC+21(4),=C'CHAR' CHAR VALUE @V60B9BA 00582100
MVC DATAREC+26(4),VSPXCHAR ... @V60B9BA 00582150
OC DATAREC+26(4),BLANKS MAKE IT PRINTABLE @V60B9BA 00582200
MVC DATAREC+32(4),=C'MDFY' MODIFY VALUE @V60B9BA 00582250
MVC DATAREC+37(4),VSPXCMOD ... @V60B9BA 00582300
OC DATAREC+37(4),BLANKS MAKE IT PRINTABLE @V60B9BA 00582350
MVC DATAREC+43(3),=C'FCB' FCB VALUE @V60B9BA 00582400
MVC DATAREC+47(4),VSPXFCB ... @V60B9BA 00582450
OC DATAREC+47(4),BLANKS MAKE IT PRINTABLE @V60B9BA 00582500
DROP R2 NO LONGER NEEDED @V60B9BA 00582550
LA R0,60 DATA SIZE @V60B9BA 00582600
B WRTVIRT STACK LINE @V60B9BA 00582650
NOHOLDRD MVC DATAREC+29(5),=C'NOEOF' @V200930 00583000
TM VDEVSFLG,VDEVEOF INDICATE EOF VIA UE ?? 00584000
BZ SETWRT WRITE IT @V200930 00585000
MVC DATAREC+29(2),BLANKS @V200930 00586000
SETWRT LA R0,45 SIZE @V200930 00587000
B WRTVIRT NOW, PRINT IT 00588000
EJECT 00589000
QRYVDASD EQU * VIRTUAL DASD 00590000
MVC DATAREC+9(4),=C'2305' @V200930 00591000
TM VDEVTYPE,TYP2305 IS IT A 2305 00592000
BO QRYVMINI IF YES, BRANCH 00593000
MVC DATAREC+9(4),=C'3350' @V304498 00594000
CLI VDEVTYPE,TYP3350 IS IT A 3350 ? @V304498 00595000
BE QRYVMINI IF YES BRANCH @V304498 00596000
MVC DATAREC+9(4),=C'3380' HRC011DK 00596200
CLI VDEVTYPE,TYP3380 IS IT A 3380 ? HRC011DK 00596400
BE QRYVMINI IF YES BRANCH HRC011DK 00596600
MVC DATAREC+9(4),=C'3330' @V200930 00597000
TM VDEVTYPE,TYP3330 IS IT ? 00598000
BO QRYVMINI YEP, BRANCH 00599000
MVC DATAREC+9(4),=C'3340' @V2A2029 00600000
TM VDEVTYPE,TYP3340 3340 DEVICE ? @V2A2029 00601000
BO QRYVMINI IF YES BRANCH @V2A2029 00602000
MVC DATAREC+9(4),=C'2314' @V200930 00603000
TM VDEVTYPE,TYP2314 IS IT A 2314 ? 00604000
BO QRYVMINI IF YES, BRANCH 00605000
TM VDEVTYPE,TYP2311 MAYBE A 2311. 00606000
BZ QRYUNSP TREAT AS A SPECIAL DEVICE. @V304498 00607000
TM VDEVFLAG,VDEV231T SPECIAL TYPE 2311 ? @V304498 00608000
BO QRY231T YES, INSERT "T" @V304498 00609000
TM VDEVFLAG,VDEV231B SPECIAL TYPE 2311 ? @V304498 00610000
BZ QRYUNSP TREAT AS A SPECIAL DEVICE @V304498 00611000
MVI DATAREC+12,C'B' INSERT "B" IN DEVTYPE FIELD @V304498 00612000
B QRYVMINI CHECK IF IT'S A "T-DISK" @V304498 00613000
QRY231T MVI DATAREC+12,C'T' INSERT "T" IN DEVTYPE FIELD @V304498 00614000
B QRYVMINI CHECK IF IT'S A "T-DISK" @V304498 00615000
QRYUNSP EQU * @V304498 00616000
MVC DATAREC+9(4),=C'UNSP' @V200930 00617000
QRYVMINI LH R1,VDEVBND SIZE OF MINIDISK(CYL) @VA10879 00618100
CALL DMKCVTBD CONVERT 00622000
STCM R1,15,DATAREC+25 HRC011DK 00623040
MVC DATAREC+14(6),=C'(TEMP)' @VA10879 00623100
TM VDEVFLAG,VDEVTDSK MINI-DISK? @VA10879 00623200
CNOP 0,4 00623301
L R2,VDEVREAL LOAD POINTER TO RDEVBLOK 00624000
USING RDEVBLOK,R2 ADDRESSABILITY 00625000
MVC DATAREC+14(6),RDEVSER @V200930 00626000
DROP R2 00627000
CHKWRT1 EQU * @VA10879 00627100
MVC DATAREC+21(3),=C'R/O' @V200930 00628000
MVC DATAREC+30(3),=C'CYL' HRC011DK 00629590
LA R0,33 GET LNG LEN. HRC011DK 00630180
TM VDEVFLAG,VDEVRDO IS IT R/O MODE ? 00631000
BO WRTVIRT IF YES, LINE IS COMPLETE 00632000
MVI DATAREC+23,C'W' @V200930 00633000
B WRTVIRT NOW PRINT THIS LINE 00634000
EJECT 00635000
QRYVTERM EQU * VIRTUAL TP-TYPE LINE 00636000
CLI VDEVTYPE,TYP3210 IS IT A CONSOLE DEVICE TYPE ? 00637000
BNE NOTERM IF NOT ITS A VIRTUAL 270X LINE . 00638000
TM VMOSTAT,VMDISC IS CONSOLE DISC? @VA01742 00639000
BO USERDISC YES....BRANCH @VA01742 00640000
L R2,VMTERM MUST BE THE CONSOLE FOR THIS VIRT USER. 00641000
CLI RDEVTYPC-RDEVBLOK(R2),CLASTERM IS CLASS TERMINAL 00642000
BNE *+12 NO, BYPASS TEST FOR BISYNC LINE 00643000
CLI RDEVTYPE-RDEVBLOK(R2),TYPBSC IS THIS A LINE 00644000
BE *+12 YES, GET RESOURCE ID. 00645000
CLI RDEVTYPC-RDEVBLOK(R2),CLASSPEC 370X TERM ? @V200820 00646000
BNE FINDRTRM NO -- SAME AS DEDICATED@V200820 00647000
LH R1,VMTRMID RESOURCE IDENTIFICATION FOR 3705 @V200820 00648000
CALL DMKCVTBH CONVERT TO PRINTABLE FORM @V200820 00649000
MVC DATAREC+9(3),=C'ON ' INFORMATION WORD @V200820 00650000
MVC DATAREC+12(4),=C'DEV ' 3705 TERM IS A 'DEV' @V200820 00651000
ST R1,DATAREC+16 STORE FOUR-CHAR R.I.D. @V200820 00652000
B CNTRAIL GO CHECK FOR 'TERM', 'STOP' @V200820 00653000
NOTERM LA R0,17 SET LINE LNG 00654000
MVC DATAREC+9(7),=C'ENABLED' @V200930 00655000
TM VDEVFLAG,VDEVENAB WAS IT ? 00656000
BO WRTVIRT YES, GO PRINT IT 00657000
MVC DATAREC+9(8),=C'DISABLED' @V200930 00658000
B WRTVIRT 00659000
SPACE 00660000
USERDISC MVC DATAREC+9(12),=C'DISCONNECTED' @VA09461 00661100
B CNTRAIL GO CHECK SPOOLING OPTIONS @VA01742 00662000
SPACE 00663000
QRYVSPEC EQU * SPECIAL OR UNKNOWN 00664000
MVC DATAREC+9(4),=C'UNSP' @V200930 00665000
LA R0,14 LENGTH 00666000
CLC VDEVTYPC(2),=AL1(CLASSPEC,TYPCTCA) CTCA ? 00667000
BE QRYVNR YES, SEE IF READY @V200930 00668000
CLI VDEVTYPC,CLASGRAF IS IT GRAF ?? @V200930 00669000
BNE WRTVIRT NO, LET GO @V200930 00670000
QRYVNR MVC DATAREC+9(9),=C'NOT READY' @V200930 00671000
LA R0,18 SIZE @V200930 00672000
TM VDEVSTAT,VDEVNRDY IS THE CTCA COUPLED ? 00675000
BO WRTVIRT NO - MSG AS IS 00676000
ICM R4,15,VDEVREAL LOAD AND TEST CHXBLOK POINTER @VM08569 00677000
BZ WRTVIRT NOT COUPLED AFTER ALL @VM08569 00678000
MVC DATAREC+9(9),=C'COUPLE TO' @V200930 00679000
USING CHXBLOK,R4 00680000
L R2,CHXOTHR VMBLOK OF Y-SIDE USER 00681000
LH R1,CHXYADD VIRT ADDR ON Y-SIDE 00682000
DROP R4 00683000
MVC DATAREC+19(8),VMUSER-VMBLOK(R2) @V200930 00684000
CALL DMKCVTBH CONVERT VADDR 00685000
STCM R1,7,DATAREC+28 @V200930 00686000
LA R0,32 00687000
B WRTVIRT 00688000
EJECT 00689000
DEDICATE L R2,VDEVREAL POINTER TO RDEVBLOK 00690000
USING RDEVBLOK,R2 00691000
FINDRTRM LR R3,R8 SAVE VDEV ADD @VA01081 00692000
LR R8,R2 AND POINT TO RDEV ADD @VA01081 00693000
TM RDEVADD-RDEVBLOK(R8),RDEVLDEV Is this an LDEV? HRC065DK 00693020
BZ LDEV010 No HRC065DK 00693040
LH R1,RDEVADD-RDEVBLOK(,R8) Get the LDEV address HRC065DK 00693060
N R1,F4095 Keep only the dev num HRC065DK 00693080
CALL DMKCVTBH Make it displayable HRC065DK 00693100
STCM R1,7,DATAREC+18 Put dev addr in message HRC065DK 00693120
MVI DATAREC+17,C'L' Move in LDEV indicator HRC065DK 00693140
B LDEV020 Go display msg HRC065DK 00693160
* 00693180
LDEV010 EQU * HRC065DK 00693200
CALL DMKSCNRD FIND THE REAL ADD CCU @VA01081 00694000
CALL DMKCVTBH CONVERT TO PRINT FORM 00695000
STCM R1,7,DATAREC+17 @V200930 00696000
* 00696100
LDEV020 EQU * HRC065DK 00696200
MVC DATAREC+9(3),=C'ON ' @V200930 00697000
CALL DMKSCNRN GET REAL DEVICE NAME @V200930 00698000
STCM R1,15,DATAREC+12 SET DEVICE NAME @V200930 00699000
LR R8,R3 RESTORE VDEVBLOK ADDRESS @V200930 00700000
CLI VDEVTYPE,TYP3210 IS IT A CONSOLE ?? @V200930 00701000
BNE CWRT NO, DEDICATED DONE @V200930 00702000
CNTRAIL EQU * CHECK FOR CONSOLE SPOOLING OPTION@V200820 00703000
MVC DATAREC+22(6),=C'NOTERM' SET NOTERM @V200930 00704000
TM VDEVSFLG,VDEVTERM OUTPUT TO TERM AND SPOOLING ??@V200930 00705000
BZ CSTRT NOTERM IS CORRECT @V200930 00706000
MVC DATAREC+22(2),BLANKS MARK TERM @V200930 00707000
CSTRT MVC DATAREC+29(4),=C'STOP' MARK NO SPOOLING @V200930 00708000
TM VDEVFLAG,VDEVCSPL IS CONSOLE SPOOLING ?? @V200930 00709000
BZ CWRT NO, CONT @V200930 00710000
MVC DATAREC+29(5),=C'START' MARK START @V200930 00711000
CWRT LA R0,35 SIZE @V200930 00712000
TM VDEVSTAT,VDEVDED IS IT A DEDICATED DEVICE ?? @V200930 00713000
BO WRTVIRT YES, WRITE AND RETURN @V200930 00714000
LA R1,DATAREC DATA AREA @V200930 00715000
TM QRYBITS,RANGE RANGE PROCESSING? @V407466 00716000
BZ CWRT2 NO, SEE IF DEDICATED DEVICE @V407466 00716100
LA R1,DATAREC-1 ADJUST MSG BUFFER FOR RANGE FLAG @V407466 00716200
CWRT2 BAL R3,STACK PLACE MSG BUFFER ON STACK @V407466 00716300
MVC DATAREC(4),BLANKS FORMAT NEXT LINE @V200930 00717000
MVI DATAREC+9,C' ' CLEAR PART OF BUFFER @V200930 00718000
MVC DATAREC+10(40),DATAREC+9 ... @V200930 00719000
B QRYVURI NEXT LINE FOR SPOOLING DATA @V200930 00720000
WRTVIRT LA R1,DATAREC SET DATA AREA @V200930 00721000
TM QRYBITS,RANGE RANGE BEING PROCESSED? @V407466 00722000
BZ WRTVIRT2 NO, DO NOT READJUST PTR @V407466 00722100
LA R1,DATAREC-1 MINUS 1 @V407466 00722200
WRTVIRT2 BAL R3,STACK PLACE BUFFER ON STACK @V407466 00722300
BR R10 RETURN @V200930 00723000
DROP R9 @V200930 00724000
EJECT 00725000
* ROUTINE TO STACK OUTPUT LINES ON VMBLOK 00726000
* THE LINES WILL BE PRINTED BY DMKCFM ON RETURN 00727000
* 00728000
STACK LR R4,R0 GET SIZE OF DATA @V200930 00729000
LR R5,R1 SET DATA ADDRESS @V200930 00730000
LA R0,7(R4) ROUND UP TO DOUBLE WORD @V200930 00731000
SRL R0,3 GET SIZE IN DOUBLE WORDS @V200930 00732000
A R0,F1 ONE MORE FOR CHAINING @V200930 00733000
CALL DMKFREE GET BUFFER @V200930 00734000
MVI 0(R1),BIN0 ZERO ERROR INDICATOR @V407466 00734100
STH R4,4(R1) SAVE LINE SIZE @V200930 00735000
STH R0,6(R1) SAVE BUFFER SIZE @V200930 00736000
BCTR R4,R0 DECREMENT FOR EXECUTE @V200930 00737000
TM QRYBITS,RANGE RANGE PROCESSING @V407466 00738000
BZ EXECUTE NO, MOVE MSG TO STACK BUFFER @V407466 00738050
TM 0(R5),QRYERR ERROR MSG BEING STACKED? @V407466 00738100
LA R5,1(,R5) GO PAST INDICATOR @V407466 00738150
BO EXECUTE2 YES, IDENTIFY AS ERROR MESSAGE @V407466 00738200
EXECUTE EX R4,MVCSTK MOVE DATA TO STACK BUFFER @V407466 00738250
CLR0 SR R0,R0 CLEAR R0 @V407466 00738300
STCM R0,B'0111',1(R1) CLEAR PTR @V407466 00738350
LA R2,VMSTKO GET OUTPUT STACK POINTER @V200930 00741000
STKLOOP SLR R4,R4 CLEAR R4 @V407466 00742000
ICM R4,B'0111',1(R2) GET PTR TO STACK BUFFER @V407466 00742100
LTR R4,R4 TEST FOR END OF CHAIN @V200930 00743000
BZ CHAIN FOUND END, CHAIN THIS BUFFER @V200930 00744000
LR R2,R4 POINT TO THIS BUFFER @V200930 00745000
B STKLOOP LOOP TO FIND END @V200930 00746000
CHAIN STCM R1,B'0111',1(R2) CHAIN AT END @V407466 00747000
BR R3 RETURN @V200930 00748000
* 00749000
MVCSTK MVC 8(*-*,R1),0(R5) EXEC FOR STACK BUFFER MOVE @V407466 00750050
SPACE 00750100
EXECUTE2 EQU * @V407466 00750150
MVI 0(R1),QRYERR INDICATE ERROR IN STACK BUFFER @V407466 00750200
EX R4,MVCSTK MOVE MSG TO BUFFER @V407466 00750250
LR R2,R1 SAVE R1 TEMPORARILY @V407466 00750300
LA R0,ERRSZE SIZE OF WORK AREA IN DWDS @V407466 00750350
LR R1,R5 MSG AREA ADDRESS TO R1 FOR 'FRET'@V407466 00750400
BCTR R1,0 DECREM FOR INDICATOR BYTE @V407466 00750450
CALL DMKFRET RELEASE THE AREA @V407466 00750500
LR R1,R2 RESTORE R1 @V407466 00750550
B CLR0 BR TO ABOVE ROUTINE @V407466 00750600
SPACE 3 00751000
QRYTABL DS 0H DECODING TABLE FOR QUERY VIRTUAL @VM08820 00752000
STORAGE DC C'STORAGE ',AL1(3,36) QUERY VIRTUAL STORAGE @VM08820 00753000
DASD DC C'DASD ',AL1(1,20) QUERY VIRTUAL DASD @VM08820 00754000
TAPES DC C'TAPES ',AL1(1,24) QUERY VIRTUAL TAPES @VM08820 00755000
LINES DC C'LINES ',AL1(4,28) QUERY VIRTUAL LINES @VM08820 00756000
SPOOL DC C'UR ',AL1(1,32) QUERY VIRTUAL UR @VM08820 00757000
GRAF DC C'GRAF ',AL1(1,44) QUERY VIRTUAL GRAF @VM08820 00758000
CONS DC C'CONSOLE ',AL1(2,48) QUERY VIRTUAL CONSOLE @VM08820 00759000
CHANNELS DC C'CHANNELS',AL1(3,52) QUERY VIRTUAL CHANNELS @VA01771 00760000
QRYTEND DC C'ALL ',AL1(2,40) QUERY VIRTUAL ALL @VM08820 00761000
QRYTLEN EQU *-QRYTEND ENTRY LENGTH @VM08820 00762000
SPACE 2 00763000
* EQUATES USED IN SAVEWRK1: 00764000
VIRTALL EQU X'02' QUERY VIRTUAL ALL @VM08820 00765000
* EQU X'80' RESERVED 00766000
* EQU X'40' RESERVED 00766800
* EQU X'20' RESERVED 00767600
* EQU X'10' RESERVED 00768400
* EQU X'08' RESERVED 00769200
* EQU X'04' RESERVED 00770000
* EQU X'02' RESERVED 00770800
* EQU X'01' RESERVED 00771600
SPACE 00773100
* EQUATES USED IN SAVEWRK1+2 00773200
RANGE EQU X'80' RANGE PROCESSING @V407466 00773300
PASS1 EQU X'40' FIRST PASS SWITCH @V407466 00773400
* EQU X'20' RESERVED 00773450
SPACE 00773500
* MISCELLANEOUS EQUATES 00773600
QRYERR EQU X'80' ERROR MSG INDICATOR @V407466 00773700
BLANK EQU X'40' DELIMITERS @V407466 00773800
BIN0 EQU X'00' RESET INDICATOR @V407466 00773900
EJECT 00774000
CQG020 LA R2,20 ERROR CODE 00988000
B NOVAR ... 00989000
CQG022B LA R0,15 STORAGE SIZE FOR FRET @VA08527 00989250
LR R1,R9 SET ADDRESS TO FOR FRET @VA08527 00989500
CALL DMKFRET RETURN STORAGE @VA08527 00989750
SPACE 00990000
CQG022 LA R2,22 ERROR CODE 00991000
B NOVAR ... 00992000
CQG022A TM QRYBITS,RANGE RANGE PROCESSING @V407466 00992020
BZ CQG022B NO, REGULAR CQG022 MESSAGE @VA08527 00992040
LA R2,22 ERROR MSG = 022E @V407466 00992060
ST R2,SAVER2 SAVE RETURN CODE = 22 @V407466 00992080
B COMERR BR TO COMMOM ERROR PROCESSING @V407466 00992100
CQG040A TM QRYBITS,RANGE RANGE PROCESSING? @V407466 00992120
BZ CQG040 NO - NO SPECIAL TREATMENT @V407466 00992140
LA R2,40 ERROR RETURN = 40 @V407466 00992160
ST R2,SAVER2 STORE ERROR RETURN = 40 @V407466 00992180
COMERR LA R0,ERRSZE ACQUIRE BUFFER FOR MSG @V407466 00992200
CALL DMKFREE GO GET IT @V407466 00992220
USING MSGERR,R1 ADDRESSABILITY @V407466 00992240
XC MSGERR(ERRSZE3),MSGERR CLEAR AREA @V407466 00992260
C R2,=F'22' ERROR MESSAGE = 022E?? @V407466 00992280
BH ERROR40 NO, MUST BE 040E @V407466 00992300
MVC ERRCODE(L'ERRCODE+L'ERRSEV),=CL4'022E' MSG CODE @V407466 00992320
MVC ERRTEXT(L'MSG22),MSG22 SUBST. APPROP. MSG @V407466 00992340
LA R0,ERRSZE2+L'MSG22 MESSAGE LENGTH @V407466 00992360
COMERR2 MVI ERRIND,QRYERR INDICATE ERROR MESSAGE @V407466 00992380
MVC ERRHDR(L'ERRHDR),=CL6'DMKCQG' HDR PORTION @V407466 00992400
LA R1,MSGERR POINTER TO ERROR MSG @V407466 00992420
BAL R3,STACK PLACE ERROR MSG ON STACK @V407466 00992440
L R1,SAVER2 RESTORE ERROR CODE @VA09138 00992445
C R1,=F'22' IS IT A '022E'? @VA09138 00992450
BE QRYVFRET YES,GET OUT @VA09138 00992455
B NEXTADDR SEE IF MORE ADDRS TO PROCESS @V407466 00992460
ERROR40 MVC ERRTEXT(L'MSG40),MSG40 SUBST. MSG @V407466 00992480
LR R2,R1 SAVE MSG AREA ADDR FOR MINUTE @V407466 00992500
L R1,SAVEWRK6 ADDRESS TO R1 @V407466 00992520
CALL DMKCVTBH CONVERT ADDR TO HEX @V407466 00992540
USING MSGERR,R2 ADDRESSABILITY @V407466 00992560
STCM R1,B'0111',ERRTEXT+4 PLACE IN ERROR @V407466 00992580
MVC ERRCODE(L'ERRCODE+L'ERRSEV),=CL4'040E' CODE+SEV @V407466 00992600
LR R1,R2 RESTORE MSG AREA ADDRESS @V407466 00992620
DROP R2 @V407466 00992640
LA R0,ERRSZE2+L'MSG40 MSG40 LENGTH @V407466 00992660
B COMERR2 CONTINUE COMMON CODE @V407466 00992680
DROP R1 @V407466 00992700
SPACE 00993000
CQG026 LA R2,26 ERROR CODE @V200930 00994000
B NOVAR .... @V200930 00995000
SPACE 00999000
CQG040 LA R2,40 ERROR CODE 01000000
LA R0,15 BUFFER SIZE @VA08527 01000250
LR R1,R9 SET UP R1 FOR FRET @VA08527 01000500
CALL DMKFRET GIVE BACK CORE @VA08527 01000750
LM R0,R1,SAVEWRK8 LOAD ADDRESS AND LENGTH OF BAD USERID 01001000
B CALLERM ... 01002000
SPACE 01003000
SPACE 01007000
CQG045 LA R2,45 ERROR CODE 01008000
LM R0,R1,SAVER0 RESTORE ARGUMENT LENGTH AND ADDRESS 01009000
B CALLERM .... 01010000
SPACE 01011000
NOVAR SR R1,R1 INDICATE NO VARIABLE TO MESSAGE ROTUINE 01012000
CALLERM ICM R0,14,MODID+3 INSERT MODULE IDENTITY 01013000
CALL DMKERMSG GO SEND MESSAGE WITH NO RETURN 01014000
* 01015000
* MESSAGE MODULE WILL RETURN DIRECTLY TO DMKCFM 01016000
* 01017000
SPACE 01017100
MSG22 DC CL24'VADDR MISSING OR INVALID' @V407466 01017200
MSG40 DC CL22'DEV DOES NOT EXIST' @V407466 01017300
SPACE 01017400
EJECT 01018000
LTORG 01019000
SPACE 4 01020000
REGSAVE DSECT 01021000
REG1 DS 1F 01022000
REG2 DS 1F 01023000
REG3 DS 1F 01024000
REG4 DS 1F 01025000
REG5 DS 1F 01026000
REG6 DS 1F 01027000
REG7 DS 1F 01028000
REG8 DS 1F 01029000
SPACE 2 01030000
DATAREC DS 0C @V200930 01031000
DATARECD DS 0C @V200930 01032000
XUSER DS CL8 @V200930 01033000
DS C @V200930 01034000
XFILID DS CL4 @V200930 01035000
DS C @V200930 01036000
XCLAS DS CL1 @V200930 01037000
DS C @V200930 01038000
XTYPE DS CL3 @V200930 01039000
DS C @V200930 01040000
XRECNO DS CL6 @V200930 01041000
DS CL2 @V60B9BA 01042000
XCOPY DS CL2 @V200930 01043000
DS C @V60B9BA 01044000
XSTAT DS CL4 @V200930 01045000
DS C @V200930 01046000
XDATE DS CL5 @V200930 01047000
DS C @V200930 01048000
XTIME DS CL8 @V200930 01049000
DS C @V200930 01050000
XFNAME DS CL12 @V200930 01051000
XFTYPE DS CL8 @V200930 01052000
DS C @V200930 01053000
XDIST DS CL8 @V200930 01054000
SPACE 01054060
ORG XDATE @V60B9BA 01054120
XFLASH DS CL4 FLASH NAME @V60B9BA 01054180
DS CL3 @V60B9BA 01054240
XCHAR DS CL4 CHARS VALUE @V60B9BA 01054300
DS CL3 @V60B9BA 01054360
XFCB DS CL4 FCB VALUE @V60B9BA 01054420
DS CL2 @V60B9BA 01054480
XCMOD DS CL4 MODIFY VALUE @V60B9BA 01054540
DS CL3 @V60B9BA 01054600
XFLSHC DS CL2 FLASH COUNT @V60B9BA 01054660
DS CL5 @V60B9BA 01054720
DS CL2 @V60B9BA 01054780
ORG 01054840
DATARECL EQU *-DATAREC @V200930 01055000
SPACE 01055050
MSGERR DSECT @V407466 01055100
ERRIND DS XL1 ERROR MSG INDICATOR @V407466 01055150
ERRHDR DS CL6 ERROR MSG HEADER 'DMKCQG' @V407466 01055200
ERRCODE DS CL3 FOR MSG NUMBER @V407466 01055250
ERRSEV DS CL1 ERROR MSG SEVERITY @V407466 01055300
DS CL1 DELIMITER @V407466 01055350
ERRSZE2 EQU *-MSGERR LENGTH OF HEADER PORTION @V407466 01055400
ERRTEXT DS CL25 MSG TEXT @V407466 01055450
ERRSZE3 EQU *-MSGERR LENGTH OF FULL MSG @V407466 01055500
ERRSZE EQU ((*-MSGERR)+7)/8 SIZE OF ERROR MSG IN DWDS @V407466 01055550
SPACE 2 01056000
EJECT 01057000
PSA , @V306638 01058000
COPY DEVTYPES @V306638 01059000
COPY EQU @V306638 01060000
COPY RBLOKS @V306638 01061000
COPY SAVE @V306638 01062000
SPACE 01062100
RADDR1 EQU SAVEWRK7 FIRST ADDR IN RANGE @V407466 01062200
RADDR2 EQU SAVEWRK7+2 SECOND RADDR IN RANGE @V407466 01062300
SPACE 01062400
QRYBITS EQU SAVEWRK1+2 QUERY FLAGS @V407466 01062500
SPACE 01062600
*RANGE EQU X'80' RANGE PROCESSING 01062700
*PASS1 EQU X'40' FIRST PASS SWITCH 01062800
COPY SPOOL @V306638 01063000
COPY VBLOKS @V306638 01064000
COPY VCTCA @V306638 01065000
COPY VMBLOK @V306638 01066000
END 01067000