CPS TITLE 'DMKCPS (CP) VM/370 - RELEASE 6' 00001000 *. 00002000 * MODULE NAME - 00003000 * 00004000 * DMKCPS 00005000 * 00006000 * FUNCTION - 00007000 * 00008000 * TO HANDLE A, B, AND C PRIVILEGE CLASS COMMANDS THAT ARE NOT 00009000 * SUBSETS OF NON-PRIVILEGED COMMANDS 00010000 * 00011000 * ATTRIBUTES - 00012000 * 00013000 * REENTRANT, PAGEABLE, CALLED VIA SVC 00014000 * 00015000 * ENTRY POINTS 00016000 * 00017000 * DMKCPSH - DO A HALT DEVICE TO THE SPECIFIED UNIT 00020000 * DMKCPSRY - TO MARK A SYSTEM DEVICE OFFLINE OR ONLINE. 00021000 * 00022000 * ENTRY CONDITIONS - 00023000 * 00024000 * GPR9 = ADDRESS OF COMMAND LINE BUFFER 00025000 * GPR11 = ADDRESS OF CALLER'S VMBLOK 00026000 * GPR12 = ADDRESS OF ENTRY POINT 00027000 * GPR13 = ADDRESS OF SAVEAREA 00028000 * 00029000 * EXIT CONDITIONS - 00030000 * 00031000 * NORMAL - 00032000 * GPR2 = 0 00033000 * 00034000 * ERROR - 00035000 * GPR2 = ERROR MESSAGE CODE NUMBER 00036000 * 00037000 * CALLS TO OTHER ROUTINES - 00038000 * 00039000 * DMKQCNWT - TO WRITE MESSAGE TO CONSOLE 00040000 * DMKFREE - TO OBTAIN STORAGE 00041000 * DMKIOSQR - TO QUE I/O REQUEST 00042000 * DMKPTRUL - TO UNLOCK A PAGE 00043000 * DMKSCNVU - TO FIND A VIRTUAL UNIT 00044000 * DMKFRET - TO RETURN A BLOCK OF STORAGE 00045000 * DMKCVTBH - TO CONVERT BINARY TO HEX 00046000 * DMKCVTBD - TO CONVET BINARY TO DECIMAL 00046500 * DMKIOSHA - HALT AN ACTIVE DEVICE 00047000 * DMKCFPRD - RESET A VIRTUAL DEVICE 00048000 * DMKSCNVD - FIND A VIRTUAL DEVICE ADDRESS 00049000 * DMKSCNVN - GET THE VIRTUAL DEVICE TYPE 00050000 * DMKSCNRN - GET THE REAL DEVICE TYPE 00051000 * DMKCFMBK - PUT A USER IN CF MODE 00052000 * DMKSCNFD - LOCATE THE NEXT ARGUMENT ON THE COMMAND LINE 00053000 * DMKCVTHB - CONVERT HEXADECIMAL ADDRESSES TO BINARY 00054000 * DMKSCNRU -LOCATE THE RDEVBLOK FOR THE SPECIFIED REAL DEVICE 00055000 * DMKERMSG - TO SEND ERROR MESSAGES TO TERMINAL 00057000 * DMKRSESD - RECORD 3800 STATISTICAL DATA 00059000 * DMKSTKCP - STACK A CPEXBLOK 00059500 * DMKSTKIO - STACK IOBLOK TO READ DASD VOLID. 00060000 * DMKDSBRD - IOBIRA TO READ LABEL 00061000 * DMKIOESR - SYNCHRONOUS OBR PROCESSING 00063000 * DMKSCNRA - COMPUTE FULL REAL DEVICE ADDRESS 00064000 * DMKSCNNP - GET RCUBLOK & RCHBLOK FOR NEXT PATH TO DEVICE 00065000 * DMKCFCSC - SCAN OPERAND FOR RANGE OF ADDRESSES 00067000 * DMKSPLDL - DELETE SPOOL FILES ON THE 3800 DELAY QUEUE 00071000 * DMKSSSDE - DEMOUNT V3330 VOLUME 00071300 * DMKTAPRL - TAPE RELEASE EPA 00071600 * DMKTBLLC - TRANSLATE TABLE TO TRANSLATE TO LOWERCASE HRC010DK 00071800 * 00072000 * EXTERNAL REFERENCES - 00073000 * 00074000 * NONE 00075000 * 00076000 * TABLES / WORKAREAS - 00077000 * 00078000 * CORTABLE 00079000 * 00080000 * REGISTER USAGE - 00081000 * 00082000 * GPR0 = LENGTH OF ARGUMENT (RETURNED BY DMKSCNFD) 00083000 * GPR1 = ADDRESS OF ARGUMENT (RETURNED BY DMKSCNFD) 00084000 * GPR2 = PARMS PASSED TO CALLED ROUTINES 00085000 * GPR3 = LENGTH FOR EXECUTED MOVES AND COMPARES 00086000 * GPR4 = INTERNAL LINKAGE (2ND LEVEL) 00087000 * GPR5 = INTERNAL LINKAGE (2ND LEVEL) 00088000 * GPR6-8 NOT USED 00089000 * GPR9 = ADDRESS OF COMMAND LINE BUFFER 00090000 * GPR10 = IOBLOK BASE 00091000 * GPR11 = VMBLOK BASE 00092000 * GPR12 = MODULE BASE 00093000 * GPR13 = SAVEAREA BASE 00094000 * GPR14 = EXTERNAL LINKAGE 00095000 * GPR15 = EXTERNAL LINKAGE 00096000 * 00097000 * OPERATION - 00098000 * 00099000 * THE COMMAND HANDLING ROUTINES IN DMKCPS ARE CALLED FROM DMKCFM 00100000 * AFTER THEIR PRIVILEGE CLASS HAS BEEN VERIFIED 00101000 * THE FORMAT AND OPERATION OF EACH COMMAND IS DESCRIBED IN 00102000 * SEPARATE COMMAND PROLOGUES BELOW 00103000 *. 00104000 EJECT 00105000 COPY OPTIONS @VA03757 00106000 COPY LOCAL @VA03757 00107000 SPACE 3 00108000 PUNCH 'SPB' @VA03757 00109000 DMKCPS CSECT @VA03757 00110000 MODID DC CL8'DMKCPS' @VA03757 00111000 SPACE 3 00112000 USING PSA,R0 @VA03757 00113000 USING VMBLOK,R11 @VA03757 00114000 USING SAVEAREA,R13 @VA03757 00115000 SPACE 2 00116000 EXTRN DMKSCNFD @VA03757 00117000 AIF (NOT &AP).SKIPCP1 **AIF*** 00118000 EXTRN DMKCPUVY VARY PROCESSOR ROUTINE @V5BC0AB 00119000 .SKIPCP1 ANOP **ANOP** 00120000 EXTRN DMKIOSQR @VA03757 00121000 EXTRN DMKCVTHB @VA03757 00123000 EXTRN DMKSCNRA @V407438 00125000 EXTRN DMKSCNNP @V407438 00126000 EXTRN DMKSTKCP @V407466 00127000 EXTRN DMKTAPRL TAPE RELEASE EPA @V407466 00128000 EXTRN DMKCVTBD @VA03757 00129000 EXTRN DMKSCNRU @VA03757 00130000 EXTRN DMKPTRUL @VA03757 00131000 EXTRN DMKCVTBH @VA03757 00132000 EXTRN DMKSCNVU @VA03757 00134000 EXTRN DMKIOSHA @VA03757 00135000 EXTRN DMKCFPRD @VA03757 00136000 EXTRN DMKSCNVD @VA03757 00137000 EXTRN DMKSCNVN @VA03757 00138000 EXTRN DMKSCNRN @VA03757 00139000 EXTRN DMKCFMBK @VA03757 00140000 EXTRN DMKERMSG @VA03757 00141000 EXTRN DMKSTKIO @VA03757 00144000 EXTRN DMKDSBRD @VA08187 00145000 EXTRN DMKIOESR SYCHRONOUS OBR PROCESSING @VA03757 00147000 EXTRN DMKCFCSC SCAN FOR RANGE OPERAND @V407466 00148000 EXTRN DMKSPLDL,DMKRSESD 3800 SUPPORT @VA13648 00149000 EXTRN DMKSSSDE TO DEMOUNT VOLUME @VA10877 00149100 EXTRN DMKTBLLC TRANSLATE TO LOWER CASE HRC010DK 00249100 EJECT 00356000 *. 00357000 * SUBROUTINE NAME - 00358000 * 00359000 * DMKCPSRY 00360000 * 00361000 * FUNCTION - 00362000 * 00363000 * TO MAKE A DEVICE AVAILABLE/UNAVAILABLE FOR USE BY A USER 00364000 * OR BY THE CONTROL PROGRAM. 00365000 * 00366000 * COMMAND LINE FORMAT - 00367000 * 00368000 * +------+---------------------------------+ 00369000 * | VARY | ONLINE RADDR . . . | 00370000 * | | OFFLINE RADDR1-RADDR2 | 00371000 * | VARY | ONLINE PROCESSOR RADDR | 00372000 * | | OFFLINE PROCESSOR RADDR | 00373000 * +------+---------------------------------+ 00374000 * 00375000 * OPERATION - 00376000 * 00377000 * 1. CALL DMKSCNFD TO GET THE ONLINE OR OFFLINE PARAMETER; 00378000 * IF NO PARAMETER, ISSUE ERROR MESSAGE DMKCPS026E. 00379000 * 2. CALL DMKSCNFD TO GET DEVICE ADDRESS, RANGE OPERAND OR 00380000 * PROC OPERAND. IF THE VARY IS FOR A PROCESSOR, CALL 00381000 * DMKSCNFD TO GET THE PROCESSOR ADDRESS. IF NO ADDRESS, 00382000 * ISSUE ERROR MESSAGE DMKCPS021E. OTHERWISE, CALL 00383000 * DMKCPUVY TO VARY THE PROCESSOR ONLINE OR OFFLINE. 00384000 * UPON RETURN FROM DMKCPUVY, EXIT. IF THE VARY IS FOR 00385000 * A DEVICE, AND THERE IS NO DEVICE ADDRESS OR IF ADDRESS 00386000 * IS INVALID AFTER CONVERSION ISSUE ERROR MESSAGE 00387000 * DMKCPS021E. ALSO ISSUE THE MSG IF TARGET IS A 2305 AND 00388000 * THE ADDRESS IS NOT THAT OF EXPOSURE 0, I.E. 'XX0' 00389000 * 'XX8'. 00390000 * 3. ACQUIRE FREE STORAGE FOR MESSAGE BUFFER; THIS 00391000 * BUFFER WILL BE USED TO BUILD SUCCESSFUL VARY ONLINE/ 00392000 * OFFLINE MESSAGE. 00393000 * 4. CALL DMKCFCSC TO DETERMINE IF RANGE OPERAND HAS 00394000 * BEEN SPECIFIED; VALIDITY CHECK RANGE OPERAND AND 00395000 * CONVERT FIRST AND SECOND ADDRESS IN RANGE TO BINARY. 00396000 * IF VALIDITY CHECK FAILS, ISSUE ERROR MESSAGE DMKCPS026E. 00397000 * IF CONVERSION FAILS, ISSUE ERROR MESSAGE DMKCPS021E. 00398000 * 5. CALL DMKSCNRU TO LOCATE THE DEVICE TO BE VARIED. 00399000 * IF THE DEVICE DOES NOT EXIST, ISSUE ERROR MSG DMKCPS040E. 00400000 * IF A SDRBLOK EXISTS, CALL DMKIOESR FOR SYNCHRONOUS 00401000 * OBR PROCESSING (STATISTICAL DATA RECORDING). 00402000 * 6. RESET THE DISABLE FLAGS FOR THIS DEVICE. 00403000 * FOR VARY OFFLINE, SKIP TO STEP 8. BUILD AN IOB 00404000 * FOR A TEST I/O REQUEST AND CALL DMKIOSQR TO TEST THE 00405000 * AVAILABILITY OF THE PATH TO THE DEVICE. IF THERE ARE 00406000 * ALTERNATE PATHS TO THE DEVICE, SCHEDULE A TIO ON EACH 00407000 * PATH. IF IT IS A DASD DEVICE 00408000 * DMKSTKIO TO STACK A DEVICE END INTERRUPT FOR DMKDASRD 00409000 * TO READ THE REAL VOLID. IF THE DEVICE IS A 2305, VARY ALL 00410000 * EIGHT EXPOSURES ONLINE. THEN CALL DMKQCNWT TO 00411000 * ISSUE SUCCESSFUL MESSAGE. 00412000 * 7. WHEN ALL DEVICES HAVE BEEN PROCESSED, EXIT. 00413000 * AN INVALID DEVICE IN THE COMMAND LINE DOES NOT TERMINATE 00414000 * COMMAND PROCESSING. AN ERROR MESSAGE WILL BE ISSUED FOR 00415000 * THE DEVICE IN ERROR AND PROCESSING WILL CONTINUE WITH THE 00416000 * NEXT ADDRESS. 00417000 * 00418000 * THE FOLLOWING STEPS ARE FOR VARY OFFLINE PROCESSING 00419000 * 00420000 * 8. IF THE DEVICE IS DEDICATED, CALL DMKERMSG TO SEND ERROR 00421000 * MESSAGE DMKCPS140E. IF THE DEVICE IS AN ENABLED TP LINE, 00422000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCPS049E. IF 00423000 * NONACTIVE TP LINE, GO TO STEP 9. IF NOT A TPLINE, CHECK 00424000 * FOR A SPOOL DEVICE. IF NOT A SPOOL DEVICE, GO TO STEP 8. 00425000 * FOR A SPOOL DEVICE THAT IS NOT DRAINED, CALL DMKERMSG TO 00426000 * SEND ERROR MESSAGE DMKCPS142E. IF DRAINED, GO TO STEP 9. 00427000 * 9. IF THIS IS NOT A TAPE DEVICE, GO TO STEP 10-ELSE CONTINUE. 00428000 * 10. SET THE RDEVDISA FLAG IN THE RDEVBLOK. CALL DMKQCNWT TO 00429000 * ISSUE THE SUCCESSFUL MESSAGE AND CONTINUE. 00430000 * NOTE THAT IF THE DEVICE IS A 2305, ALL EIGHT EXPOSURES WILL 00431000 * BE VARIED OFFLINE. 00432000 * IF THIS IS A 3800, DMKRSESD WILL BE CALLED TO 00433000 * UNLOAD THE ERROR LOG BUFFER, AND THEN EACH FILE 00434000 * ON ITS DELAYED PURGE QUEUE WILL BE PURGED VIA 00435000 * A CALL TO DMKSPLDL. 00436000 * 11. IF THIS IS A CP-OWNED DASD, CALL DMKERMSG TO SEND ERROR 00437000 * MESSAGE DMKCPS123E. IF IT IS A SYSTEM DASD THAT IS BUSY, 00438000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCPS124E. IF NOT ONE 00439000 * OF THESE, GO TO STEP 9. 00440000 * 00441000 * RESPONSES - 00442000 * +----------------------------------------+ 00443000 * | RADDR ... VARIED ONLINE | 00444000 * | RADDR-RADDR OFFLINE | 00445000 * +----------------------------------------+ 00446000 * 00447000 * ERROR MESSAGES - 00448000 * DMKCPS003E INVALID OPTION - (OPTION) 00449000 * DMKCPS021E RADDR MISSING OR INVALID 00450000 * DMKCPS026E OPERAND MISSING OR INVALID 00451000 * DMKCPS040E DEV (ADDR) DOES NOT EXIST 00452000 * DMKCPS049E (TYPE RADDR) IN USE 00453000 * DMKCPS123E DASD (RADDR) CP OWNED 00454000 * DMKCPS124E DASD (RADDR) IN USE BY (NNN) USERS 00455000 * DMKCPS140E (TYPE RADDR) ATTACHED TO (USERID) 00456000 * DMKCPS142E (TYPE RADDR) NOT DRAINED 00457000 * 00458000 *. 00459000 EJECT 00460000 DMKCPSRY RELOC VARY ENTRY @VA03757 00461000 USING RCHBLOK,R6 @VA03757 00462000 USING RCUBLOK,R7 @VA03757 00463000 USING RDEVBLOK,R8 @VA03757 00464000 XC SAVEWRK1(4),SAVEWRK1 CLEAR FLAG BITS @V407466 00465000 MVC SAVEWRK6(4),BUFCNT-BUFFER(R9) SAVE CNT AT ENTRY @VA15100 00465100 CALL DMKSCNFD GET ON OR OFF @VA03757 00466000 BNZ CPS026 NONE, ERROR @VA03757 00467000 LR R2,R0 GET DATA COUNT @VA03757 00468000 BCTR R2,R0 MINUS ONE @VA03757 00469000 CL R0,F2 LESS THAN TWO ?? @VA03757 00470000 BL CPS003A YES, ERROR @V407466 00471000 EX R2,COMPON IS IT ONLINE ?? @VA03757 00472000 BE VARYONS YES @VA03757 00473000 EX R2,COMPOFF IS IT OFFLINE ?? @VA03757 00474000 BNE CPS003A NO, ERROR @V407466 00475000 B VARYDGET GO GET DEVICES TO VARY @VA03757 00476000 VARYONS OI CPSBITS,ON VARY ONLINE REQUEST @V407466 00477000 SR R10,R10 INDICATE NO IOB YET @VA03757 00478000 VARYDGET LA R0,MSGSIZE ACQ. STORAGE FOR SUCCESS MSG @V407466 00479000 CALL DMKFREE ... @V407466 00480000 ST R1,SAVEWRK7 SAVE MSG AREA ADDRESS @V407466 00481000 CALL DMKSCNFD FIND SECOND OPERAND @V407466 00482000 BNZ CPS021C NONE, ERROR @V407490 00483000 CLC 0(4,R1),=C'PROC' A VARY PROC COMMAND? @V5BC0AB 00485000 BNE MSGBUFF NO, CONTINUE @V5BC0AB 00486000 AIF (NOT &AP).SKIPCP2 00487000 CALL DMKSCNFD GET PROCESSOR ADDRESS @V5BC0AB 00489000 BNZ CPS021B GO ISSUE ERROR MESSAGE @VA09324 00490100 CL R0,F2 IS OPERAND LENGTH = 2? @VA09324 00491100 BNE CPS021B NO, BRANCH @VA09324 00491200 CALL DMKCVTHB CONVERT TO BINARY @V5BC0AB 00492000 BNZ CPS021B GO ISSUE ERROR MESSAGE @VA09324 00493100 TM CPSBITS,ON IS THIS AN ONLINE REQUEST? @V5BC0AB 00494000 BO VARYPROC YES, CONTINUE @V5BC0AB 00495000 O R1,NOADD INDICATE THIS IS AN OFFLINE REQ. @V5BC0AB 00496000 * I.E. PUT X'FF' IN BYTE 0 OF REGISTER 1 00497000 VARYPROC DS 0H @V5BC0AB 00498000 CALL DMKCPUVY CALL THE VARY PROCESSOR ROUTINE @V5BC0AB 00499000 STC R1,LASTRC STORE RETURN CODE @V5BC0AB 00500000 B CPSEXIT GO RETURN TO CALLER @V5BC0AB 00501000 .SKIPCP2 ANOP 00502000 L R1,SAVEWRK7 GET ADDR OF MESSAGE AREA @VMH0011 00503000 LA R0,MSGSIZE GET MESSAGE AREA SIZE @VMH0011 00504000 CALL DMKFRET FREE THE MESSAGE AREA @VMH0011 00505000 SLR R0,R0 NO MESSAGE TEXT INSERT LENGTH @VMH0011 00506000 SLR R1,R1 NO MESSAGE TEXT INSERT ADDRESS @VMH0011 00507000 LA R2,192 ERROR MESSAGE NUMBER FOR MSG, @VMH0011 00508000 * VARY PROCESSOR COMMAND FAILED 00509000 B CALLERM ISSUE MESSAGE, RETURN TO DMKCFM @VMH0011 00510000 MSGBUFF DS 0H @VMH0011 00511000 USING MSG,R9 ADDRESSABILITY FOR MSG @V407466 00512000 L R9,SAVEWRK7 R9 ADDRESSES MSG AREA @V407466 00513000 XC CPSADD1(MSGSIZE*8),CPSADD1 CLEAR MSG AREA @V407466 00514000 CL R0,F7 MORE THAN 7 CHARACTERS? @V407466 00515000 BH CPS021D YES, ERROR @V407490 00516000 LA R2,DASH '-' FOR RANGE SCAN @V407466 00517000 CALL DMKCFCSC SEE IF RANGE SPECIFIED @V407466 00518000 BZ VARYDEV NO, RANGE, CONTINUE BELOW @V407466 00519000 CR R1,R2 INVALID IF '-' FIRST CHARACTER @V407466 00520000 BNL CPS021D ERROR @V407490 00521000 CL R0,F3 RANGE < 3? @V407466 00522000 BL CPS021D ERROR @V407490 00523000 LR R3,R2 ... @V407466 00524000 SR R3,R1 LENGTH OF RADDR1 FIELD @V407466 00525000 LR R4,R0 ENTIRE OPERAND LENGTH @V407466 00526000 LR R0,R3 RADDR1 LENGTH @V407466 00527000 MVI 0(R2),BLANK REPLACE '-' WITH BLANK @V407466 00528000 CALL DMKCVTHB CONVERT FIRST RADDR IN RANGE @V407466 00529000 BNZ CPS021A ERROR IF BAD CONVERT @V407466 00530000 STH R1,RADDR1 STORE RADDR1 IN SAVEWRK8 @V407466 00531000 LA R1,1(,R2) POINT TO SECOND RADDR IN RANGE @V407466 00532000 SR R4,R3 RADDR2 LENGTH @V407466 00533000 BCTR R4,0 MINUS ONE FOR '-' @V407466 00534000 LR R0,R4 TO R0 @V407466 00535000 CALL DMKCVTHB CONVERT SECOND RADDR IN RANGE @V407466 00536000 BNZ CPS021B BAD CONVERT ON SECOND ADDRESS @V407490 00537000 LH R4,RADDR1 FIRST ADDRESS IN RANGE @V407466 00538000 CR R1,R4 RADDR2 MUST BE > RADDR1 @V407466 00539000 BNH CPS021B INVALID OPERAND @V407490 00540000 STH R1,RADDR2 STORE RADDR2 IN SAVEWRK8+2 @V407466 00541000 OI CPSBITS,RANGE INDICATE RANGE PROCESSING @V407466 00542000 CALL DMKSCNFD BETTER NOT BE MORE OPERANDS @V407466 00543000 BZ CPS026A ERROR @V407466 00544000 LH R1,RADDR1 NEXT ADDRESS @V407466 00545000 B CONTINUE PROCESS ADDRESS @V407466 00546000 VARYDEV CL R0,F3 MORE THAN 3 CHARACTERS ?? @VA03757 00547000 BH CPS021 YES, RADDR ERROR @V407490 00548000 CALL DMKCVTHB CONVERT TO DEVICE ADDRESS @VA03757 00549000 BNZ CPS021 BAD CONVERT @VA03757 00550000 CONTINUE ST R1,SAVEWRK9 SAVE FOR POSSIBLE ERROR MSG @V407466 00551000 CALL DMKSCNRU FIND DEVICE CONTROL BLOKS @VA03757 00552000 BNZ CPS040 CANT FIND THE DEVICE @VA03757 00553000 TM RDEVSTA3,RDEVPEND IS VARY IN PROCESS FOR THIS @VA12646 00553100 * DEVICE? 00553200 BO CPSVPEND YES, ISSUE ERROR MESSAGE @VA12646 00553300 OI RDEVSTA3,RDEVPEND TURN ON VARY PENDING FLAG @VA12646 00553400 TM RDEVTYPC,CLASDASD+CLASTAPE TAPE OR DASD? @V407438 00554000 BZ CKON NOPE, CONTINUE WITH OTHERS @V407438 00555000 L R7,RDEVCUA GET FIRST DEFINED PATH TO DEVICE @V407438 00556000 TM RCUTYPE,RCUSUB IS THIS A SUBORDINATE CTL UNIT? @V407438 00557000 BZ *+8 NOPE, GOT PRIMARY, BR. @V407438 00558000 L R7,RCUPRIME GET PRIMARY RCUBLOK @V407438 00559000 L R6,RCUCHA GET FIRST CHANNEL BLOCK @V407438 00560000 CLI RDEVTYPC,CLASDASD THIS A DASD DEVICE? @VA03757 00561000 BNE CKON NOPE @VA03757 00562000 CLI RDEVTYPE,TYP2305 YES - MULT. EXPOSURE DEVICE? @VA03757 00563000 BNE CKON NO - NORMAL PROCESSING @VA03757 00564000 TM RDEVADD+1,X'07' IS THIS EXPOSURE 0?? @VA03757 00565000 BNZ CPS021 NOPE, BAD STUFF, BR. @V407466 00566000 CKON EQU * @VA03757 00567000 TM CPSBITS,ON VARY 'ONLINE' REQUEST @V407466 00568000 BO VARYON YES, DO IT @V407466 00569000 B VARYOFF VARY OFFLINE @VA03757 00570000 SPACE 00571000 VARYNDEV L R1,SAVEWRK9 CURRENT ADDRESS @V407466 00572000 CLI RDEVTYPC,CLASDASD DASD DEVICE TYPE @V407466 00573000 BNE CONVERT NOT 2305, CONVERT ADDR @V407466 00574000 CLI RDEVTYPE,TYP2305 2305 DRUM? @V407466 00575000 BNE CONVERT NOT 2305, CONVERT CURRENT ADDR @V407466 00576000 LA R7,7(,R1) BUMP FOR 8 EXPOSURES @V407466 00577000 ST R7,SAVEWRK9 SAVE FOR LATER @V407466 00578000 CONVERT CALL DMKCVTBH CONVERT ADDRESS TO HEX @V407466 00579000 TM CPSBITS,RANGE PROCESSING A RANGE? @V407466 00580000 BO MSGRANGE YES, FILL IN SUCCESS MSG @V407466 00581000 L R9,SAVEWRK7 BEGINNING MSG BUFFER @V407466 00582000 SLR R7,R7 CLEAR R7 @V407466 00583000 IC R7,MULTCUU COUNT OF NUMBER OF MULTIPLES @V407466 00584000 LA R8,1(,R7) INCREMENT BY 1 @V407466 00585000 STCM R8,B'0001',MULTCUU STORE UPDATED COUNT @V407466 00586000 LA R8,4 L'CUU + L'DELIMITER @V407466 00587000 MR R6,R8 R7*R8 INTO R6-R7 @V407466 00588000 AR R9,R7 ADJUSTED MSG BUFFER PTR @V407466 00589000 STCM R1,B'0111',CPSMULT1 STORE ADDRESS IN MSG @V407466 00590000 MVI CPSDEL4,BLANK MSG DELIMITER @V407466 00591000 ST R9,SAVEWRK8 SAVE MSG BUFF PTR IN CASE MULTS @V407490 00592000 L R9,SAVER9 GET COMMAND LINE POINTER @VA15100 00593100 CALL DMKSCNFD FIND NEXT ADDR, IF ANY @V407466 00594000 BNZ FINMSG NO MORE ADDRS TO PROCESS @V407466 00595000 B VARYDEV VARY NEXT DEVICE @V407466 00597000 FINMSG L R9,SAVEWRK7 BEGINNING MSG BUFFER @V407466 00598000 CLC CPSADD1,=XL3'000000' ANY MSG SUBST. @V407466 00599000 BE SKIPMSG NO, SKIP MSG @V407466 00600000 L R9,SAVEWRK8 RESTORE MSG BUFFER PTR. @V407490 00601000 MVC CPSCON3(L'CPSCON3+1),=CL7'VARIED ' SUBT. CONS. @V407466 00602000 TM CPSBITS,ON VARY ONLINE @V407466 00603000 BO ONLINE YES, SUBSTITUE CONS 'ONLINE' @V407466 00604000 MVC CPSCON4,=CL7'OFFLINE' CONSTANT 'OFFLINE' @V407466 00605000 MSGLEN LA R0,CPSSIZE2 LENGTH OF SINGLE MSG @V407466 00606000 L R1,SAVEWRK7 ORIG. PTR TO WORK AREA @V407466 00607000 SR R9,R1 ACCOUNT FOR MULT ADDR MSG @V407466 00608000 AR R0,R9 ADD TO LENGTH @V407466 00609000 B SENDMSG SEND MSG @V407466 00610000 ONLINE MVC CPSCON4,=CL7'ONLINE ' SHOW ONLINE @VA10053 00611010 B MSGLEN ISSUE MESSAGE @V407466 00612000 MSGRANGE CLC CPSADD1,=XL3'000' FIRST ADDR ALREADY FILLED IN @V407466 00613000 BE FSTRADD STORE IN FIRST ADDRESS FIELD @V407466 00614000 STCM R1,B'0111',CPSADD2 STORE IN 2ND ADDRESS FIELD @V407466 00615000 NEXTRADD L R1,SAVEWRK9 LAST ADDR PROCESSED @V407466 00616000 NEXTRAD2 LA R3,IOBFRET BR ADDR IF NOT ISSUING MSG @V407466 00617000 CH R1,RADDR2 END OF RANGE PROCESSING @V407466 00618000 BNL CHKADDRS YES, END OF RANGE @V407490 00619000 LA R1,1(,R1) UP ADDRESS BY ONE @V407466 00620000 B CONTINUE PROCESS NEXT ADDRESS @V407466 00621000 FSTRADD STCM R1,B'0111',CPSADD1 FIRST ADDR IN RANGE @V407466 00622000 B NEXTRADD SEE IF END OF RANGE PROCESSING @V407466 00623000 ENDRADDR MVI CPSDEL1,CHARDASH MSG DELIMITER @V407466 00624000 SINGMSG MVC CPSCON1(L'CPSCON1+1),=CL7'VARIED ' SUB. CONSTANT@VA08438 00625000 MVI CPSDEL2,BLANK MSG DELIMITER @V407466 00626000 TM CPSBITS,ON VARY ONLINE REQUEST? @V407466 00627000 BO ONLINE2 YES @V407466 00628000 MVC CPSCON2,=CL7'OFFLINE' SUBSTITUTE OFFLINE @V407466 00629000 MSGSEND LA R0,CPSSIZE1 MSG LENGTH @V407466 00630000 LR R1,R9 MSG POINTER @V407466 00631000 B SENDMSG ISSUE MSG @V407466 00632000 ONLINE2 MVC CPSCON2,=CL7'ONLINE ' SHOW ONLINE @VA10053 00633010 B MSGSEND ISSUE MSG @V407466 00634000 SPACE 2 00635000 TSTRANGE TM CPSBITS,RANGE RANGE BEING PROCESSED? @V407466 00636000 BCR 14,R3 NO, NO PENDING SUCCESSFUL MSG @V407466 00637000 OI CPSBITS,VARYERR INDICATE PENDING ERROR MSG @V407466 00638000 CHKADDRS CLC CPSADD1,=XL3'000' FIRST ADDR ALREADY FILLED IN @V407466 00639000 BCR 8,R3 NO SUCCESSFUL RANGE MSG PENDING @V407466 00640000 CLC CPSADD2,=XL3'000' FULL RANGE MSG PENDING? @V407466 00641000 BNE ENDRADDR YES, FORMAT REST RANGE MSG @V407466 00642000 * SINGLE RADDR IN MESSAGE 00643000 MVC CPSDEL1(L'CPSDEL1+L'CPSADD2),=CL4' ' BL RADD2@V407466 00644000 B SINGMSG FORMAT REST OF SINGLE MSG @V407466 00645000 SPACE 00646000 VARYON EQU * @VA03757 00647000 SWITCH ENSURE RUNNING ON MAIN PROCESSOR @V407595 00648000 TM RDEVSTAT,RDEVDED IS THE DEVICE DEDICATED? @VA03757 00649000 BO DEVDED YES, CAN'T VARY ON THEN. @VA03757 00650000 TM RDEVTYPC,CLASDASD+CLASTAPE ALT PATH TYPE DEVICE?@V407438 00651000 BZ FINDEX NOPE, SKIP THE USE CHECK. @V407438 00652000 TM RDEVFLAG,RDEVSYS+RDEVOWN SYSTEM USE NOW @V407438 00653000 * CAN'T AFFORD TO ENABLE ONE PATH IF ANOTHER IS IN USE. 00654000 * IT COULD RESULT IN CC3 ON NON-VARY RELATED I/O. 00655000 BNZ CPS143 YES, CAN'T DO I/O TO IT. @V407438 00656000 FINDEX LA R1,RCUCHA ADDRESS OF THE FIRST CHANNEL @V407438 00657000 LA R2,4 INCREMENT @V407438 00658000 LA R3,RCUCHD ADDRESS OF THE LAST CHANNEL @V407438 00659000 NEXTCH CL R6,0(R1) R6 REPRESENT THIS CU -> CH PATH? @V407438 00660000 BE *+8 YES, PATH FOUND, BR. @V407438 00661000 BXLE R1,R2,NEXTCH NOPE, LOOK AT ALL CHANNEL PATHS @V407438 00662000 LA R2,RCUCHA ADDRESS OF THE BEGINNING AGAIN @V407438 00663000 SLR R1,R2 FIND HOW FAR DOWN WE FOUND IT @V407438 00664000 SRL R1,2 CONVERT TO INDEX FROM 0 TO 3 @V407438 00665000 IC R3,DISATBL(R1) GET CORRECT PATH OFFLINE BIT @V407438 00666000 EX R3,CUCHDISA (TM RCUSTAT,RCUCHXOF) PTH AVAIL? @V407438 00667000 BO GRADDR PATH IS OFFLINE, WORK TO DO @V407438 00668000 TM RCUSTAT,RCUDISA IS THE CONTROL UNIT OFFLINE? @V407438 00669000 BO GRADDR YES, WORK TO DO, BR. @V407438 00670000 TM RDEVSTAT,RDEVDISA DEVICE OFFLINE? @V407438 00671000 BZ FNDNPTH THIS PATH ON, CONTINUE WITH NEXT @V407438 00672000 GRADDR CALL DMKSCNRA GET RADDR IN CCU FORM @V407438 00673000 LA R6,256 TIO RETRY COUNT IS 256 @VA12448 00673100 LR R2,R1 SAVE THE DEVICE ADDR @VA03757 00674000 LTR R10,R10 DO WE HAVE A TIO IOBLOK? @VA03757 00675000 BNZ HAVEIOB YUP, SKIP FREE CALL @VA03757 00676000 LA R0,IOBSIZE SET SIZE OF BLOCK @VA03757 00677000 CALL DMKFREE AND GO GET IT @VA03757 00678000 LR R10,R1 ADDRESS THE BLOCK @VA03757 00679000 USING IOBLOK,R10 AS AN IOB @VA03757 00680000 LA R0,CPEXSIZE GET A CPEXBLOK TOO... @VA03757 00681000 CALL DMKFREE ... @VA03757 00682000 LR R5,R1 ADDRESS IT @VA03757 00683000 USING CPEXBLOK,R5 @VA03757 00684000 HAVEIOB XC IOBLOK(IOBSIZE*8),IOBLOK CLEAR IT OUT @VA03757 00685000 ST R5,IOBMISC SAVE THE CPEXBLOK ADDR @VA03757 00686000 ST R11,IOBUSER ... @VA03757 00687000 OI IOBSTAT,IOBPATHF FLAG THIS AS FIXED PATH FOR IOS@V407438 00688000 OI IOBSPEC,IOBTIO FLAG THIS AS A TIO REQUEST @V407438 00689000 STH R2,IOBRADD STUFF PATH ADDRESS IN THE IOB @V407438 00690000 LA R15,10 COUNT FOR CHANNEL ERRORS @VA12977 00690500 LA R2,TIODONE SET UP RETURN ADDRESS @V407438 00691000 ST R2,IOBIRA ... @V407438 00692000 IC R2,RCUSTAT CTLUNIT & CTL->CH ON/OFF STATUS @V407438 00693000 * R3 CONTAINS 1 BIT: RCUCHAOF, BOF, COF, OR DOF FROM ABOVE 00694000 ICM R2,B'0010',RDEVSTAT GET DEVICE ON/OFF STATUS @V407438 00695000 N R2,=AL1(0,0,RDEVDISA,RCUDISA+RCUCHAOF+RCUCHBOF+RCUCHCOF+X00696000 RCUCHDOF) PRESERVE ONLY PATH STATUS BITS 00697000 ST R2,IOBMISC2 SAVE FOR LATER @V407438 00698000 X R3,FFS FLIP/FLOP FOR PATH ENABLE @V407438 00699000 NI RDEVSTAT,X'FF'-RDEVDISA ENABLE THE DEVICE PATH @V407438 00700000 RETRYCH EQU * @VA12977 00700500 STM R0,R15,CPEXR0 SAVE THE REGS @VA03757 00701000 CALL DMKIOSQR GO QUEUE UP THE TIO REQUEST @VA03757 00702000 GOTO DMKDSPCH AND BEATIT FOR AWHILE @VA03757 00703000 SPACE 00704000 * RCU TO RCH BLOCK PATH AVAILABLE BITS IN RCUSTAT 00705000 DISATBL DC AL1(RCUCHAOF,RCUCHBOF,RCUCHCOF,RCUCHDOF) @V407438 00706000 CUCHDISA TM RCUSTAT,0 CHECK RCU -> RCH PATH AVAILBILITY@V407438 00707000 CUCHENAB NI RCUSTAT,0 ENABLE RCU -> RCH PATH @V407438 00708000 SPACE 00709000 TIODONE EQU * HERE WHEN TIO IS DONE @VA03757 00710000 L R5,IOBMISC ADDR OF CPEXBLOK @VA03757 00711000 LM R0,R15,CPEXR0 REGAIN ADDRESSABILITY, QUICK @VA03757 00712000 EX R3,CUCHENAB (NI RCUSTAT,X'FF'-RCUCHXOF) ENAB @VA08547 00713000 NI RCUSTAT,X'FF'-RCUDISA ENAB CTL UNIT @VA08547 00714000 TM IOBSTAT,IOBCC3 DID WE GET CC=3? @VA03757 00715000 BO CPSCC3 YES, BR @VA03757 00716000 BZ CPSCC0 NO, CC=0, BR @VA03757 00717000 TM IOBCSW+5,IFCC+CCC IFCC OR CCC ? @VA12977 00717300 BNZ ERRORCH YES, CHECK COUNT @VA12977 00717600 CLI RDEVTYPC,CLASTAPE IS THIS A TAPE? @VA09038 00718100 BE CKTAPE YES, BRANCH OUT @VA09038 00718110 CLI RDEVTYPC,CLASDASD IS THIS A DASD @VA09038 00718120 BNE CPSCC0 NO, ASSUME DEVICE THERE @VA09038 00718130 LH R2,IOBRADD LOAD REAL ADDRESS @VA09038 00718140 L R1,IOBIOER GET IOERBLOK POINTER @VA09038 00718150 LTR R1,R1 IOERBLOK PRESENT? @VA09038 00718160 BNZ CHKINT YES CHECK INT REQUIRED @VA12448 00718171 BCT R6,HAVEIOB RETRY UNTIL RETRY COUNT REACHED @VA12448 00718172 L R1,SAVEWRK9 GET DEV ADDR @VA12448 00718173 CALL DMKCVTBH CONVERT ADDR BACK TO HEX @VA12448 00718174 ST R1,SAVEWRK3 SAVE DEV ADDR @VA12448 00718175 LA R1,SAVEWRK3+1 POINT AT ADDR @VA12448 00718176 LA R0,3 LENGTH OF 3 @VA12448 00718177 B CPS149 GO SEND RESERVED MSG @VA12448 00718178 CHKINT EQU * @VA12448 00718179 USING IOERBLOK,R1 @VA09038 00718180 TM IOERDATA,X'40' INTERVENTION REQUIRED? @VA09038 00718190 BNO CPSCC3 YES, BRANCH OUT @VA09038 00718200 B CPSCC0 NO, ASSUME DEVICE THERE @VA09038 00718210 DROP R1 @VA09038 00718220 CKTAPE EQU * @VA09038 00718230 L R1,IOBIOER GET THE IOERBLOK @VA03757 00720000 LTR R1,R1 IS THERE ONE? @VA03757 00721000 BZ FNDNPTH FIND NEXT PATH @V407438 00722000 USING IOERBLOK,R1 ADDRESS IT @VA03757 00723000 TM IOERDATA,X'40' INT REQ? @VA03757 00724000 BZ FRETIOE2 NOPE, AGAIN NOT SERIOUS @VA03757 00725000 TM IOERDATA+1,X'60' STATUS A & B ON? @VA03757 00726000 BNZ FRETIOE2 SOMETHING ON, DEVICE THERE @VA03757 00727000 CPSCC3 EQU * DEVICE DOES NOT EXIST @VA03757 00728000 OI IOBSTAT,IOBCC3 MAKE SURE BOTH BITS ARE ON @VA03757 00729000 OC RCUSTAT(1),IOBMISC2+3 RESET CU & CU -> CH STATUS@V407438 00730000 OC RDEVSTAT(1),IOBMISC2+2 RESET THE DEVICE STATUS @V407438 00731000 B FRETIOER AND RETURN THE IOERBLOK @VA03757 00732000 SPACE 3 00733000 ERRORCH EQU * @VA12977 00733050 L R1,IOBIOER IOER BLOCK @VA12977 00733100 LTR R1,R1 IOERBLOK ? @VA12977 00733150 BZ NOIOER NO @VA12977 00733200 LA R0,IOERSIZE @VA12977 00733250 AH R0,IOEREXT-IOERBLOK(,R1) . . .PLUS EXTENSION @VA15139 00733260 * SIZE 00733261 CALL DMKFRET @VA12977 00733300 L R15,CPEXR15 RESTORE COUNT @VA12977 00733350 NOIOER EQU * @VA12977 00733400 BCTR R15,0 DECREMENT @VA12977 00733450 LTR R15,R15 10 CHANNEL ERRORS ? @VA12977 00733500 BZ CPS60X YES, SEND MESSAGE @VA12977 00733550 XC IOBCSW(8),IOBCSW CLEAR CSW @VA12977 00733600 NI IOBSTAT,X'FF'-IOBCC3 CCODE OFF @VA12977 00733650 B RETRYCH @VA12977 00733700 SPACE 00733750 CPSCC0 EQU * HERE IF DEVICE EXISTS @VA03757 00734000 SWITCH ENSURE RUNNING ON MAIN PROCESSOR @V407595 00735000 CLI RDEVTYPC,CLASTERM IS THIS A TERMINAL CLASS @VA03757 00736000 BNE CONT9 NO, CONTINUE @VA03757 00737000 TM RDEVTYPE,TYPBSC IS THIS A BISYNC LINE ? @VA03757 00738000 BZ CONT9 NO, CONTINUE @VA03757 00739000 NI RDEVSTAT,X'FF'-RDEVNRDY CLEAR THE NOT READY FLAG@VA03757 00740000 CONT9 EQU * @VA03757 00741000 CLI RDEVTYPC,CLASTAPE TAPE DEVICE? @V407466 00742000 BNE CONT10 NO, LOOK FOR DASD @V407466 00743000 TM CPSBITS,LBLREAD TAPE REL. BY DIFF. CCU @V407466 00744000 BO FRETIOER YES, NO NEED TO DO AGAIN @V407466 00745000 OI CPSBITS,LBLREAD IND. RELEASE CCW @V407466 00746000 LA R0,CPEXSIZE ACQUIRE CPEXBLOK TO GIVE @V407466 00747000 CALL DMKFREE CONTROL TO DMKTAPRL TO @V407466 00748000 LR R5,R1 PERFORM TAPE 'RELEASE' @V407466 00749000 XC CPEXBLOK(16),CPEXBLOK CLEAR BLOCK @V407466 00750000 L R1,=A(DMKTAPRL) ENTRY POINT TO PERFORM REL. @V407466 00751000 TRANS 2,1,OPT=(BRING,DEFER,SYSTEM,LOCK) ENSURE DMKTAP @V407466 00752000 * IS IN STORAGE AND LOCKED FOR DURATION OF 'RELEASE' 00753000 LR R1,R2 SAVE REAL ADDR OF DMKTAPRL @VA07358 00754000 LH R2,IOBRADD DEVICE ADDRESS @V407466 00755000 STM R0,R15,CPEXREGS STORE CALLER'S REGISTERS @V407466 00756000 ST R1,CPEXADD EXECUTION ADDR IN CPEXBLOK @V407466 00757000 ST R1,CPEXR12 AND AS MODULE BASE ADDRESS @V407466 00758000 MVC CPEXR11,ASYSVM STACK CPEXBLOK FOR SYSTEM @VA11960 00758100 LR R1,R5 CPEXBLOK ADDR TO R1 FOR CALL @V407466 00759000 L R5,IOBMISC RESTORE ORIG. CPEXBLOK ADDR @V407466 00760000 CALL DMKSTKCP STACK CPEXBLOK @V407466 00761000 B FRETIOER RELEASE IOERBLOK @V407466 00762000 CONT10 CLI RDEVTYPC,CLASDASD DASD DEVICE? @V407466 00763000 BNE FRETIOER NOPE, SKIP THE DUMMY INT @VA03757 00764000 TM CPSBITS,LBLREAD LABEL PROCESSED BY DIFF CCU? @V407466 00765000 BO FRETIOER YUP, BR. @V407438 00766000 TM IOERDATA,X'40' INT REQUIRED? @VA12965 00766100 BO FRETIOER YES, THEN LET ATTACH READ LABEL @VA12965 00766200 OI CPSBITS,LBLREAD INDICATE LABEL PROCESSED @V407466 00767000 TM RDEVFLAG,RDEVSYS+RDEVOWN PREVIOUSLY MOUNTED ? @VA03757 00768000 BNZ *+8 YES - DON'T RESET FLAG @VA03757 00769000 OI RDEVFLAG,RDEVMOUT MOUNT THE DEVICE @VA03757 00770000 LA R0,IOBSIZE GET AN IOB FOR THE DUMMY @VA03757 00771000 CALL DMKFREE DEV END I/O INTERRUPT @VA03757 00772000 LR R3,R10 SAVE THE ADDR OF THE TIO IOB @VA03757 00773000 LR R10,R1 ADDRESS THE DE IOB @VA03757 00774000 XC IOBLOK(IOBSIZE*8),IOBLOK CLEAR IT OUT @VA03757 00775000 ST R10,IOBLINK LINK TO SELF @VA03757 00776000 MVC IOBRADD(2),IOBRADD-IOBLOK(R3) SETUP DEV ADD @VA03757 00777000 L R2,ASYSVM SET USER TO SYSTEM @VA03757 00778000 ST R2,IOBUSER ... @VA03757 00779000 L R2,=A(DMKDSBRD) AIM AT DASD FOR LABEL @VA08187 00780000 ST R2,IOBIRA READING @VA03757 00781000 MVI IOBCSW+4,DE INDICATE AN UNSOL INT. @VA03757 00782000 OI IOBSPEC,IOBUNSL FLAG AS UNSOLICITED INT @VA03757 00783000 CALL DMKSTKIO GO STACK THE DE IOB @VA03757 00784000 LR R10,R3 RE-ADDRESS THE TIO IOB @VA03757 00785000 CLI RDEVTYPE,TYP2305 SPECIAL HANDLING NEEDED? @VA03757 00786000 BE VRY2305 YES - GO TO IT @VA03757 00787000 FRETIOER EQU * @VA03757 00788000 L R1,IOBIOER GET THE IOERBLOK @VA03757 00789000 LTR R1,R1 IS THERE ONE? @VA03757 00790000 BZ TESTCC3 NOPE, THEN DON'T FRET @VA03757 00791000 FRETIOE2 EQU * RELEASE THE IOERBLOK @VA03757 00792000 LA R0,IOERSIZE BASIC SIZE IN DBL-WDS @VA03757 00793000 AH R0,IOEREXT . . .PLUS EXTENSION SIZE @VA03757 00794000 CALL DMKFRET AND RETURN IT @VA03757 00795000 DROP R1 @VA03757 00796000 TESTCC3 TM IOBSTAT,IOBCC3 IS THE DEVICE THERE? @VA03757 00797000 BO NOCCU NOT BY THAT PATH NAME, BR. @V407438 00798000 TM RDEVTYPC,CLASDASD+CLASTAPE IS IT DASD OR TAPE? @V407438 00799000 BZ VARYNDEV NOPE, CONTINUE WITH NEXT DEVICE @V407438 00800000 FNDNPTH CALL DMKSCNNP YUP, THEN FIND THE NEXT PATH @V407438 00801000 BZ VARYON GOT NEXT PATH, GO PROCESS IT @V407438 00802000 NI CPSBITS,X'FF'-LBLREAD DONE WITH THIS DEVICE @V407466 00803000 TM RDEVSTAT,RDEVDISA DEVICE ONLINE BY ANOTHER PATH?@V407438 00804000 BZ VARYNDEV YES, GO PROCESS NEXT DEVICE @V407438 00805000 B CPS040 NOPE, SEND MSG AND CONTINUE @V407438 00806000 SPACE 00807000 NOCCU TM RDEVTYPC,CLASDASD+CLASTAPE IS IT DASD OR TAPE? @V407438 00808000 BNZ FNDNPTH YES, GO FIND NEXT PATH TO DEVICE @V407438 00809000 B CPS040 SEND MSG AND CONTINUE @V407438 00810000 SPACE 00811000 FRETIOB LA R0,IOBSIZE . . . @VA03757 00812000 CALL DMKFRET . . . @VA03757 00813000 DROP R10 @VA03757 00814000 SLR R10,R10 CLEAR R10 TO IND. NO IOBLOK @V407466 00815000 LA R0,CPEXSIZE GET SIZE OF CPEXBLOK @VA03757 00816000 LR R1,R5 GET ADDR OF CPEXBLOK @VA03757 00817000 CALL DMKFRET GET RID OF IT @VA03757 00818000 DROP R5 @VA03757 00819000 LR R1,R2 @VA03757 00820000 BR R3 FIRE OFF TO DESTINATION @VA03757 00821000 SPACE 2 00822000 VRY2305 EQU * @VA03757 00823000 L R1,SAVEWRK9 GET 'CUU' FORM ADDRESS @VA04578 00824000 LA R4,7 NUMBER OF REMAINING ADDRS @VA03757 00825000 VON2305 EQU * @VA03757 00826000 LA R1,1(,R1) ADD 1 FOR NEXT ADDRESS @VA03757 00827000 CALL DMKSCNRU GO GET THE CTL BLOKS @VA03757 00828000 NI RDEVSTAT,255-RDEVDISA MARK DEVICE ONLINE @VA03757 00829000 BCT R4,VON2305 DO ALL REMAINING EXPOSURES @VA03757 00830000 NI CPSBITS,X'FF'-LBLREAD DONE WITH THIS DEVICE @VA11530 00831100 USING IOBLOK,R10 IOB ADDRESSABILITY @V407466 00832000 TM CPSBITS,RANGE RANGE PROCESSING @V407466 00833000 BO UPADDR INCREM PAST EXPOSURE 0 @V407466 00834000 L R1,SAVEWRK9 GET ADDR OF EXPOSURE 0 @VA04578 00835000 SCNRU CALL DMKSCNRU GET THE BLOKS BACK @VA07283 00836000 LR R4,R1 SAVE DEVICE ADDRESS TEMPORARILY @VA07283 00837000 USING IOERBLOK,R1 ADDRESSABILITY 00838000 L R1,IOBIOER GET THE IOERBLOK ADDRESS @VA07283 00839000 LTR R1,R1 IS THERE ONE? @VA07283 00840000 BZ CC3TST NOPE, THEN DON'T FRET @V407466 00841000 LA R0,IOERSIZE BASIC SIZE IN DBL-WDS @V407466 00842000 AH R0,IOEREXT ... PLUS EXTENSION SIZE @V407466 00843000 CALL DMKFRET AND RETURN IT @V407466 00844000 CC3TST LR R1,R4 RESTORE DEVICE ADDRESS @VA07283 00845000 TM IOBSTAT,IOBCC3 IS THE DEVICE THERE? @VA07283 00846000 BO CPS040 DEVICE DOES NOT EXIST MESSAGE @V407466 00847000 B CONVERT OTHERWISE CONVERT ADDRESS @V407466 00848000 DROP R10 @V407466 00849000 DROP R1 @V407466 00850000 UPADDR LR R4,R1 SAVE LAST EXP. ADDR @V407466 00851000 L R1,SAVEWRK9 EXP. 0 ADDR @V407466 00852000 ST R4,SAVEWRK9 RANGE PROC. ON EXP. 0 ADDR ONLY @V407466 00853000 B SCNRU GET BLOKS BACK @V407466 00854000 EJECT 00855000 VARYOFF EQU * @V407595 00856000 SWITCH ENSURE RUNNING ON MAIN PROCESSOR @V407595 00857000 TM RDEVSTAT,RDEVDED DEDICATED DEVICE ? @V407595 00858000 BO DEVDED YES, CAN'T FIDDLE WITH IT @VA03757 00859000 TM RDEVSTAT,RDEVDISA OFFLINE ALREADY? @VA03757 00860000 BO VARYNDEV YES, DONE HERE, GET NEXT @VA03757 00861000 TM RDEVSTAT,RDEVBUSY+RDEVSCED BUSY OR SCHEDULED? @VA03757 00862000 BNZ CPS143 YES, CANT TAKE IT THEN... @VA03757 00863000 TM RDEVTYPC,CLASTERM+CLASGRAF MAYBE VIRT CON? @VA03757 00864000 BZ CHEKUR NO - CHECK UR @VA03757 00865000 TM RDEVTYPE,TYPBSC IS THIS A BISYNC LINE ? @VA03757 00866000 BZ CONTN NO, BYPASS @VA03757 00867000 TM RDEVSTAT,RDEVRSVD IS BISYNC LINE IN USE BY @VA03757 00868000 * SYSTEM 00869000 BO ENABERR YES, ... @VA03757 00870000 B TURNOFF GO VARY OFFLINE @VA03757 00871000 CONTN EQU * @VA03757 00872000 TM RDEVFLAG,RDEVENAB ENABLED ???? @VA03757 00873000 BO ENABERR YES - CAN'T VARY OFF @VA03757 00874000 B TURNOFF OK TO VARY OFF -- @VA03757 00875000 SPACE 00876000 CHEKUR EQU * @VA03757 00877000 TM RDEVTYPC,CLASURI+CLASURO IS THIS SPOOL DEVICE @VA03757 00878000 BZ CHEKTAPE NO, GO CHECK FOR TAPE DEVICE @VA03757 00879000 TM RDEVFLAG,RDEVDRAN DRAIN FLAG ON ???? @VA03757 00880000 BZ NOTDRAN NO - CAN'T VARY ACTIVE SPOOLING @VA03757 00881000 * DEV. OFF 00882000 L R0,RDEVSPL MAY BE DRAINED BUT STILL ACTIVE @VA03757 00883000 LTR R0,R0 IS IT ???? @VA03757 00884000 BZ TURNOFF NO - GO AHEAD AND VARY IT OFF @VA03757 00885000 EJECT 00886000 NOTDRAN BAL R3,TSTRANGE RANGE BEING PROCESSED? @V407466 00887000 L R1,SAVEWRK9 LOAD DEVICE ADDR FOR ERROR @V407466 00888000 BAL R3,GETYPE GET TYPE AND ADDR IN SAVEWRK2 @V407466 00889000 LA R0,8 FIELD LENGTH @VA03757 00890000 LA R1,SAVEWRK2 FIELD ADDRESS @VA03757 00891000 B CPS142 GO SEND ERROR MESSAGE @VA03757 00892000 SPACE 3 00893000 CHEKTAPE CLI RDEVTYPC,CLASTAPE IS THIS A TAPE DEVICE ? @VA03757 00894000 BNE CHEKDASD NO - TRY DASD DEVICE @VA03757 00895000 TM RDEVFLAG,RDEVSYS IS THIS TAPE IN USE ? @VA03757 00896000 BO CPS143 YES - ERROR MESSAGE @VA03757 00897000 TURNOFF CLC RDEVTYPC(2),P3800 IS IT A 3800 ? @V60B9BA 00898000 BNE TURNOFF2 I GUESS IT ISN'T @V60B9BA 00899000 * UNLOAD THE ERROR LOG BUFFER @V60B9BA 00900000 LA R0,IOBSIZE GET A DUMMY IOB @V60B9BA 00901000 CALL DMKFREE GO GET IT @V60B9BA 00902000 XC 0(IOBSIZE*8,R1),0(R1) GO AND CLEAR IT @V60B9BA 00903000 LR R10,R1 INTO R10 FOR DMKRSESD @V60B9BA 00904000 CALL DMKRSESD UNLOAD THE ERROR LOG @V60B9BA 00905000 CALL DMKFRET FRET THE DUMMY IOBLOK @V60B9BA 00906000 * CLEAR THE DELAYED PURGE QUEUE @V60B9BA 00907000 TRYNXTF L R7,RDEVDELP GET THE DELAYED PURGE ANCHOR @V60B9BA 00908000 LTR R7,R7 ANY FILES LEFT TO PURGE? @V60B9BA 00909000 BZ TURNOFF2 NOTHING TO PURGE IF ZERO @V60B9BA 00910000 MVC RDEVDELP,0(R7) NEXT IS NOW FIRST @V60B9BA 00911000 CALL DMKSPLDL GO AND DELETE THE SPOOL FILE @V60B9BA 00912000 B TRYNXTF TRY THE NEXT ONE @V60B9BA 00913000 SPACE 3 @V60B9BA 00914000 TURNOFF2 OI RDEVSTAT,RDEVDISA MAKE DEVICE UNAVAILABLE @V60B9BA 00915000 TESTSDR1 ICM R15,15,RDEVCTRS PICK UP ADDRESS OF SDRBLOK @VA03757 00916000 BNP VARYNDEV NO SDRBLOK, GET NEXT DEVICE @VA03757 00917000 CALL DMKIOESR GO RECORD OBR SYNCHRONOUSLY @VA03757 00918000 B VARYNDEV GET NEXT DEVICE @VA09265 00918100 SPACE 3 00918200 CHEKDASD EQU * CHECK FOR DASD DEVICES @VA03757 00919000 CLI RDEVTYPC,CLASDASD IS THIS A DASD DEVICE ? @VA03757 00920000 BNE CHEKSPEC NO -- @VA03757 00921000 TM RDEVFLAG,RDEVOWN CP-OWNED DEVICE ? @VA03757 00922000 BO CPOWNERR IF IT IS, CAN'T VARY OFF @VA03757 00923000 TM RDEVFLAG,RDEVSYS SYSTEM DEVICE ????? @VA03757 00924000 BZ CKMULT NO - CHECK FOR 2305 @VA03757 00925000 LH R4,RDEVLNKS ANY LINKS TO DASD ???? @VA03757 00926000 LTR R4,R4 ....... @VA03757 00927000 BNZ LINKERR CAN'T VARY OFF IF USERS LINKED @VA03757 00928000 * TO IT 00929000 B CPS143 Leave alone - attached to system HRC039DK 00929100 CKMULT L R1,SAVEWRK9 GET 'CUU' FORM ADDR @VA04578 00930000 LA R4,1 ASSUME SINGLE EXPOSURE DEVICE @VA04578 00931000 CLI RDEVTYPE,TYP2305 IS THIS A 2305? @VA04578 00932000 BNE DASDOFF NO. LOOP COUNTER IS CORRECT @VA04578 00933000 LA R4,8 NUMBER OF EXPOSURES TO VARY IS 8 @VA04578 00934000 LA R1,7(,R1) CONTRUCT HIGHEST EXPOSURE ADDRESS@VA04578 00935000 OFFLOOP CALL DMKSCNRU GO GET THE CONTROL BLOKS @VA04578 00936000 TM RDEVSTAT,RDEVBUSY+RDEVSCED IS EXPOSURE BUSY? @VA04578 00937000 BNZ BCK2305 YES. CAN'T VARY DEVICE OFF @VA04578 00938000 BCTR R1,0 SUBTRACT 1 TO DERIVE NEXT ADDRESS@VA04578 00939000 DASDOFF OI RDEVSTAT,RDEVDISA MARK DEVICE OFFLINE @VA04578 00940000 TM RDEVFTR,SYSVIRT+VIRTUAL IS THIS MSS? @VA10877 00940100 BZ N3330V NO DEMOUNT NECESSARY @VA10877 00940150 TM RDEVFLAG,RDEVSEL SELECTED FOR MOUNT? @VA10877 00940200 BO N3330V DO NOT DEMOUNT @VA10877 00940250 CLC RDEVSER(6),BLANKS IS A VOL. MOUNTED @VA10877 00940300 BE N3330V NOTHING TO DEMOUNT @VA10877 00940350 TM PSAMSS,MSSPRES IS THE CPSERVER THERE? @VA10877 00940400 BZ DMNTFAIL CAN'T BLANK THE VOLSER @VA10877 00940450 CALL DMKSSSDE GO TO DEMOUNT VOLUME @VA10877 00940500 LTR R0,R0 DEMOUNT GO OK? @VA10877 00940550 BNZ DMNTFAIL LEAVE VOLSER IN RDEVBLOK FOR @VA10877 00940600 * RECOVERY 00940650 N3330V EQU * @VA10877 00940700 BCT R4,OFFLOOP PROCESS THE REMAINING EXPOSURES @VA04578 00941000 MVC RDEVSER(6),BLANKS BLANKOUT VOLUME SERIAL FIELD @VA04578 00942000 DMNTFAIL EQU * @VA10877 00942100 B VARYNDEV SEE IF THERE'S MORE WORK @VA03757 00943000 SPACE 00944000 BCK2305 EQU * BACK OUT OF 2305 VARY OFF @VA03757 00945000 L R1,SAVEWRK9 GET ADDRESS OF EXPOSURE 0 @VA04719 00946000 LA R4,8 AND NUMBER OF EXPOSURES @VA03757 00947000 BOF2305 EQU * @VA03757 00948000 CALL DMKSCNRU GO FIND THE CTL BLOKS @VA03757 00949000 NI RDEVSTAT,255-RDEVDISA BRING BACK THE DEVICE @VA03757 00950000 LA R1,1(,R1) ADD 1 FOR NEXT ADDRESS @VA03757 00951000 BCT R4,BOF2305 DO 'EM ALL @VA03757 00952000 L R1,SAVEWRK9 GET EXPOSURE 0 AGAIN @VA04578 00953000 CALL DMKSCNRU AND THEN THE BLOKS @VA03757 00954000 B CPS143 GO TELL HIM THE BOX IS BUSY @VA03757 00955000 SPACE 00956000 CHEKSPEC EQU * CHECK FOR SPECIAL-CLASS DEVICES @VA03757 00957000 CLI RDEVTYPE,TYP3705 REAL 370X ? @VA03757 00958000 BNE TURNOFF NO -- JUST VARY IT OFFLINE @VA03757 00959000 TM RDEVSTAT,RDEVRSVD IN USE BY SYSTEM? @VA03757 00960000 BO CPS143 YES, SO INFORM USER @VA03757 00961000 TM RDEVFLAG,RDEVRCVY+RDEVEPLN CHECK FURTHER @VA03757 00962000 BNZ CPS143 SYSTEM HAS IT @VA03757 00963000 TM RDEVFLAG,RDEVLNCP LOADED WITH NCP? @VA03757 00964000 BZ NONCPEP NOPE @VA03757 00965000 LH R0,RDEVMAX MAX RESOURCE ID @VA03757 00966000 MH R0,=AL2(NICSIZE) SIZE IN DOUBLE WORDS @VA03757 00967000 AH R0,=AL2(NICSIZE) PLUS ONE FOR NO. OF NICBLOKS @VA03757 00968000 L R1,RDEVNICL ADDRESS OF THE LIST @VA03757 00969000 CALL DMKFRET RETURN THE STORAGE @VA03757 00970000 MVC RDEVNICL(4),ZEROES NO MORE ACTIVE @VA03757 00971000 NONCPEP NI RDEVFLAG,255-(RDEVLNCP+RDEVLCEP) ... @VA03757 00972000 B TURNOFF @VA03757 00973000 EJECT 00974000 SPACE 00975000 DEVDED BAL R3,TSTRANGE RANGE BEING PROCESSED? @V407466 00976000 L R1,SAVEWRK9 LOAD DEVICE ADDR FOR ERROR MSG @V407466 00977000 BAL R3,GETYPE GET TYPE AND ADDR IN SAVEWRK2 @V407466 00978000 MVI SAVEWRK4,X'00' INSERT SEPARATER @VA03757 00979000 L R1,RDEVUSER LOAD USERS VMBLOK ADDRESS @VA03757 00980000 DROP R11 @VA03757 00981000 USING VMBLOK,R1 @VA03757 00982000 MVC SAVEWRK4+1(8),VMUSER USERID TO MESSAGE @VA03757 00983000 DROP R1 @VA03757 00984000 USING VMBLOK,R11 @VA03757 00985000 LA R0,17 FIELD LENGTH @VA03757 00986000 LA R1,SAVEWRK2 ADDRESS OF FIELD @VA03757 00987000 B CPS140 SEND ATT ERROR MESSAGE @VA03757 00988000 SPACE 00989000 LINKERR EQU * SET UP FOR CPS124 ERROR @VA03757 00990000 BAL R3,TSTRANGE RANGE BEING PROCESSED? @V407466 00991000 BAL R3,BLDADR GET REAL ADDRESS @V407466 00992000 N R1,X40FFS BLANK HIGH BYTE @VA03757 00993000 ST R1,SAVEWRK2 STASH IT @VA03757 00994000 LR R1,R4 NUMBER OF USER LINKED @VA03757 00995000 CALL DMKCVTBD CONVERT THE NUMBER @VA03757 00996000 STCM R1,7,SAVEWRK3+1 SHOULD ONLY REQUIRE THREE DIGITS@VA03757 00997000 MVI SAVEWRK3,X'00' INSERT SEP. @VA03757 00998000 LA R2,2 BLANK OUT HIGH ORDER ZEROS @VA03757 00999000 CLI SAVEWRK3+1,X'F0' EBCDIC ZERO ??? @VA03757 01000000 BNE SEND124 NO - GO SEND ERROR @VA03757 01001000 MVI SAVEWRK3+1,X'40' BLANK IT @VA03757 01002000 CLI SAVEWRK3+2,X'F0' NEXT ONE ??? @VA03757 01003000 BNE SEND124 ... @VA03757 01004000 MVI SAVEWRK3+2,X'40' ... @VA03757 01005000 SEND124 LA R1,SAVEWRK2 @VA03757 01006000 LA R0,8 FIELD LENGTH @VA03757 01007000 B CPS124 SEND THE ERROR MESSAGE @VA03757 01008000 SPACE 01009000 CPOWNERR EQU * SET UP FOR CPS123 ERROR MESSAGE @VA03757 01010000 BAL R3,TSTRANGE RANGE BEING PROCESSED? @V407466 01011000 BAL R3,BLDADR GET REAL ADDRESS @V407466 01012000 STCM R1,7,SAVEWRK2 STORE THE ADDRESS @VA03757 01013000 LA R0,3 FIELD LENGTH @VA03757 01014000 LA R1,SAVEWRK2 ADDRESS @VA03757 01015000 B CPS123 SEND IT @VA03757 01016000 SPACE 01017000 ENABERR EQU * @VA03757 01018000 BAL R3,TSTRANGE RANGE BEING PROCESSED? @V407466 01019000 L R1,SAVEWRK9 RETRIEVE DEV. ADDR @VA03757 01020000 BAL R3,GETYPE GET TYPE AND ADDR IN SAVEWRK2 @V407466 01021000 LA R0,8 FIELD LENGTH @VA03757 01022000 LA R1,SAVEWRK2 FIELD ADDRESS @VA03757 01023000 B CPS049 SEND THE ERROR MESSAGE @VA03757 01024000 SPACE 01025000 BLDADR L R1,SAVEWRK9 GET THE CMD LINE ADDRESS (CCU) @V407438 01026000 CALL DMKCVTBH CONVERT IT TO HEX @VA03757 01027000 BR R3 RETURN @V407466 01028000 SPACE 01029000 GETYPE EQU * DEVELOP TYPE AND RADDR @VA03757 01030000 CALL DMKCVTBH GET DEVICE ADDRESS IN HEX @VA03757 01031000 ST R1,SAVEWRK3 SAVE ADDRESS IN MESSAGE @VA03757 01032000 MVI SAVEWRK3,X'00' PUT IN SEPARATER @VA03757 01033000 CALL DMKSCNRN GET REAL NAME @VA03757 01034000 ST R1,SAVEWRK2 SAVE NAME IN MESSAGE AREA @VA03757 01035000 BR R3 RETURN @V407466 01036000 SPACE 1 01037000 SENDMSG EQU * @VA03757 01038000 CALL DMKQCNWT,PARM=NORET SEND THE MESSAGE @VA03757 01039000 L R9,SAVEWRK7 MSG AREA ADDR @V407466 01040000 XC CPSADD1(MSGSIZE*8),CPSADD1 CLEAR MSG AREA @V407466 01041000 SKIPMSG TM CPSBITS,VARYERR ERROR MESSAGE PENDING ? @V407466 01042000 BCR 1,R3 YES, RETURN TO ISSUE ERROR MSG @V407466 01043000 IOBFRET TM CPSBITS,ON VARY ONLINE REQUEST @V407466 01044000 BO IOBADDR REL. IOBLOK IF NECESSARY @V407466 01045000 CPSEXIT L R1,SAVEWRK7 ADDR OF MSG BUFFER @V407466 01046000 LA R0,MSGSIZE SIZE OF BUFFER @V407466 01047000 CALL DMKFRET RELEASE STORAGE @V407466 01048000 TM CPSBITS,RANGE PROCESSING A RANGE? @VA12646 01048040 BNO ONEDEV NO, CONTINUE @VA12646 01048080 LH R1,RADDR1 GET STARTING ADDRESS OF RANGE @VA12646 01048120 LH R4,RADDR2 GET ENDING ADDRESS OF RANGE @VA12646 01048160 B GETBLOKS @VA12646 01048200 ONEDEV DS 0H @VA12646 01048240 L R9,SAVER9 GET COMMAND LINE POINTER @VA15100 01048260 USING BUFFER,R9 @VA15100 01048280 L R14,BUFNXT GET COMMAND POINTER @VA15100 01048300 L R15,SAVEWRK6 GET CNT AT ENTRY @VA15100 01048320 LA R15,0(,R15) Strip top byte HRC041DK 01048330 A R14,BUFCNT ADD RESIDUAL COUNT @VA15100 01048340 SR R14,R15 SUB COUNT AT ENTRY @VA15100 01048360 STM R14,R15,BUFNXT STORE CMD AND COUNT @VA15100 01048380 DROP R9 @VA15100 01048400 CALL DMKSCNFD POINT TO ON OFF OPTION @VA15100 01048420 TESTMULT DS 0H @VA15100 01048440 L R9,SAVER9 LOAD SAVED CMD POINTER @VA15100 01048460 CALL DMKSCNFD FIND NEXT PARM @VA15100 01048480 BNZ PNDRESET NO MORE TO RESET @VA15100 01048500 CALL DMKCVTHB CONVERT TO DEVICE ADDRESS @VA15100 01048520 ST R1,SAVEWRK9 SAVE FOR POSS ERROR MSG @VA15100 01048540 GETBLOKS DS 0H @VA15100 01048560 CALL DMKSCNRU FIND DEV CONTROL BLOCKS @VA15100 01048580 BNZ TESTFINI BRANCH IF NONE FOUND @VA15100 01048600 TM RDEVSTA3,RDEVPBYP MULT VARY FOR SAME DEV ? @VA15100 01048620 BO RESETBYP YES, DON'T RESET PENDING @VA15100 01048640 NI RDEVSTA3,X'FF'-RDEVPEND RESET VARY PENDING @VA15100 01048660 RESETBYP DS 0H @VA15100 01048680 NI RDEVSTA3,X'FF'-RDEVPBYP TURN OFF VARY BYPASS @VA15100 01048700 TESTFINI DS 0H @VA15100 01048720 TM CPSBITS,RANGE PROCESSING A RANGE ? @VA15100 01048740 BNO TESTMULT NO, SEE IF MULT DEVICES @VA15100 01048760 CLR R1,R4 LAST DEVICE ? @VA15100 01048780 BNL PNDRESET YES, BRANCH @VA15100 01048800 LA R1,1(0,R1) GET NEXT DEVICE ADDRESS @VA15100 01048820 B GETBLOKS GO FIND BLOCKS FOR DEV @VA15100 01048840 PNDRESET DS 0H @VA15100 01048860 SLR R2,R2 CLEAR R2 @V407466 01049000 IC R2,LASTRC ERROR NUMBER OF LAST MSG @V407466 01050000 ST R2,SAVER2 RETURN CODE IN USER'S R2 @V407466 01051000 EXIT RETURN TO DMKCFM @V407466 01052000 DROP R6,R7,R8 @VA03757 01053000 IOBADDR LTR R1,R10 ANY IOBLOK REMAINING @V407466 01054000 BZ CPSEXIT NO, JUST EXIT @V407466 01055000 LA R3,CPSEXIT EXIT ADDRESS @V407466 01056000 B FRETIOB RELEASE IOBLOK @V407466 01057000 SPACE 01058000 COMPOFF CLC 0(0,R1),=C'OFFLINE ' EXECUTED COMPARE @VA03757 01059000 COMPON CLC 0(0,R1),=C'ONLINE ' @VA03757 01060000 DASH DC C'-' RANGE SCAN CHARACTER @V407466 01061000 P3800 DC AL1(CLASURO,TYP3800) FOR COMPARISONS @V60B9BA 01062000 SPACE 01063000 BLANK EQU X'40' @V407466 01064000 CHARDASH EQU C'-' REANGE DELIMITER @V407466 01065000 BIN0 EQU X'00' RESET SWITCH @V407466 01066000 SPACE 2 01067000 MSG DSECT @V407466 01068000 CPSADD1 DS XL3 FIRST ADDRESS IN RANGE @V407466 01069000 CPSDEL1 DS CL1 RANGE DELIMITER '-' @V407466 01070000 CPSADD2 DS XL3 SECOND ADDR IN RANGE @V407466 01071000 CPSDEL2 DS CL1 MSG DELIMITER @V407466 01072000 CPSCON1 DS CL6 'VARIED' CONSTANT @V407466 01073000 CPSDEL3 DS CL1 MSG DELIMITER @V407466 01074000 CPSCON2 DS CL7 CONSTANT 'ONLINE/OFFLINE' @V407466 01075000 CPSSIZE1 EQU *-CPSADD1 MSG LENGTH @V407466 01076000 ORG CPSADD1 @V407466 01077000 CPSMULT1 DS CL3 FIRST MULTIPLE ADDRESS @V407466 01078000 CPSDEL4 DS CL1 MSG DELIMITER @V407466 01079000 CPSCON3 DS CL6 CONSTANT 'VARIED' @V407466 01080000 CPSDEL5 DS CL1 MSG DELIMITER @V407466 01081000 CPSCON4 DS CL7 CONSTANT 'ONLINE/OFFLINE' @V407466 01082000 CPSSIZE2 EQU *-CPSMULT1 MSG LENGTH @V407466 01083000 DS 24D UP TO 47 MULTIPLE ADDRESSES @V407466 01084000 MSGSIZE EQU (*-CPSMULT1+7)/8 BUFFER SIZE IN DBL. WORDS @V407466 01085000 SPACE 2 01086000 DMKCPS CSECT , RE-ENTER MAIN CSECT @V407466 01087000 EJECT 01088000 *. 01089000 * 01090000 * SUBROUTINE NAME - 01091000 * 01092000 * DMKCPSH 01093000 * 01094000 * 01095000 * FUNCTION - 01096000 * 01097000 * TO ISSUE A HIO TO THE SPECIFIED REAL DEVICE. 01098000 * 01099000 * 01100000 * COMMAND FORMAT - 01101000 * 01102000 * +--------+---------+ 01103000 * | HALT | RADDR | 01104000 * | HALT | | 01105000 * +--------+---------+ 01106000 * 01107000 * 01108000 * OPERATION - 01109000 * 01110000 * 1. CALL DMKSCNFD TO GET RADDR ARGUMENT. IF NONE IS FOUND, 01111000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCPS021E. 01112000 * 2. CALL DMKCVTHB TO CONVERT THE ADDRESS TO BINARY. IF THE 01113000 * CONVERT FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE 01114000 * DMKCPS021E. 01115000 * 3. CALL DMKSCNRU TO LOCATE THE DEVICE BLOKS. IF NOT FOUND, 01116000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCPS040E. 01117000 * 4. IF NO ACTIVE IOBLOK IS FOUND CALL DMKIOSQR TO 01118000 * SCHEDULE A HALT DEVICE. 01119000 * 5. IF THA ACTIVE IOBLOK IS CP GENERATED CALL 01120000 * DMKIOSHA TO HALT THE DEVICE. 01121000 * 6. IF NOT CP GENERATED CALL DMKCFPRD TO RESET THE VIRTUAL 01122000 * DEVICE AND SEND MSG DMKCPS114 TO THE VIRTUAL USER. 01123000 * 7. CALL DMKCFMBK TO PUT THE VIRTUAL USER IN CF MODE AND EXIT. 01124000 * 01125000 * RESPONSES - 01126000 * DEVICE HALTED 01127000 * 01128000 * ERROR MESSAGES - 01129000 * DMKCPS021E RADDR MISSING OR INVALID 01130000 * DMKCPS040E DEV (ADDR) DOES NOT EXIST 01131000 * DMKCPS144W (TYPE) (VADD) RESET BY (USERID) 01132000 * 01133000 *. 01134000 EJECT 01135000 DMKCPSH RELOC ISSUE HALT TO REAL DEVICE @VA03757 01136000 CALL DMKSCNFD GET REAL DEVICE ADDRESS @VA03757 01137000 BNZ CPS021NR NO ARGUMENTS, MSG021 W/ NO RETURN@V407466 01138000 CL R0,F3 CAN'T HAVE OVER THREE DIGIT @VA03757 01139000 * ADDRESS 01140000 BH CPS021NR BR IF IT IS, MSG021 W/ NO RETURN @V407466 01141000 CALL DMKCVTHB CONVERT ADDRESS @VA03757 01142000 BNZ CPS021NR INVALID ADDR, MSG021 W/ NO RETURN@V407466 01143000 CALL DMKSCNRU GET REAL DEVICE BLOKS @VA03757 01144000 BNZ CPS040NR NONEXIST. UNIT, MSG040 W/ NO RET.@V407466 01145000 USING RCHBLOK,R6 @VA03757 01146000 USING RCUBLOK,R7 @VA03757 01147000 USING RDEVBLOK,R8 @VA03757 01148000 USING IOBLOK,R10 @VA03757 01149000 SWITCH ENSURE RUNNING ON MAIN PROCESSOR @V407595 01150000 L R10,RDEVAIOB POINT TO THE ACTIVE IOB @VA03757 01151000 LTR R10,R10 ANY ACTIVE IOB ? @VA03757 01152000 BP TSTCPGEN YES- BRANCH @VA04182 01153000 CL R8,RDEVFIOB ANY IOB'S QUEUED (DEVICE BUSY) @VA04182 01154000 BE SCHEDULE NO- BRANCH @VA04182 01155000 L R10,RDEVFIOB GET FIRST QUEUED IOBLOK @VA04182 01156000 TM IOBFLAG,IOBCP CP GENERATED I/O? @V407438 01157000 BZ HALTVIRT NOPE, GO RESET THE VIRT DEVICE @V407438 01158000 TM IOBSTAT,IOBPATHF IS IT FIXED PATH ALREADY? @V407438 01159000 BO *+8 YES, THEN DONT CHANGE THE PATH @V407438 01160000 STH R1,IOBRADD SET PATH ADDR TO THAT OF COMMAND @V407438 01161000 SETPATHF OI IOBSTAT,IOBPATHF INDICATE FIXED PATH @V407438 01162000 CALL DMKIOSHA GO HALT THE ACTIVE DEVICE @V407438 01163000 B HALTEXIT AND RETURN TO THE CALLER @V407438 01164000 SPACE 01165000 TSTCPGEN TM IOBFLAG,IOBCP CP GENERATED I/O? @V407438 01166000 BO SETPATHF YES, FREEZE THE PATH & HALT I/O @V407438 01167000 SPACE 01168000 HALTVIRT EQU * @V407595 01169000 L R1,IOBUSER OBTAIN ADDRESS OF DEVICE OWNER @V407595 01170000 SWTCHVM SWAP ACCOUNTING TO DEVICE OWNER @V407595 01171000 XC RDEVIOER(4),RDEVIOER CLEAR IOERBLOK POINTER @VA03757 01172000 TM IOBFLAG,IOBHVC DIAG IO? (DMKDGD OR DMKGEN) @VA03757 01173000 BZ LOADVADD NOPE, BR. I/O STARTED VIA 'SIO' @V407438 01174000 L R8,VMDVSTRT POINT TO THE VIRT DEVICE BLOCK OF@VA03757 01175000 AL R8,IOBMISC THE DEVICE TO BE RESET @VA03757 01176000 CALL DMKSCNVD FIND THE VCU+VCH+DEVICE ADDRESS @VA03757 01177000 B SAVEVADD AND GO SAVE THE DEVICE ADDRESS @VA03757 01178000 LOADVADD LH R1,IOBVADD GET THE VIRT DEVICE ADD SAVED @VA03757 01179000 * BY VIO 01180000 CALL DMKSCNVU FIND THE VCH+VCU+VDEV BLOCKS @VA03757 01181000 BNZ CPS040NR NOT FOUND - GIVE MSG AND NORETURN@VA08979 01182100 SPACE 1 01183000 SAVEVADD CALL DMKCVTBH CONVERT THE VIRT DEVICE ADDRESS @VA03757 01184000 ST R1,SAVEWRK1 AND SAVE IT FOR THE MSG @VA03757 01185000 SPACE 1 01186000 CALL DMKCFPRD RESET THE VIRTUAL DEVICE @VA03757 01187000 LA R0,(L'CPS144+7)/8 GET A BUFFER FOR MSG CPS144 @VA03757 01188000 LR R3,R0 AND REMEMBER THE LENGTH FOR QCNWT@VA03757 01189000 CALL DMKFREE GET THE MSG BUFFER @VA03757 01190000 LR R5,R1 POINT TO THE BUFFER WITH R5 @VA03757 01191000 MVC 0(L'CPS144,R5),CPS144 MOVE THE MSG INTO THE BUFFER 01192000 CALL DMKSCNVN GET THE VIRT DEVICE TYPE @VA03757 01193000 ST R1,TYPE144(0,R5) AND SAVE IT IN THE MSG @VA03757 01194000 MVC VADD144(3,R5),SAVEWRK1+1 MOVE IN THE VIRT @VA03757 01195000 * DEVICE ADD 01196000 L R1,SAVER11 POINT TO THE CALLERS VM BLOCK AND@VA03757 01197000 MVC USER144(8,R5),VMUSER-VMBLOK(R1) MOVE IN THE @VA03757 01198000 * USER ID 01199000 LA R0,L'CPS144 LENGTH OF THE MSG @VA03757 01200000 LR R1,R5 POINTER TO THE MSG @VA03757 01201000 LA R2,DFRET+NORET+PRIORITY SET UP THE PARM FIELD @VA03757 01202000 CALL DMKQCNWT TYPE THE MSG (R3 IS SET) @VA03757 01203000 CALL DMKCFMBK PUT THE USER IN CF MODE @VA03757 01204000 L R1,SAVER11 OBTAIN ADDRESS OF CALLER @V407595 01205000 SWTCHVM SWAP ACCOUNTING BACK TO CALLER @V407595 01206000 B HALTEXIT RETURN TO THE CALLER @VA03757 01207000 SPACE 1 01208000 SCHEDULE LR R4,R1 SAVE PATH ADDRESS @VA14036 01209100 TM RDEVSTAT,RDEVDISA DEVICE OFFLINE ? @VA12963 01209140 BO FATAL YES, CANNOT PERFORM HALT @VA12963 01209190 TM RCUSTAT,RCUDISA CONTROL UNIT OFFLINE @VA12963 01209240 BO FATAL YES, CANNOT PERFORM HALT @VA12963 01209290 LA R1,RCUCHA ADDRESS OF FIRST CHANNEL @VA12963 01209340 LA R2,4 INDEX @VA12963 01209390 LA R3,RCUCHD ADDRESS OF LAST RCHBLOK @VA12963 01209440 NEXTCHA CL R6,0(R1) CHANNEL MATCH ? @VA12963 01209490 BE *+8 YES, CONTINUE @VA12963 01209540 BXLE R1,R2,NEXTCHA KEEP LOOKING @VA12963 01209590 LA R2,RCUCHA FIND CHANNEL INDEX @VA12963 01209640 SLR R1,R2 RELATIVE CHANNEL @VA12963 01209690 SRL R1,2 INDEX @VA12963 01209740 IC R1,DISATBL(R1) GET CU TO CH PATH @VA12963 01209790 EX R1,CUCHPTH AVAILABLE ? @VA12963 01209840 BO FATAL NO, CANNOT PERFORM HALT @VA12963 01209890 LA R0,IOBSIZE GET AN IOB FOR THIS OPERATION @V407438 01210000 CALL DMKFREE * @VA03757 01211000 LR R10,R1 POINT TO THE IOB @VA03757 01212000 XC IOBLOK(IOBSIZE*8),IOBLOK ZERO IT @VA03757 01213000 * (NOTE: "IOBLINK" FILLED IN BY DMKIOSQR) 01214000 STH R4,IOBRADD SET DEVICE PATH @VA14036 01215100 OI IOBSTAT,IOBPATHF INHIBIT ALTERNATE PATH @V407438 01216000 ST R11,IOBUSER * BUILD AN IOB TO SCHEDULE A @VA03757 01217000 LA R2,HALTRET * HALT DEVICE SO THAT THE DEVICE@VA03757 01218000 ST R2,IOBIRA * IS RESET. @VA03757 01219000 MVI IOBSPEC,IOBHIO * @VA03757 01220000 CALL DMKIOSQR GO HALT THE DEVICE @VA03757 01221000 LR R2,R12 REAL ADDRESS OF THIS PAGE TO GR2 @VA03757 01222000 CALL DMKPTRLK LOCK THE PAGE DURING I/O @VA03757 01223000 SPACE 1 01224000 HALTEXIT DS 0H @VA11399 01225010 TM IOBSTAT,IOBFATAL DID HALT GET THROUGH?? @VA11399 01225020 BZ HALTOK YES, ISSUE NORMAL MSG @VA11399 01225030 FATAL MSG 'FATAL IO ERROR-HALT ABORTED' @VA12963 01225040 B HALTQCN GO PRINT ABORT MSG @VA11399 01225050 HALTOK DS 0H @VA11399 01225060 MSG 'DEVICE HALTED' @VA11399 01225070 HALTQCN DS 0H @VA11399 01225080 CALL DMKQCNWT,PARM=NORET WRITE MSG @V407466 01226000 EXIT RETURN TO CALLER @V407466 01227000 CUCHPTH TM RCUSTAT,0 CHANNEL PATH OFFLINE TEST @VA12963 01227100 SPACE 1 01228000 USING HALTRET,R12 ADDRESSABILITY FROM DMKDSPCH @VA03757 01229000 HALTRET EQU * HERE AFTER THE IOBLOK HAS BEEN @VA03757 01230000 * UNSTACKED 01231000 LR R1,R10 POINT TO THE IOBLOK @VA03757 01232000 LA R0,IOBSIZE AND ITS SIZE @VA03757 01233000 CALL DMKFRET RETURN THE IOBLOK @VA03757 01234000 LR R2,R12 REAL ADDRESS OF THIS PAGE @VA03757 01235000 CALL DMKPTRUL UNLOCK THE PAGE BEFORE EXITING @VA03757 01236000 GOTO DMKDSPCH RETURN @VA03757 01237000 SPACE 2 01238000 CPS144 DC C'DMKCPS144W TYPE ADD RESET BY (USERID)' @VA03757 01239000 TYPE144 EQU 11 @VA03757 01240000 VADD144 EQU 16 @VA03757 01241000 USER144 EQU 29 @VA03757 01242000 DROP R6,R7,R8 @VA03757 01243000 USING DMKCPS,R12 NORMAL ADDRESSABILITY AGAIN @VA03757 01244000 USING RDEVBLOK,R8 RDEVBLOK ADDRESSABILITY @V407466 01245000 EJECT 01246000 CPS003 LA R2,3 ERROR CODE @VA03757 01247000 B SETRET INVALID OPTION - OPTN @V407466 01248000 SPACE 01249000 CPS003A LA R2,3 ERROR CODE @V407466 01250000 B CALLERM ISSUE ERROR MESSAGE @V407466 01251000 SPACE 01252000 CPS021A EQU * INVALID RADDR @V407490 01253000 USING BUFFER,R1 @V407490 01254000 L R1,SAVER9 GET COMMAND LINE POINTER @VA15100 01255100 L R1,BUFNXT ADDRESS OF NEXT PARAMETER @V407490 01256000 SR R1,R4 POINT TO INVALID FIELD @V407490 01257000 B CPS021D GO LOAD ERROR CODE @V407490 01258000 SPACE 01259000 CPS021B DS 0H @VA15100 01260100 L R1,SAVER9 GET COMMAND LINE POINTER @VA15100 01260200 L R1,BUFNXT ADDRESS OF NEXT PARAMETER @V407490 01261000 SR R1,R0 POINT TO INVALID FIELD @V407490 01262000 B CPS021D GO LOAD ERROR CODE @V407490 01263000 SPACE 01264000 CPS021C SLR R1,R1 ZIP DATA REG @V407490 01265000 CPS021D LA R2,21 LOAD ERROR CODE @V407490 01266000 LTR R0,R0 IS COUNT ZERO OR MINUS ?? @V407490 01267000 BP CKSIZE BR IF NOT @V407490 01268000 SLR R1,R1 ZIP DATA REG @V407490 01269000 CKSIZE CL R0,F8 SIZE > 8 CHAR ???? @V407490 01270000 BNH NORTN NO, GO TO NO RETURN @V407490 01271000 L R0,F8 MAKE IT EIGHT(MAX) @V407490 01272000 B NORTN GO TO NO RETURN @V407490 01273000 SPACE 01274000 CPS021 EQU * INVALID RADDR @V407490 01275000 ST R0,SAVEWRK2 TUCK IT AWAY @V407490 01276000 ST R2,SAVEWRK3 CONTINUE SAVING ALL NEEDED INFO @V407490 01277000 ST R3,SAVEWRK4 SAVE ONE MORE THING @V407490 01278000 BAL R3,TSTRANGE RANGE BEING PROCESSED ?? @V407490 01279000 LA R2,21 LOAD ERROR CODE @V407490 01280000 TM CPSBITS,RANGE PROCESSING A RANGE @V407490 01281000 BZ CPS021E NO , BR @V407490 01282000 L R0,SAVEWRK4 LOAD COUNT OF FIRST RADDR @V407490 01283000 L R1,SAVEWRK3 POINTER TO THE DASH @V407490 01284000 SR R1,R0 POINT TO INVALID PARAMETER @V407490 01285000 CL R0,F8 SIZE > 8 ??? @V407490 01286000 BNH NORTN NO,DRUM RADDR MISSING OR INVALID @V407490 01287000 L R0,F8 THEN MAKE IT EIGHT (MAX) @V407490 01288000 B NORTN DRUM RADDR INVALID , NO RETURN @V407490 01289000 SPACE 01290000 CPS021E L R0,SAVEWRK2 FETCH COUNT REG @V407490 01291000 L R1,SAVER9 GET COMMAND LINE POINTER @VA15100 01292100 L R1,BUFNXT POINTER TO NEXT PARAMETER @V407490 01293000 SR R1,R0 POINT TO INVALID PARAMETER @V407490 01294000 CL R0,F8 SIZE > 8 ?? @V407490 01295000 BNH SETRET BR IF 8 OR LESS, RETURN @V407490 01296000 L R0,F8 THEN MAKE IT EIGHT (MAX) @V407490 01297000 B SETRET NO, RADDR MISSING OR INVALID, RTN@V407490 01298000 SPACE 01299000 DROP R1 @V407490 01300000 SPACE 01301000 CPS021NR SLR R1,R1 NO SUBSTITUTABLE DATA, NO RETURN @V407466 01302000 LA R2,21 MESSAGE NUMBER 21 @V407466 01303000 B CALLERM WRITE MSG WITHOUT RETURN @V4M0014 01304000 CPS026 LA R2,26 ERROR CODE @VA03757 01305000 SLR R1,R1 NO SUBSTITUTABLE DATA, NO RETURN @V407466 01306000 B CALLERM OPERAND MISSING OR INVALID @V407466 01307000 SPACE 01308000 CPS026A LA R2,26 ERROR CODE @V407466 01309000 SLR R1,R1 NO DATA TO PASS @V407466 01310000 ICM R2,B'1000',=X'40' RETURN STORAGE @V407466 01311000 B CALLERM OPERAND MISSING OR INVALID @V407466 01312000 SPACE 01313000 CPS040 EQU * HERE FOR RETURN @V407466 01314000 BAL R3,TSTRANGE RANGE BEING PROCESSED? @V407466 01315000 L R1,SAVEWRK9 RESTORE ADDRESS @V407466 01316000 SLR R2,R2 CLEAR FOR LATER @V407466 01317000 ICM R2,B'1000',=X'80' SET FOR RETURN TO CPS @V407466 01318000 B CPS040B AND CONTINUE @V407466 01319000 CPS040NR SLR R2,R2 CLEAR... @V407466 01320000 CPS040B CALL DMKCVTBH CONVERT ADDR BACK TO HEX @V407466 01321000 N R1,X40FFS BLANK HIGH BYTE @VA03757 01322000 SLR R0,R0 ZERO GPR0 @VA03757 01323000 IC R2,=AL1(40) ERROR CODE @V407466 01324000 B CALLERM DEV RADDR DOES NOT EXIST @V407466 01325000 SPACE 01325100 CPSVPEND DS 0H @VA12646 01325200 OI RDEVSTA3,RDEVPBYP RESET PENDING BYPASS BIT @VA14349 01325250 BAL R3,TSTRANGE RANGE BEING PROCESSED? @VA12646 01325300 BAL R3,BLDADR GET REAL ADDRESS @VA12646 01325400 N R1,X40FFS CLEAR HIGH ORDER BYTE @VA12646 01325500 ST R1,SAVEWRK2 SAVE FOR DMKERMSG @VA12646 01325600 LA R0,4 GET FIELD LENGTH @VA12646 01325700 LA R1,SAVEWRK2 ADDRESS OF FIELD @VA12646 01325800 LA R2,154 ERROR CODE @VA12646 01325900 B SETRET GO ISSUE DMKCPS154E @VA12646 01326000 CPS049 LA R2,49 ERROR CODE @VA03757 01327000 B SETRET TYPE RADDR IN USE @V407466 01328000 SPACE 01329000 CPS123 LA R2,123 ERROR CODE @VA03757 01330000 B SETRET DASD RADDR CP OWNED @V407466 01331000 SPACE 01332000 CPS124 LA R2,124 ERROR CODE @VA03757 01333000 B SETRET DASD RADDR IN USE BY NN USERS @V407466 01334000 SPACE 01335000 CPS140 LA R2,140 ERROR CODE @VA03757 01336000 B SETRET TYPE RADDR ATTACHED TO USERID @V407466 01337000 SPACE 01338000 CPS142 LA R2,142 ERROR CODE @VA03757 01339000 B SETRET TYPE RADDR NOT DRAINED @V407466 01340000 SPACE 01341000 CPS60X EQU * @VA12977 01341050 LH R1,IOBRADD DEVICE ADDRESS @VA12977 01341100 CALL DMKCVTBH @VA12977 01341150 ICM R1,B'1000',=X'40' INSERT BLANK @VA12977 01341200 SR R0,R0 LENGTH @VA12977 01341250 TM IOBCSW+5,IFCC IFCC ? @VA12977 01341300 BO CPTIFCC YES, IFCC MSG @VA12977 01341350 LA R2,601 IFCC MSG @VA12977 01341400 B SETRET @VA12977 01341450 CPTIFCC EQU * @VA12977 01341500 LA R2,602 CCC MSG @VA12977 01341550 B SETRET @VA12977 01341600 SPACE 01341650 CPS143 EQU * DMKCPS143E TYPE RADDR IN USE BY @VA03757 01342000 * SYSTEM 01343000 BAL R3,TSTRANGE RANGE BEING PROCESSED? @V407466 01344000 BAL R3,BLDADR GET REAL ADDRESS @V407466 01345000 ST R1,SAVEWRK3 SET IN SAVEAREA FOR DMKERM @VA03757 01346000 MVI SAVEWRK3,X'00' DELIMITER @VA03757 01347000 CALL DMKSCNRN GET A TYPE NAME FOR THE DEVICE @VA03757 01348000 ST R1,SAVEWRK2 @VA03757 01349000 LA R1,SAVEWRK2 @VA03757 01350000 LA R0,8 LENGTH OF VARIABLE DATA FIELDS @VA03757 01351000 LA R2,143(0) MESSAGE NUMBER @VA03757 01352000 B SETRET TYPE RADDR IN USE BY SYSTEM @V407466 01353000 CPS149 LA R2,149 ERROR CODE 149 @VA12448 01353010 B SETRET TYPE DASD ADDR BUSY OR RESERVED @VA12448 01353020 SPACE 01354000 NORTN ICM R2,B'1000',=X'40' RETURN STORAGE @V407490 01355000 LA R3,MSGSIZE GET SIZE OF BUFFER @V407490 01356000 SLL R3,24 MOVE IT TO HI ORDER BYTE @V407490 01357000 ICM R3,B'0111',SAVEWRK7+1 BUFFER ADDRESS @V407490 01358000 B CALLERM ISSUE ERROR MSG @V407490 01359000 SETRET ICM R2,B'1000',=X'80' SET FOR RETURN TO CPS @V407466 01360000 CALLERM ICM R0,14,MODID+3 INSERT THE MODULE INDENT. @VA03757 01361000 STC R2,LASTRC SAVE ERROR @V407466 01362000 CALL DMKERMSG SEND THE MESSAGE @VA03757 01363000 * 01364000 * IF DMKERMSG RETURNS, IT IS FOR 'VARY' IN WHICH CASE 01365000 * WE CONTINUE WITH THE NEXT DEVICE. IF NO RETURN HAS 01366000 * BEEN REQUESTED, THEN DMKERM WILL RETURN DIRECTLY TO 01367000 * DMKCFM WITHOUT COMING THROUGH HERE. 01368000 SPACE 01369000 NI CPSBITS,X'FF'-VARYERR RESET ERROR FLAG @V407466 01370000 TM CPSBITS,RANGE IS RANGE BEING PROCESSED? @V407466 01371000 BO NEXTRADD YES, PROCESS NEXT ADDRESS @V407490 01372000 L R9,SAVER9 GET COMMAND LINE POINTER @VA15100 01373100 CALL DMKSCNFD FIND NEXT ADDR @V407466 01374000 BNZ FINMSG NO MORE TO PROCESS @V407466 01375000 B VARYDEV VARY THE DEVICE @V407466 01377000 EJECT 01378000 * HRC010DK 01378010 * DMKCPSCP: ISSUE COMMAND TO HOST HRC010DK 01378020 * HRC010DK 01378030 DMKCPSCP RELOC PASS COMMAND TO HOST HRC010DK 01378040 USING BUFFER,R9 HRC010DK 01378050 CLI CPUID,X'FF' HRC010DK 01378060 BZ DIAG8OK HRC010DK 01378070 CLI CPUID,X'FD' HERCULES HRC010DK 01378080 BZ DIAG8OKH HRC010DK 01378090 LA R1,MSG182E HRC010DK 01378100 LA R0,LMSG182E HRC010DK 01378110 CALL DMKQCNWT,PARM=NORET+ERRMSG HRC010DK 01378120 LA R6,182 HRC010DK 01378130 B NOCOMMD HRC010DK 01378140 DIAG8OKH EQU * HRC010DK 01378150 * TRANSLATE HERCULES COMMANDS TO LOWERCASE HRC010DK 01378160 LM R2,R3,BUFNXT HRC010DK 01378170 LTR R3,R3 HRC010DK 01378180 BZ NOCOMMD HRC010DK 01378190 BCTR R3,0 HRC010DK 01378200 L R6,=V(DMKTBLLC) HRC010DK 01378210 EX R3,TRANLC HRC010DK 01378220 B DIAG8OK HRC010DK 01378230 TRANLC TR 0(0,R2),0(R6) HRC010DK 01378240 DIAG8OK EQU * HRC010DK 01378250 XR R6,R6 DEFAULT RETCODE HRC010DK 01378260 LM R2,R3,BUFNXT GET COMMAND BUFFER LOCS HRC010DK 01378270 LTR R3,R3 ZERO LENGTH ? HRC010DK 01378280 BZ NOCOMMD YES - NO COMMAND HRC010DK 01378290 LOOPSCN4 EQU * HRC010DK 01378300 CLI 0(R2),C' ' HRC010DK 01378310 BNZ GOTCOMM HRC010DK 01378320 LA R2,1(R2) HRC010DK 01378330 BCT R3,LOOPSCN4 HRC010DK 01378340 B NOCOMMD HRC010DK 01378350 GOTCOMM EQU * HRC010DK 01378360 LA R0,512 GET 1 FULL PAGE OF STORAGE HRC010DK 01378370 CALL DMKFREE ... HRC010DK 01378380 LR R4,R2 SAVE COMMAND HRC010DK 01378390 LR R5,R1 AND RESP BUFFER HRC010DK 01378400 LR R6,R3 AND COMMAND LENGTH HRC010DK 01378410 LA R7,512 AND RESP BFR LENGTH HRC010DK 01378420 SLL R7,3 512*8=4096 HRC010DK 01378430 ICM R6,B'1000',=X'E0' SET DIAG 8 FLAGS HRC010DK 01378440 DC X'83460008' ISSUE DIAGNOSE HRC010DK 01378450 BNZ TOOSHORT HRC010DK 01378460 LTR R7,R7 ENSURE VALID LENGTH HRC010DK 01378470 BNP TOOSHORT BAD LENGTH, NO RESPONSE HRC010DK 01378480 LR R1,R5 REFETCH CMD RESP HRC010DK 01378490 LA R0,0(R7) GET RESP LENGTH HRC010DK 01378500 LR R8,R5 HRC010DK 01378510 XR R3,R3 HRC010DK 01378520 LOOPSCN1 EQU * HRC010DK 01378530 LR R4,R8 HRC010DK 01378540 ALR R4,R3 HRC010DK 01378550 CLI 0(R4),X'15' HRC010DK 01378560 BZ GOWRITE HRC010DK 01378570 CLI 0(R4),X'0D' HRC010DK 01378580 BZ GOWRITE HRC010DK 01378590 CLI 0(R4),X'25' HRC010DK 01378600 BZ GOWRITE HRC010DK 01378610 LA R3,1(R3) HRC010DK 01378620 LOOPSCN2 EQU * HRC010DK 01378630 BCT R7,LOOPSCN1 HRC010DK 01378640 GOWRITE EQU * HRC010DK 01378650 LR R1,R8 HRC010DK 01378660 ALR R8,R3 HRC010DK 01378670 LR R0,R3 HRC010DK 01378680 CALL DMKQCNWT,PARM=NORET HRC010DK 01378690 XR R3,R3 HRC010DK 01378700 LTR R7,R7 HRC010DK 01378710 BZ TOOSHORT HRC010DK 01378720 LA R8,1(R8) HRC010DK 01378730 BCT R7,LOOPSCN1 HRC010DK 01378740 TOOSHORT EQU * HRC010DK 01378750 LR R1,R5 HRC010DK 01378760 LA R0,512 HRC010DK 01378770 CALL DMKFRET HRC010DK 01378780 NOCOMMD DS 0H HRC010DK 01378790 ST R6,SAVER2 HRC010DK 01378800 EXIT HRC010DK 01378810 MSG182E DC C'DMKCPS182E The host system cannot proc' HRC010DK 01378820 DC C'ess host commands' HRC010DK 01378830 LMSG182E EQU *-MSG182E HRC010DK 01378840 LTORG @VA03757 01379000 EJECT 01380000 PSA @VA03757 01381000 COPY CORE @VA03757 01382000 COPY CONBUF @V407490 01383000 COPY DEVTYPES @VA03757 01384000 COPY EQU @VA03757 01385000 COPY IOBLOKS @VA03757 01386000 COPY IOER @VA03757 01387000 COPY MONBLOKS @VA03757 01388000 COPY NETWORK @VA03757 01389000 COPY RBLOKS @VA03757 01390000 COPY SAVE @VA03757 01391000 SPACE 2 01392000 CPSBITS EQU SAVEWRK1 @V407466 01393000 LASTRC EQU SAVEWRK1+1 ERROR NUMBER OF LAST MSG ISSUED @V407466 01394000 MULTCUU EQU SAVEWRK1+2 COUNT OF NO. OF MULTIPLES @V407466 01395000 SPACE 01396000 * 01397000 * BITS DEFINED IN CPSBITS 01398000 * 01399000 SPACE 01400000 LBLREAD EQU X'20' DASD LABEL READ PROCESS INITIATED @V407466 01401000 RANGE EQU X'04' RANGE INDICATOR @V407466 01402000 ON EQU X'80' VARY ONLINE REQUEST @V407466 01403000 VARYERR EQU X'40' PENDING VARY ERROR MESSAGE @V407466 01404000 SPACE 01405000 RADDR1 EQU SAVEWRK8 RADDR1 IN RANGE @V407466 01406000 RADDR2 EQU SAVEWRK8+2 SECOND RANGE ADDRESS @V407466 01407000 COPY SAVTABLE @VA03757 01408000 COPY SYSTBL @VA03757 01409000 COPY VBLOKS @VA03757 01410000 COPY VMBLOK @VA03757 01411000 END 01412000