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