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