CFO TITLE 'DMKCFO (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCEING OF INPUT @V326538 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMKCFO 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* PROCESS PRIVILEGED SET COMMANDS 00010000
* 00011000
* ATTRIBUTES - 00012000
* 00013000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00014000
* 00015000
* ENTRY POINTS - 00016000
* 00017000
* DMKCFOEX - ENTRY FOR 'SET' COMMANDS (CLASS A,B,C AND F) 00018000
* 00019000
* ENTRY CONDITIONS - 00020000
* 00021000
* GPR0 = LENGTH OF THE SET OPERAND 00022000
* GPR1 = ADDRESS OF THE SET OPERAND 00023000
* GPR6 = OPERAND INDEX FROM DMKCFC 00024000
* GPR9 = COMMAND LINE ADDRESS 00025000
* GPR12 = ADDRESS OF ENTRY POINT 00026000
* GPR13 = ADDRSS OF THE SAVEAREA 00027000
* 00028000
* EXIT CONDITIONS - 00029000
* 00030000
* NORMAL - 00031000
* GPR2 = 0 00032000
* 00033000
* ERROR - 00034000
* GPR2 = ERROR MESSAGE CODE NUMBER 00035000
* 00036000
* 00037000
* CALLS TO OTHER ROUTINES - 00038000
* 00039000
* DMKSCNFD - LOCATE ARGUMENTS IN THE COMMAND LINE 00040000
* DMKQCNWT - TO OUTPUT MESSAGES TO TERMINAL 00041000
* DMKSCNAU - TO FIND USERS VMBLOK ADDRESS 00042000
* DMKCVTBH - TO CONVERT BINARY TO HEX 00043000
* DMKCVTDB - TO CONVERT DECIMAL TO BINARY 00044000
* DMKCVTHB - TO CONVERT HEX TO BINARY 00045000
* DMKSCNRU - TO GET RDEVBLOK ADDRESS 00046000
* DMKSCNRA - TO GET THE DEVICE ADDRESS IN CCU FORM 00046100
* DMKFREE - TO OBTAIN A BLOCK OF FREE STORAGE 00047000
* DMKFRET - TO RETURN A BLOCK OF STORAGE 00048000
* DMKQCNRD - TO READ A RESPONSE FROM THE TERMINAL 00049000
* DMKCVTDT - TO GET THE DATE AND TIME 00050000
* DMKSTKIO - TO STACK A TIMER REQUEST BLOK (TRQBLOK) 00051000
* DMKSTKOP - TO RESUME EXECUTION ON THE OTHER PROCESSOR (AP) 00051100
* DMKMCIMS - TO ENABLE MACHINE CHECK RECORDING 00052050
* GPR2 - MESSAGE INDICATOR 00052100
* DMKERMSG - TO SEND AN ERROR MESSAGE 00053000
* DMKSCHRT - TO FREE A TIMER REQUEST BLOK 00054000
* 00055000
* TABLES/WORKAREAS - 00056000
* 00057000
* VMBLOK 00058000
* MICBLOK 00059000
* 00060000
* REGISTER USAGE - 00061000
* 00062000
* GPR0 = ARGUMENT LENGTH (RETURN BY DMKSCNFD) 00063000
* GPR1 = ADDRESS OF ARGUMENT (RETURN BY DMKSCNFD) 00064000
* GPR9 = ADDRESS OF COMMAND LINE 00065000
* GPR11 = ADDRESS OF USERS VMBLOK 00066000
* GPR12 = BASE REGISTER 00067000
* GPR13 = ADDRESS OF SAVEAREA 00068000
* 00069000
* COMMAND LINE FORMAT - 00070000
* 00071000
* CLASS A 00072000
* +-------+-------------------------+ 00073000
* | SET | FAVORED USERID <XX> | 00074000
* | | <OFF> | 00075000
* | | | 00076000
* | | RESERVE USERID XX | 00077000
* | | OFF | 00078000
* | | SASSIST ON <<PROC> XX>| 00079100
* | | OFF | 00080000
* ' ' CPASSIST ON <<PROC> XX>' @V5DAACD 00080110
* | | OFF | 00080200
* | | | 00080300
* | | MAX NN | 00080400
* +-------+-------------------------+ 00081000
* 00082000
* 00083000
* CLASS B 00084000
* +-------+-------------------------+ 00085000
* | SET | LOGMSG N | 00086000
* | | NULL | 00087000
* | | | 00088000
* | | DUMP AUTO | 00089000
* | | RADDR | 00090000
* +-------+-------------------------+ 00091000
* 00092000
* 00093000
* CLASS C 00094000
* +-------+-------------------------+ 00095000
* | SET | PRIORITY USERID NN | 00098000
* +-------+-------------------------+ 00099000
* 00100000
* 00101000
* CLASS F 00102000
* 00103000
* +-------+--------------------------------------------------+ 00104000
* | SET | RECORD ON RADDR LIMIT NN BYTE NN BIT N | 00105000
* | | AND BYTE NN BIT NN | 00106000
* | | OR | 00107000
* | | OFF | 00108000
* | | MODE MAIN/RETRY RECORD/QUIET CPUID | 00109100
* +-------+--------------------------------------------------+ 00110000
* 00111000
* OPERATION - 00112000
* 00113000
* 1. CALL DMKSCNFD TO SEE IF THERE IS A SECOND ARGUMENT. IF 00114000
* NONE IS FOUND, SET A FLAG TO INDICATE THIS AND CONTINUE. 00115000
* IF HAVE ONE, SAVE IT IN SAVEWRK5/6. 00116000
* 2. USING THE INDEX SET BY DMKCFC, BRANCH TO THE APPROPRIATE 00117000
* ROUTINE TO HANDLE THE REQUEST. 00118000
* 00119000
* TSTONOFF - THIS IS THE SUBROUTINE TO TEST THE ON/OFF 00120000
* ARGUMENT. IF THE ARGUMENT = ON, RETURN ON REGISTER 8. 00121000
* IF THE ARGUMENT = OFF, RETURN ON REGISTER 10. IF NO 00122000
* OTHER ARGUMENTS ARE LEGAL, CALL DMKERMSG TO SEND ERROR 00123000
* MESSAGE DMKCFS026E. IF SOMETHING ELSE LEGAL, RETURN 00124000
* ON REGISTER 7. 00125000
* 00126000
* SET PRIORITY 00127000
* 1. SETPRIOR - THIS ROUTINE WILL PROCESS THE SET PRIORITY 00128000
* REQUEST. FIRST CALL DMKSCNFD TO GET THE 'NN' ARGUMENT. 00129000
* IF NONE IS FOUND, CALL DMKERMSG TO SEND ERROR MESSAGE 00130000
* DMKCFO026E. 00131000
* 2. CALL DMKSCNAU TO FIND THE USER VMBLOK. IF BLOK NOT 00132000
* FOUND, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO045E. 00133000
* 3. CALL DMKCVTDB TO CONVERT THE 'NN' ARGUMENT TO BINARY. 00134000
* IF THE CONVERT FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE 00135000
* DMKCFO003E. 00136000
* 4. STORE THE 'NN' VALUE IN THE VMBLOK. 00137000
* 5. EXIT - RETURN TO DMKCFM 00138000
* 00139000
* SET DUMP 00140000
* 1. SETDUMP - THIS ROUTINE WILL PROCESS THE SET DUMP REQUEST. 00141000
* CALL DMKSCNFD TO GET NEXT ARGUMENT. IF NONE FOUND, GO TO 00142000
* STEP 3. 00143000
* 2. IF ARGUMENT IS 'ALL' TURN ON THE ALL FLAG AND GO TO 00144000
* STEP 4. IF NOT ALL, CONTINUE WITH NEXT STEP. 00145000
* 3. RESET THE ALL FLAG. 00146000
* 4. IF A DEVICE IS ALREADY ACTIVE AS A DUMP DEVICE, RETURN IT 00147000
* TO THE SYSTEM. THEN IF THIS IS AN AUTO REQUEST, GO TO 00148000
* STEP 9. 00149000
* 5. CALL DMKCVTHB TO CONVERT THE RADDR TO BINARY. IF THE 00150000
* CONVERT FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE 00151000
* DMKCFO021E. 00152000
* 6. CALL DMKSCNRU TO FIND THE DEVICE BLOKS. IF NOT FOUND, 00153000
* CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO040E. 00154000
* 7. IF THE DEVICE IS A TAPE THAT IS DEDICATED, CALL DMKERMSG 00155000
* TO SEND ERROR MESSAGE DMKCFO140E. IF A NONPRINTER TYPE 00156000
* UR DEVICE, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO006E. 00157000
* IF THE DEVICE IS OFFLINE, CALL DMKERMSG TO SEND ERROR 00158000
* MESSAGE DMKCFO046E. 00159000
* 8. STORE THE DEVICE ADDRESS IN THE DUMP DEVICE WORD 00160000
* AND EXIT. 00161000
* 9. GET THE DEVICE ADDRESS FOR THE AUTO DASD DEVICE 00162000
* AND GO TO STEP 8. 00163000
* 00164000
* SET LOGMSG 00165000
* 1. SETLOGM - ROUTINE TO PROCESS SET LOGMSG REQUEST. IF NO 00166000
* SECOND ARGUMENT , GO TO STEP 5. IF THE SECOND ARGUMENT 00167000
* IS A NULL REQUEST, GO TO STEP 8. 00168000
* 2. CALL DMKCVTDB TO CONVERT THE LINE NUMBER TO BINARY. IF 00169000
* THE CONVERT FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE 00170000
* DMKCFO026E. 00171000
* 3. SEARCH FOR THE LINE NUMBER. IF NOT FOUND, CALL DMKERMSG 00172000
* TO SEND ERROR MESSAGE DMKCFO041E. IF THE LINE IS FOUND, 00173000
* BAL TO STEP 9 TO READ THE INPUT LINE. IF A NULL LINE 00174000
* IS ENTERED, GO TO NEXT STEP. ELSE - OVERLAY THE OLD 00175000
* MESSAGE WITH THE NEW AND GO TO STEP 10. 00176000
* 4. CALL DMKFRET TO FRET THE OLD MESSAGE BLOK AND THEN GO 00177000
* TO STEP 10. 00178000
* 5. FIND THE LAST LOGMSG IN THE CHAIN. THEN BAL TO STEP 9 00179000
* TO READ THE INPUT LINE. IF RECEIVE A NULL LINE, GO TO 00180000
* STEP 7. ELSE CONTINUE WITH NEXT STEP. 00181000
* 6. CALL DMKFREE TO GET STORAGE FOR A NEW MESSAGE BLOK. MOVE 00182000
* THE MESSAGE INTO THE BLOK AND GO TO STEP 5. 00183000
* 7. CALL DMKFRET TO FRET THE READ BUFFER AND GO TO STEP 10. 00184000
* 8. FOR EACH EXISTING MESSAGE BLOK, CALL DMKFRET TO RETURN 00185000
* THE BLOK TO FREE STORAGE. THEN GO TO STEP 10. 00186000
* 9. CALL DMKQCNWT TO SEND THE PROMPT MESSAGE 'LOGMSG:'. 00187000
* THEN CALL DMKFREE TO OBTAIN STORAGE FOR A READ BUFFER. 00188000
* SET UP THE RETURN FROM THE READ TO POINT TO THE ADDRESS 00189000
* CONTAINED IN THE BAL REGISTER 10. THEN CALL DMKQCNRD 00190000
* TO READ THE INPUT LINE. 00191000
* 10. RESEQUENCE THE LINE NUMBERS IN ALL EXISTING MESSAGE 00192000
* BLOKS. THEN CALL DMKCVTDT TO GET THE DATE AND TIME. 00193000
* UPDATE THE DATE AND TIME FOR CHANGING THE LOGMSG. THIS 00194000
* WILL BE USED BY LOGON. THEN EXIT. 00195000
* 00196000
* SET RESERVED 00197000
* 1. SETRESRV - SET FLAG TO INDICATE A RESERVE REQUEST AND 00198000
* GO TO STEP 2. 00199000
* 00200000
* SET FAVORED 00201000
* 2. SETFAVOR - ROUTINE TO PROCESS THE SET FAVORED REQUEST. 00202000
* IF THERE IS NO SECOND ARGUMENT, CALL DMKERMSG TO SEND 00203000
* ERROR MESSAGE DMKCFO026E. IF HAVE ONE, CALL DMKSCNAU TO 00204000
* FIND USERID VMBLOK. IF CAN'T FIND, CALL DMKERMSG TO 00205000
* SEND ERROR MESSAGE DMKCFO045E. IF HAVE USER, CALL DMKSCNFD 00206000
* TO FIND NEXT ARGUMENT. IF NONE IS FOUND, GO TO STEP 5. 00207000
* IF ARGUMENT=OFF, GO TO STEP 6 - ELSE CONTINUE. 00208000
* 3. CALL DMKCVTDB TO CONVERT THE XX TO BINARY. IF THE 00209000
* CONVERT FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE 00210000
* DMKCFO026E. IF OK, CHECK IF THIS IS A RESERVE REQUEST. 00211000
* IF IT IS, GO TO STEP 7 - ELSE CONTINUE. 00212000
* 4. IF A FAVORED PERCENTAGE USER IS ALREADY ACTIVE, CALL 00213000
* DMKERMSG TO SEND ERROR MESSAGE DMKCFO175E. IF NOT CALL 00214000
* DMKFREE TO OBTAIN STORAGE FOR A TRQBLOK(TIMER BLOK). 00215000
* INITIALIZE THE TIMER BLOK AND SET THE FAVORED AND 00216000
* PERCENTAGE FLAGS IN THE VMBLOK. THEN CALL DMKSTKIO TO 00217000
* PUT THE TIMER BLOK ON THE QUEUE. THEN EXIT. 00218000
* 5. IF THIS IS A RESERVE REQUEST, CALL DMKERMSG TO SEND 00219000
* ERROR MESSAGE DMKCFO026E. IF FAVORED REQUEST, SET THE 00220000
* FAVORED FLAG IN THE VMBLOK AND EXIT. 00221000
* 6. IF THIS IS A RESERVE REQUEST, GO TO STEP 8. IF FAVORED, 00222000
* RESET THE FAVORED FLAG IN THE VMBLOK AND EXIT. 00223000
* 7. IF RESERVE IS ALREADY ACTIVE FOR OTHER THAN THIS USER 00224000
* CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO175E. IF NOT, 00225000
* CHECK IF THE NUMBER OF PAGES SPECIFIED WILL FIT IN THIS 00226000
* VIRTUAL MACHINE. IF NOT CALL DMKERMSG TO SEND ERROR 00227000
* MESSAGE DMKCFO026E. IF THIS IS OK, TURN ON THE RESERVE 00228000
* FLAG IN THE USERS VMBLOK. THEN GO TO STEP 9. 00229000
* 8. TURN OFF THE RESERVE FLAG IN THE VMBLOK. 00230000
* 9. RESET THE RESERVE FLAGS IN THE CORTABLE AND EXIT. 00231000
* 00232000
* SET RECORD 00233000
* 1. SETRECD - ROUTINE FOR THE SET RECORD REQUEST. 00234000
* IF RECORDING ALREADY ACTIVE, CALL DMKSCNRU TO GET THE 00235000
* RDEVBLOK ADDRESS FOR THE ACTIVE DEVICE. IF NOT ACTIVE 00236000
* JUST GO TO NEXT STEP. 00237000
* 2. SET UP FOR RETURN FRON THE SUBROUTINE LABELED TSTONOFF 00238000
* AND BAL R10 TO THAT ROUTINE. 00239000
* 3. IF RETURN FOR OFF, RESET THE IRMFLAGS IN THE RDEVBLOK 00240000
* AND CALL DMKFRET TO FRET THE IRMBLOK. THEN EXIT. 00241000
* 4. IF THE RETURN IS FOR 'CPU', CALL DMKMCIMS THEN EXIT. 00242100
* 5. IF RETURN FOR ON, CHECK IF IRM IS ACTIVE. IF NOT ,CALL 00243000
* DMKFREE TO OBTAIN STORAGE FOR AN IRMBLOK. IN ANY EVENT 00244000
* CLEAR THE IRMBLOK TO BINARY ZERO. 00245000
* 7. CALL DMKSCNFD TO GET THE NEXT ARGUMENT WHICH SHOULD BE 00246000
* A RADDR. IF ARGUMENT IS NOT FOUND, CALL DMKERMSG TO 00247000
* SEND ERROR MESSAGE DMKCFO07. IF FOUND, CALL 00248000
* DMKCVTHB TO CONVERT THE ADDRESS TO BINARY. IF CONVERT 00249000
* FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO07. 00250000
* IF CONVERT IS GOOD CALL DMKSCNRU TO GET THE DEVICE BLOK 00251000
* ADDRESSES. IF CAN'T FIND, CALL DMKERMSG TO SEND ERROR 00252000
* MESSAGE DMKCFO040E. 00253000
* 7. CALL DMKSCNFD TO GET THE NEXT ARGUMENT. IF NONE FOUND, 00254000
* GO TO STEP 14. IF ONE IS FOUND, CHECK THE ARGUMENT. IF 00255000
* ARGUMENT=LIMIT, GO TO STEP 8; FOR 'AND', GO TO STEP 00256000
* 9; FOR 'OR', GO TO STEP 10; FOR 'BYTE', GO TO STEP 00257000
* 11; FOR 'BIT', GO TO STEP 12; AND IF NONE OF THESE, 00258000
* CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO003E. 00259000
* 8. BAL R10 TO STEP 13 TO GET THE 'NN' ARGUMENT. STORE THE 00260000
* LIMIT VALUE IN THE IRMBLOK AND GO TO STEP 7. 00261000
* 9. IF 'OR' HAS BEEN PREVIOSLY PROCCESSED, CALL DMKERMSG TO 00262000
* SEND ERROR MESSAGE DMKCFO013E. ELSE SET THE 'AND' FLAG 00263000
* IN THE IRMBLOK AND GO TO STEP 7. 00264000
* 10. IF THE 'AND' OPTION HAS BEEN PREVIOSLY PROCCESSED, CALL 00265000
* DMKERMSG TO SEND ERROR MESSAGE DMKCFO013E. ELSE SET THE 00266000
* 'OR' FLAG IN THE IRMBLOK AND GO TO STEP 7. 00267000
* 11. BAL R10 TO STEP 13 TO GET THE BYTE NUMBER. IF NO BYTES 00268000
* HAVE BEEN STORED, STORE THIS VALUE INTO IRMBYT1 00269000
* OF THE IRMBLOK. IF THE SECOND BYTE ARGUMENT, STORE INTO 00270000
* IRMBYT2 OF THE IRMBLOK. THEN GO TO STEP 7. IF THIS IS 00271000
* THE THIRD REQUEST FOR A BYTE IN THE COMMAND LINE, CALL 00272000
* DMKERMSG TO SEND ERROR MESSAGE DMKCFO003E. 00273000
* 12. BAL R10 TO STEP 13 TO GET THE BIT NUMBER. IF THIS IS 00274000
* THE FIRST BIT REQUEST, STORE THE VALUE INTO IRMBIT1 00275000
* OF THE IRMBLOK. IF THE SECOND NUMBER, STORE IT 00276000
* INTO IRMBIT2 OF THE IRMBLOK. THEN GO TO STEP 00277000
* 7. IF THIS IS THE THIRD REQUEST IN THE COMMAND LINE, 00278000
* CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO003E. 00279000
* 13. CALL DMKSCNFD TO GET 'NN' ARGUMENT. IF NO ARGUMENT 00280000
* FOUND, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFO026E. 00281000
* IF FOUND, CALL DMKCVTDB TO CONVERT THE NUMBER TO BINARY. 00282000
* IF THE CONVERT FAILS, CALL DMKERMSG TO SEND ERROR 00283000
* MESSAGE DMKCFO026E. IF GOOD CONVERT, RETURN ON REG. 10. 00284000
* 14. IF 'LIMIT' AND AT LEAST ONE 'BYTE/BIT' HAVE NOT BEEN 00285000
* PROCCESSED, CALL DMKERMSG TO SEND ERROR MESSAGE 00286000
* DMKCFO026E. IF OK, SET THE RECORD FLAG IN THE RDEVBLOK 00287000
* AND EXIT. 00288000
* 00289000
* SET SASSIST 00290000
* 1. SETSAS - ROUTINE TO PROCESS SET SASSIST . SET UP FOR 00291000
* RETURN FROM TSTONOFF ROUTINE, AND BAL R10 TO THAT RTN. 00292000
* 2. REMEMBER IF ON|OFF, SET DEFAULT EXIT = SETCOMP 00293100
* 3. IF WE ARE IN UP MODE, GO DIRECTLY TO STEP 7 00293140
* 3. SCAN FOR MORE PARAMETERS. IF NONE, DO 7 FOR BOTH PROCESSOR 00293180
* 4. IF THERE ARE MORE PARAMETERS, BYPASS 'PROC' IF SPECIFIED, 00293220
* TRY TO CONVERT PARAMETER TO BINARY. EXIT WITH 00293260
* DMKCFO003 ON ERROR 00293300
* 5. IF PARAMETER = OUR PROCESSOR ADDRESS, GO TO STEP 7 00293340
* 6. IF PARAMETER = OTHER PROCESSOR ADDRESS, STACK A CPEXBLOK 00293380
* TO RESUME ON THE OTHER PROCESSOR, 00293420
* ELSE EXIT WITH ERROR MESSAGE DMKCFO188. 00293460
* 7. IF OFF,TURN OFF CPMICON IN PSA 00293500
* IF ON, 00293540
* A) IF VM ASSIST IS AVAILABLE FOR THE PROCESSOR, TURN ON 00293580
* CPMICON, ELSE ISSUE DMKCFO184, ADDING OPTIONAL TEXT IF 00293620
* WE ARE IN AP MODE 00293660
* IF WE ARE IN UP MODE, EXIT. ELSE, WHEN BOTH PROCESSORS 00293700
* ARE TO BE SET, COMPARE PROC ADDR TO DETERMINE WHETHER 00293740
* OR NOT TO SWITCH AND REPEAT 7 A SECOND TIME 00293780
* 00296100
* SET CPASSIST 00296200
* 1. SETCPA - ROUTINE TO PROCESS SET CPASSIST. SET UP FOR 00296300
* RETURN FROM TSTONOFF ROUTINE, AND BAL R10 TO THAT RTN. 00296400
* 2. IF RETURN FOR OFF, TURN OFF CPASTON BIT IN PSA AND CHAIN 00296500
* THROUGH VMBLOKS, TURNING OFF THE CP ASSIST FLAG IN VMMCR6, 00296600
* EXITING WHEN BACK TO THE STARTING VMBLOK. 00296700
* 3. IF RETURN FOR ON, SEE IF CP ASSIST IS AVAILABLE ON THE 00296800
* COMPUTER. IF IT ISN'T, ISSUE MSG DMKCFO186E. IF IT IS 00296900
* AVAILABLE, TURN ON CPASTON BIT IN PSA AND CHAIN THROUGH 00297000
* VMBLOKS, TURNING ON THE CP ASSIST FLAG IN VMMCR6, EXIT 00297100
* AFTER RETURNING TO THE STARTING VMBLOK. 00297200
* 00297300
* SET MODE 00297310
* 1. CLEAR MESSAGE INDICATORS. 00297320
* 2. IF SET MODE MAIN, CALL DMKMCIMS. 00297335
* 3. IF SET MODE RETRY, SET THE RETRY MESSAGE SWITCH AND 00297340
* CALL DMKMCIMS. 00297355
* 00297360
* SET MAX 00297361
* 1. IF NO SECOND ARGUEMENT IS SPECIFIED, DEFAULT TO ZERO. 00297362
* OTHERWISE CALL DMKCVTDB TO CONVERT DECIMAL NUMBER TO 00297363
* BINARY. 00297364
* 2. STORE THE MAXIMUM NUMBER OF USERS ALLOWED ON THE SYSTEM 00297365
* 00297366
* ERROR MESSAGES - 00298000
* DMKCFO003E INVALID OPTION - (OPTION) 00299000
* DMKCFO006E INVALID DEVICE TYPE - (ADDR) 00300000
* DMKCFO013E CONFLICTING OPTION - (OPTION) 00301000
* DMKCFO020E USERID MISSING OR INVALID 00302000
* DMKCFO021E RADDR MISSING OR INVALID 00303000
* DMKCFO026E OPERAND MISSING OR INVALID 00304000
* DMKCFO040E DEV (ADDR) DOES NOT EXIST 00305000
* DMKCFO041E LOGMSG (NN) DOES NOT EXIST 00306000
* DMKCFO045E (USERID) NOT LOGGED ON 00307000
* DMKCFO046E (TYPE RADDR) OFFLINE 00308000
* DMKCFO140E (TYPE RADDR) ATTACHED TO (USERID) 00309000
* DMKCFO143E (TYPE RADDR) IN USE BY SYSTEM 00310000
* DMKCFO175E (FAVORED/RESERVED) ALREADY IN USE BY (UESRID) 00311000
* DMKCFO184E VM ASSIST NOT AVAILABLE ( ON PROC XX) @V4075A0 00312050
* DMKCFO186E CP ASSIST NOT AVAILABLE 00312100
* DMKCFO188E SPECIFIED PROCESSOR UNAVAILABLE @V4075A0 00312150
*. 00313000
EJECT 00314000
COPY OPTIONS @V326538 00315000
COPY LOCAL @V326538 00316000
SPACE 3 00317000
DMKCFO CSECT @V326538 00318000
SPACE 00319000
MODID DC CL8'DMKCFO' @V326538 00320000
SPACE 00321000
SPACE 00322000
USING VMBLOK,R11 @V326538 00323000
USING SAVEAREA,R13 @V326538 00324000
USING PSA,R0 @V326538 00325000
USING BUFFER,R9 @V326538 00326000
SPACE 3 00327000
EXTRN DMKERMSG,DMKCVTBH @V326538 00328000
EXTRN DMKSCNFD @V326538 00329000
EXTRN DMKMCIMS @VA10453 00330100
EXTRN DMKSCHAP,DMKSCHAU @V326538 00331000
EXTRN DMKSCHQ1,DMKSCHQ2,DMKSCHDL @V326538 00332000
EXTRN DMKPTRRL @V326538 00333000
EXTRN DMKIOEIR @V326538 00334000
EXTRN DMKSCNAU @V326538 00335000
EXTRN DMKCVTDB @V326538 00336000
EXTRN DMKSCHPG,DMKDSPNP @V326538 00337000
EXTRN DMKCFPRR,DMKBLDEC @V326538 00338000
EXTRN DMKQCNRD @V326538 00339000
EXTRN DMKDMPDV @V326538 00340000
EXTRN DMKDMPAU,DMKDMPSW @V326538 00341000
EXTRN DMKCVTHB @V326538 00342000
EXTRN DMKSCNRU @V326538 00343000
EXTRN DMKCVTDT @V326538 00344000
EXTRN DMKSCHRT,DMKSCH80 @V326538 00345000
EXTRN DMKPTRRU,DMKPTRRC,DMKSYSRV @V326538 00346000
EXTRN DMKSCNRA @V407438 00348000
EXTRN DMKSTKOP @V4075A0 00348100
EXTRN DMKVATAB HRC068DK 00348120
EXTRN DMKVATBC HRC068DK 00348140
EXTRN DMKVATMD HRC068DK 00348160
EXTRN DMKSLC HRC068DK 00348180
EJECT 00349000
* 00350000
* EQUATES FOR SAVEWRK1 00351000
* 00352000
NARGTWO EQU X'80' NO SECOND ARGUMENT FOUND @V326538 00353000
RESRVTYP EQU X'40' RESERVE REQUEST @V326538 00354000
FRSTBYTE EQU X'20' FIRST BYTE FOR RECORDING @V326538 00355000
SECBYTE EQU X'10' SECOND BYTE FOR RECORDING @V326538 00356000
FRSTBIT EQU X'08' FIRST BIT FOR RECORDING @V326538 00357000
SECBIT EQU X'04' SECOND BIT FOR RECORDING @V326538 00358000
WASON EQU X'02' PARM WAS 'ON' @V4075A0 00358050
SPACE 00359000
DMKCFOEX RELOC @V326538 00360000
SVC 16 DROP CFC --> CFO SAVE AREA @V326538 00361000
MVC SAVEWRK1(4),ZEROES ZERO OUT FLAG AREA @V326538 00362000
MVC SAVEWRK2(8),BLANKS BLANK OUT WORK AREA @V326538 00363000
MVC SAVEWRK4(24),SAVEWRK2 . . @V326538 00364000
LR R3,R0 LENGTH OF ARG. TO GPR3 @V326538 00365000
BCTR R3,0 REDUCE FOR EX @V326538 00366000
EX R3,MOVEARG1 MOVE FIRST ARG TO SAVEWRK2 @V326538 00367000
LM R0,R1,BUFNXT GET BUFFER COUNTERS @V326538 00368000
STM R0,R1,SAVEWRK7 SAVE FOR RESCAN AND DATA @V326538 00369000
CALL DMKSCNFD GET SECOND IF ANY @V326538 00370000
BNZ NOARG2 BRANCH IF NOT THERE @V326538 00371000
LR R4,R0 LENGTH OF ARG TO GPR4 @V326538 00372000
C R4,F8 ARG. MORE THAN 8 CHAR. ? @V326538 00373000
BH CFO026 BRANCH IF MORE THAN EIGHT @V326538 00374000
BCTR R4,0 @V326538 00375000
EX R4,MOVEARG2 MOVE SECOND ARG TO SAVEWRK5 @V326538 00376000
B SETBRTAB NOW GO TO APPROPRIATE ROUTINE @V326538 00377000
EJECT 00378000
NOARG2 OI SAVEWRK1,NARGTWO INDICATE NO SECOND ARGUMENT @V326538 00379000
SPACE 00380000
SETBRTAB B SETTAB(R6) GO TO APPROPRIATE ROUTINE @V326538 00381000
SPACE 00382000
SETTAB DS 0F BRANCH TABLE @V326538 00383000
B SETPRIOR SET PRIORITY @V326538 00384000
B SETFAVOR SET FAVOR @V326538 00385000
B SETRESRV SET RESERVED @V326538 00386000
B SETSAS SET SYSTEM ASSIST @V326538 00387000
B SETCPA SET CP ASSIST @V386198 00387100
B SETRECD SET RECORDING @V326538 00388000
B RECDCPU SET MCHK MODE @V326538 00389000
B SETDUMP SET DUMP @V326538 00390000
B SETLOGM SET LOG MESSAGE @V326538 00391000
B SETMAX SET MAX USERS HRC018DK 00391100
B SETSTB SET STBYPASS VR/OFF HRC068DK 00391120
SETTABE EQU * END OF BRANCH TABLE @V326538 00392000
SPACE 00393000
SETCOMP EQU * COMMAND COMPLETE - NO MESSAGE @V326538 00394000
EXIT @V326538 00395000
SPACE 00396000
MOVEARG1 MVC SAVEWRK2(0),0(R1) @V326538 00397000
MOVEARG2 MVC SAVEWRK5(0),0(R1) @V326538 00398000
EJECT 00399000
***** 00400000
* 00401000
* SET PRIORITY COMMAND 00402000
* 00403000
***** 00404000
SPACE 00405000
SETPRIOR EQU * SET USER DISPATCH PRIORITY @V326538 00406000
TM SAVEWRK1,NARGTWO WAS USERID SPECIFIED ? @V326538 00407000
BO CFO020 NO -- USERID MISSING @V326538 00408000
CALL DMKSCNAU R0,R1 STILL O.K. FROM SCAN @V326538 00409000
BNZ CFO045 USERID NOT LOGGED ON @V326538 00410000
LR R10,R1 VMBLOK ADDRESS TO GR10 @V326538 00411000
CALL DMKSCNFD LOCATE 'NN' PARAMETER @V326538 00412000
BNZ CFO026 OPERAND MISSING OR INVALID @V326538 00413000
CL R0,F2 CANNOT BE MORE THAN TWO CHARS @V326538 00414000
BH CFO026 . . .ELSE IT IS INVALID @V326538 00415000
CALL DMKCVTDB CONVERT TO BINARY @V326538 00416000
BNZ CFO026 WASN'T VALID DECIMAL INPUT @V326538 00417000
STC R1,VMUPRIOR-VMBLOK(,R10) SET USER PRIORITY @V326538 00418000
B SETCOMP ALL DONE - NO MESSAGE @V326538 00419000
EJECT 00420000
***** 00421000
* 00422000
* SET FAVOR COMMAND 00423000
* 00424000
***** 00425000
SPACE 00426000
SETFAVOR TM SAVEWRK1,NARGTWO USERID SPECIFIED ??? @V326538 00427000
BO CFO020 USERID MISSING @V326538 00428000
CALL DMKSCNAU GET USERID VMBLOK ADDRESS @V326538 00429000
BNZ CFO045 NOT LOGGED ON @V326538 00430000
LR R8,R1 SAVE VMBLOK ADDRESS @V326538 00431000
CALL DMKSCNFD GET NEXT ARGUMENT @V326538 00432000
BNZ SETFAVNP BRANCH IF NONE FOUND @V326538 00433000
STM R0,R1,SAVEWRK8 SAVE ARGUMENT LENGTH AND ADDRESS @V326538 00434000
CLC 0(3,R1),=C'OFF ' WAS 'OFF' SPECIFIED ? @V326538 00435000
BE SETFAVOF YES - TAKE BRANCH @V326538 00436000
CALL DMKCVTDB CONVERT TO BINARY @V326538 00437000
BNZ BADFAVXX BRANCH IF BAD CONVERT @V326538 00438000
TM SAVEWRK1,RESRVTYP RESERVE REQUEST ???? @V326538 00439000
BO SETRESXX BRANCH IF IT IS @V326538 00440000
LA R0,100 ... FOR ARITHMETIC @V326538 00441000
LR R3,R0 COMPLEMENT AND TEST @V326538 00442000
SR R3,R1 PERCENTAGE @V326538 00443000
BM BADFAVXX PERCENTAGE .GT. 100 --- @V326538 00444000
LTR R9,R1 ANY PERCENT GIVEN @V326538 00445000
BZ BADFAVXX ZERO - NOT ALLOWED @V326538 00446000
L R6,=A(DMKSCHAU) ASSURED EXCUTION USER @V326538 00447000
L R7,0(,R6) CHECK IF ALL READY IN USE @V326538 00448000
LTR R7,R7 IN USE NOW @V326538 00449000
BZ FAVMCH NO - GIVE IT TO USER @V326538 00450000
CLR R7,R8 IN USE BY THIS SAME USER @V326538 00451000
BNE FAVINUSE NO - SEND ERROR MESSAGE @V326538 00452000
FAVMCH ST R8,0(,R6) SAVE VMBLOK ADDR OF FAVORED USER @V326538 00453000
LR R1,R8 SWITCH VMBLOKS @V407510 00454100
SWTCHVM OPT=NOUPDT SWITCH TO FAVORED VMBLOK @V407510 00454200
OI VMRSTAT,VMIDLE FORCE A QUEUE DROP SO @V326538 00457000
CALL DMKSCHDL ACCOUNTING IS CORRECT @V326538 00458000
NI VMRSTAT,X'FF'-VMIDLE REMOVE FROM IDLE STATE @V326538 00459000
OI VMQLEVEL,VMAEX+VMAEXP FLAG ASSURED USER @V326538 00460000
L R6,=A(DMKSCHQ1) ADDRESS OF QUE 1 TIME SLICE @V326538 00461000
LM R2,R3,0(R6) GET QUE 1 TIME SLICE VALUE @V326538 00462000
SRDL R2,12 DROP LOW 12 BITS @V326538 00463000
MR R2,R9 MULTI BY PERCENT VALUE @V326538 00464000
D R2,=F'100' GET PERCENT OF TIME SLICE @V326538 00465000
SLR R2,R2 CLEAR HI ORDER @V326538 00466000
SLDL R2,12 CONVERT BACK TO MICRO SECS @V326538 00467000
L R7,=A(DMKSCHAP) ADDRESS OF QUE 1 PERCENTAGE @V326538 00468000
STM R2,R3,0(R7) SAVE PERCENT IN MICRO SECS @V326538 00469000
LM R0,R1,0(R6) RELOAD QUEUE 1 TIME SLICE @V326538 00470000
SLR R1,R3 SUBTRACT OUT PERCENT FAVORED @V326538 00471000
BC 8+2+1,*+8 SO THAT @V326538 00472000
SL R0,F1 THE RESULT IS THAT PERCENT USER @V326538 00473000
SLR R0,R2 WILL BE AT NORMAL PRIORITY @V326538 00474000
STM R0,R1,8(R7) SAVE NORMAL PRIORITY TIME SLICE @V326538 00475000
SPACE 1 00476000
L R6,=A(DMKSCHQ2) GET ADDRESS OF QUE 2 TIME SLICE @V326538 00477000
LM R2,R3,0(R6) PICK UP QUE 2 TIME SLICE VALUE @V326538 00478000
SRDL R2,12 DROP LOW 12 BITS @V326538 00479000
MR R2,R9 MULTI BY PERCENTAGE @V326538 00480000
D R2,=F'100' GET ACTUAL PERCENT OF TIME SLICE @V326538 00481000
SLR R2,R2 CLEAR OUT REMAINDER @V326538 00482000
SLDL R2,12 CONVERT TO MICRO SECS @V326538 00483000
L R7,=A(DMKSCHAP+16) ADDRESS OF QUE 2 PERCENTAGE @V326538 00484000
STM R2,R3,0(R7) SAVE PERCENT IN MICRO SECS @V326538 00485000
LM R0,R1,0(R6) RELOAD QUEUE 2 TIME SLICE @V326538 00486000
SLR R1,R3 SUBTRACT OUT THE FAVORED @V326538 00487000
BC 8+2+1,*+8 PERCENTAGE, SO THAT @V326538 00488000
SL R0,F1 THE REMAINING PORTION OF THE @V326538 00489000
SLR R0,R2 TIME SLICE IS AT NORMAL PRIORITY @V326538 00490000
STM R0,R1,8(R7) SAVE PERCENT OF NORMAL PRIORITY @V326538 00491000
OI VMQLEVEL,VMHIPRI GIVE USER HIGHEST PRIORITY @V326538 00492000
CALL DMKSCHDL PUT FAV USER IN Q IF POSSIBLE @V326538 00493000
L R1,SAVER11 RESTORE CALLERS VMBLOK @V407510 00494100
SWTCHVM SWITCH BACK TO CALLER @V407510 00494200
SPACE 1 00497000
B SETCOMP RETURN @V326538 00498000
SPACE 00499000
SETFAVNP EQU * HERE IF NO PERCENTAGE SPECIFIED @V326538 00500000
TM SAVEWRK1,RESRVTYP RESERVE REQUEST ???? @V326538 00501000
BO CFO026 NO GOOD @V326538 00502000
OI VMQLEVEL-VMBLOK(R8),VMAEX SET ASSURED EXECUT @V326538 00503000
B SETCOMP RETURN @V326538 00504000
SPACE 00505000
SETFAVOF EQU * COME HERE TO SET FAVOR OFF @V326538 00506000
CL R0,F3 PROPER LENGTH ??? @V326538 00507000
BNE CFO003 NOT IF WE BRANCH --- @V326538 00508000
TM SAVEWRK1,RESRVTYP RESERVE REQUEST ??? @V326538 00509000
BO SETRESOF BRANCH IF IT IS @V326538 00510000
NI VMQLEVEL-VMBLOK(R8),255-(VMAEX+VMAEXP+VMHIPRI) @V326538 00511000
L R7,=A(DMKSCHAU) ADDRESS OF USER GETTING ASSURED @V326538 00512000
C R8,0(,R7) WAS THIS USER RUNNING @V326538 00513000
BNE SETCOMP BRANCH IF NOT @V326538 00514000
SR R0,R0 ZERO REG @V326538 00515000
ST R0,0(,R7) ZERO ADDRESS @V326538 00516000
B SETCOMP FINISHED @V326538 00517000
EJECT 00518000
***** 00519000
* 00520000
* SET RESERVE COMMAND 00521000
* 00522000
***** 00523000
SPACE 00524000
SETRESRV OI SAVEWRK1,RESRVTYP FLAG AS RESERVE REQUEST @V326538 00525000
L R10,=A(DMKPTRRU) ADDRESS OF PRESENT USER(IF ANY)@V326538 00526000
L R5,=A(DMKPTRRL) ADDRESS OF PAGE LIMIT WORD @V326538 00527000
B SETFAVOR GO SCAN ARGUMENTS @V326538 00528000
SPACE 00529000
SETRESXX EQU * @V326538 00530000
ICM R7,15,0(R10) CHECK FOR ALREADY IN USE @V326538 00531000
BZ RESCKXX BRANCH IF NOT - GO PROCESS @V326538 00532000
CLR R8,R7 RESETTING SAME USER ?? @V326538 00533000
BNE RESINUSE NO - AND THAT'S A NO NO !!!!! @V326538 00534000
SPACE 00535000
RESCKXX LR R6,R1 CHK IF REQ NO OF PAGES FIT IN V.M@V326538 00536000
SLL R6,12 FORM MAX ADDRESS @V326538 00537000
SPACE 00538000
DROP R11 @V326538 00539000
USING VMBLOK,R8 @V326538 00540000
SPACE 00541000
CL R6,VMSTOR WILL IT FIT IN VM STORAGE @V326538 00542000
BH BADFAVXX BRANCH IF IT DOESNT @V326538 00543000
ST R1,0(,R5) STORE NEW PAGE COUNT @V326538 00544000
ST R8,0(,R10) STORE VMBLOK ADDRESS @V326538 00545000
OI VMPSTAT,VMRPAGE SET RESERVE FLAG @V326538 00546000
B RSVRESET GO RESET RESERVE BITS IN CORTABLE@V326538 00547000
SPACE 00548000
SETRESOF ICM R7,15,0(R10) CHECK TO SEE IF IN USE @VA04904 00548300
BZ SETCOMP RESERVE IS ALREADY OFF @VA04904 00548600
CLR R8,R7 RESETTING PRESENT RESERVE USER? @VA04904 00548900
BNE RESINUSE NO, WRONG USERID SPECIFIED @VA04904 00549200
SR R0,R0 .... @VA04904 00549500
ST R0,0(,R5) ZERO PAGE LIMIT @V326538 00550000
ST R0,0(,R10) ZERO VMBLOK ADDRESS @V326538 00551000
NI VMPSTAT,255-VMRPAGE TURN OFF RESERVE FLAG @V326538 00552000
SPACE 00553000
DROP R8 @V326538 00554000
USING VMBLOK,R11 @V326538 00555000
SPACE 00556000
RSVRESET EQU * TURN OFF RESERVE FLAG IN CORTABLE@V326538 00557000
L R3,ACORETBL ADDRESS OF START OF CORTABLE @V326538 00558000
LA R4,16 LENGTH OF ONE ENTRY @V326538 00559000
L R5,=A(DMKSYSRV) ADDRESS OF SYSGEN MEMORY SIZE @V326538 00560000
L R5,0(,R5) GET SIZE OF MAIN STORAGE @V326538 00561000
SRL R5,8 GET INDEX TO END OF CORTABLE @V326538 00562000
SLR R5,R4 GET INDEX TO LAST ENTRY @V326538 00563000
ALR R5,R3 POINT TO LAST ENTRY @V326538 00564000
SPACE 00565000
USING CORTABLE,R3 @V326538 00566000
RSVRLOOP NI CORFLAG,X'FF'-CORRSV RESET RESERVED PAGE FLAG @V326538 00567000
BXLE R3,R4,RSVRLOOP LOOP THROUGH THE CORTABLE @V326538 00568000
DROP R3 @V326538 00569000
SPACE 00570000
L R14,=A(DMKDSPNP) ADDRESS OF DYNAMIC PAGE COUNTER@V326538 00571000
L R15,=A(DMKPTRRC) ADDRESS OF RESRVD PAGE COUNTER @V326538 00572000
L R4,0(,R14) GET NO OF AVAILABLE PAGE FRAMES @V326538 00573000
AL R4,0(,R15) ADD RESERVED PAGES NOW AVAIALBLE @V326538 00574000
ST R4,0(,R14) AND SAVE NEW TOTAL @V326538 00575000
SLR R4,R4 CLEAR OUT @V326538 00576000
ST R4,0(,R15) RESERVED PAGE COUNT @V326538 00577000
B SETCOMP AND EXIT @V326538 00578000
SPACE 4 00579000
BADFAVXX LM R0,R1,SAVEWRK8 LENGTH AND ADR. OF ARG. @V326538 00580000
B CFO003 SEND ERROR MESSAGE @V326538 00581000
SPACE 00582000
FAVINUSE EQU * @V326538 00583000
MVC SAVEWRK2(7),=C'FAVORED ' SET RESPONSE @V326538 00584000
SPACE 00585000
IDSETUP MVI SAVEWRK3+3,X'00' SEPARATER @V326538 00586000
MVC SAVEWRK4(8),VMUSER-VMBLOK(R7) MOVE USERID @V326538 00587000
LA R0,16 FIELD LENGTH @V326538 00588000
LA R1,SAVEWRK2 FIELD ADDRESS @V326538 00589000
B CFO175 SEND ERROR MESSAGE @V326538 00590000
SPACE 00591000
RESINUSE EQU * @V326538 00592000
MVC SAVEWRK2(7),=C'RESERVE ' SET RESPONSE @V326538 00593000
B IDSETUP GO FINISH MESSAGE @V326538 00594000
EJECT 00595000
***** 00596000
* 00597000
* SET SASSIST COMMAND 00598000
* 00599000
***** 00600000
SPACE 00601000
SETSAS EQU * SET SYSTEM ASSIST ON / OFF @V326538 00602000
SR R7,R7 INDICATE ON/OFF ONLY LEGAL PARMS @V326538 00603000
LA R8,SETSAS1 SET UP FOR ON @V326538 00604000
BAL R10,TSTONOFF GO - TEST FOR ON/OFF @V326538 00605000
NI SAVEWRK1,X'FF'-WASON THEY SAID 'OFF' @V4075A0 00606010
B BYPROC @V4075A0 00606030
SETSAS1 OI SAVEWRK1,WASON THEY SAID 'ON' @V4075A0 00606050
BYPROC LA R8,SETCOMP MAKE SURE ALL PATHS GO OUT @V4075A0 00606070
TM APSTAT1,APUOPER IF NOT IN AP MODE, @V4075A0 00606090
BNO SASUS JUST DO OUR OWN PSA @V4075A0 00606110
CALL DMKSCNFD @V4075A0 00606130
BNZ SASBOTH DO BOTH PROCESSORS IF NO MORE PARMS@V4075A0 00606150
CLI 0(R1),C'P' OPTIONAL 'PROC' IN COMMAND? @V4075A0 00606170
BNE SASPRCAD NOT EVEN CLOSE @V4075A0 00606190
CALL DMKSCNFD YES, LOOK FOR PROC SPECIFICATION @V4075A0 00606210
BNZ CFO026 THEY FORGOT TO TELL US WHICH ONE! @V4075A0 00606230
SASPRCAD CALL DMKCVTDB @V4075A0 00606250
BNZ CFO026 WHAT THEY GAVE US WASN'T NUMERIC@V4075A0 00606270
C R1,F63 LARGEST PROC ADDR WE HANDLE @V4075A0 00606290
BH CFO026 TOO BIG @V4075A0 00606310
CH R1,IPUADDR IS IT PROCESSOR RUNNING US? @V4075A0 00606330
BE SASUS O.K., JUST DO OURSELF @V4075A0 00606350
CH R1,IPUADDRX OTHER PROCESSOR? @V4075A0 00606370
BNE CFO188 NO, WE DON'T HAVE WHAT THEY WANT @V4075A0 00606390
SASOTHER LA R0,CPEXSIZE GET OVER TO THE OTHER PROCESSOR @V4075A0 00606410
CALL DMKFREE @V4075A0 00606430
USING CPEXBLOK,R1 @V4075A0 00606450
STM R2,R13,CPEXR2 DON'T NEED THE OTHER REG VALUES @V4075A0 00606470
LA R0,SASUS @V4075A0 00606490
ST R0,CPEXADD JUST RESUME RIGHT IN PLACE @V4075A0 00606510
CALL DMKSTKOP WHEN WE GET RESTARTED @V4075A0 00606530
GOTO DMKDSPCH BUT FIRST GET OFF OF THIS PROCESSOR @V4M0122 00606540
SPACE 1 00606542
SASUS EQU * @V4075A0 00606550
TM SAVEWRK1,WASON NOW, DID THEY WANT ON|OFF @V4075A0 00606570
BO SASON @V4075A0 00606590
NI CPSTAT2,X'FF'-CPMICON STOP USE OF VM ASSIST @V4075A0 00606610
BR R8 @V4075A0 00606630
SASON TM CPSTAT2,CPMICAVL DO WE HAVE VM ASSIST? @V4075A0 00606650
BNO CFO184 @V4075A0 00606670
OI CPSTAT2,CPMICON ALLOW EVERYONE TO USE VM ASSIST@V4075A0 00606690
BR R8 @V4075A0 00606710
SPACE 2 @V4075A0 00606730
SASBOTH LH R7,IPUADDR ADDR OF PROC WE'RE DOING NOW. @V4075A0 00606750
BAL R8,SASUS WORK ON CPMICON FOR OUR PROCSR @V4075A0 00606770
LA R8,SETCOMP SET RETURN VECTOR TO EXIT AFTER: @V4075A0 00606790
CH R7,IPUADDR IF WE ARE STILL ON THE SAME PROC @V4075A0 00606810
BE SASOTHER WE MUST SWITCH FIRST & THEN @V4075A0 00606830
B SASUS WORK ON CPMICON FOR 2ND PROC @V4075A0 00606850
SPACE 2 @V4075A0 00606870
CFO184 LA R2,184 MESSAGE NUMBER @V4075A0 00606890
TM APSTAT1,APUOPER ARE WE IN AP MODE? @V4075A0 00606910
BNO NOVAR NO, QUICK EXIT AFTER MESSAGE @V4075A0 00606930
MVC SAVEWRK2(9),OPT184 SET UP OPTIONAL PART OF MSG @V4075A0 00606950
LH R1,IPUADDR CONVERT PROCESSOR ADDRESS @V4075A0 00606970
CALL DMKCVTBH @V4075A0 00606990
STCM R1,B'0011',SAVEWRK4+1 AND PLACE IN MESSAGE @V4075A0 00607010
LA R1,SAVEWRK2 TELL ERM WHERE OPTIONAL DATA IS @V4075A0 00607030
LA R0,11 ALSO HOW MUCH TO USE @V4075A0 00607050
ICM R2,B'1000',X80 FLAG FOR ERM TO RETURN TO US SO @V4075A0 00607070
B CALLERM WE CAN DECIDE WHETHER TO DO 2ND @V4075A0 00607090
SPACE 2 @V4075A0 00607110
CFO188 LA R2,188 WE DON'T HAVE WHAT THEY WANT @V4075A0 00607130
B NOVAR @V4075A0 00607150
SPACE 2 @V4075A0 00607170
F63 DC F'63' @V4075A0 00607190
OPT184 DC C' ON PROC ' @V4075A0 00607210
X80 DC X'80' @V4075A0 00607230
DS 0H @V4075A0 00607250
EJECT 00609300
***** 00609400
* 00609500
* SET CPASSIST COMMAND 00609600
* 00609700
***** 00609800
SPACE 00609900
SETCPA EQU * SET CP ASSIST ON / OFF @V386198 00610000
BAL R8,SETONOFF GO CK FOR ON/OFF @V5DAACD 00610110
BAL R10,SETPROC GO CK 'PROC' OPTION @V5DAACD 00610130
B SETCPA2 UP MODE OR THIS PROCESSOR @V5DAACD 00610150
B SETBOTH AP MODE SET BOTH PROCESSORS @V5DAACD 00610170
SETCPASW EQU * **RETURN +8 SET OTHER PROCESSOR @V5DAACD 00610190
BAL R6,SETOTHER GO SETUP FOR SWITCH @V5DAACD 00610210
SETCPA2 EQU * 00610230
L R11,SAVER11 R11-ADDR. OF USER VMBLOK @V5DAACD 00610250
LR R9,R11 ON ENTRY. SAVE FOR COMPARE. @V5DAACD 00610270
TM SAVEWRK1,WASON NOW DID THEY SAY ON OR OFF? @V5DAACD 00610290
BO SETCPA1 THEY SAID ON.. @V5DAACD 00610310
SLR R7,R7 ZERO R7 FOR CREG 6 @V5DAACD 00610330
* @V5DAACD 00610350
NI CPSTAT2,X'FF'-CPASTON TURN CP ASSIST FLAG OFF @V386198 00610500
SETCPAL1 L R11,VMPNT POINT TO NEXT VMBLOK IN CHAIN @V386198 00610600
NI VMMCR6,X'FF'-VMMCPAST RESET CP ASSIST FLAG @V386198 00610700
CR R9,R11 HAVE WE BEEN HERE BEFORE ? @V386198 00610800
BE SETCPAC6 EXIT IF YES... @V386198 00610900
B SETCPAL1 DO FOR ALL THE VMBLOKS @V386198 00611000
SPACE 00611100
SETCPA1 TM CPSTAT2,CPASTAVL IS THE CP ASSIST AVAILABLE ? @V386198 00611200
BZ CFO186 NO - SEND ERROR MESSAGE @V386198 00611300
OI CPSTAT2,CPASTON INDICATE USING THE CP ASSIST @V386198 00611400
L R7,=A(X'02000000') ENABLE MASK FOR 'CPCREG6' @V386198 00611500
SETCPAL2 L R11,VMPNT GET NEXT VMBLOK ADDRESS @V386198 00611600
OI VMMCR6,VMMCPAST FLAG AS ON IN CR6 COPY @V386198 00611700
CR R9,R11 BACK TO STARTING VMBLOK ? @V386198 00611800
BNE SETCPAL2 NO, CONTINUING WITH THE LOOP @V386198 00611900
SPACE 00612000
SETCPAC6 ST R7,CPCREG6 RESET CP ASSIST ENABLE MASK @V386198 00612100
LCTL C6,C6,CPCREG6 AND RESET CREG. 6 FOR CP ASSIST @V386198 00612200
BR R8 @V5DAACD 00612310
SETBOTH EQU * @V5DAACD 00612320
BAL R8,SETCPA2 GO SETUP THIS PROCESSOR @V5DAACD 00612330
LA R8,SETCOMP SET EXIT ADDR. UPON RETURN. @V5DAACD 00612340
B SETCPASW AND GO SWITCH PROC. @V5DAACD 00612350
EJECT 00612400
***** 00613000
* 00614000
* SET RECORDING COMMAND 00615000
* 00616000
***** 00617000
SPACE 00618000
USING RDEVBLOK,R8 @V326538 00619000
USING IRMBLOK,R5 @V326538 00620000
SPACE 00621000
SETRECD L R3,=A(DMKIOEIR) GET ADDRESS OF IRMBLOK(IF ANY) @V326538 00622000
ICM R5,15,0(R3) IS RECORDING IN PROGRESS ? @V326538 00623000
BZ CKRECARG NO - TAKE BRANCH @V326538 00624000
LH R1,IRMRLADD LOAD DEVICE ADDRESS @V326538 00625000
CALL DMKSCNRU GET RDEVBLOK ADDRESS @V326538 00626000
CKRECARG LR R6,R8 SAVE RDEVBLOK ADDRESS @V326538 00627000
LA R8,RECDON RETURN IF ON @V326538 00628000
SR R7,R7 CLEAR REGISTER 7 @V326538 00629000
SWITCH SWITCH TO MAIN PROCESSSOR @V407510 00629100
BAL R10,TSTONOFF GO - TEST @V326538 00630000
* 00631000
* RETURN HERE IF OFF SPECIFIED 00632000
* 00633000
LR R8,R6 RESTORE RDEVBLOK ADDRESS @V326538 00634000
LTR R5,R5 IRM ACTIVE ? @V326538 00635000
BZ SETCOMP NO - SO NOTHING TO DO @V326538 00636000
NI RDEVSTAT,255-RDEVIRM TURN OFF IRM FOR DEVICE @V326538 00637000
LA R0,IRMSIZE LENGTH OF IRMBLOK @V326538 00638000
LR R1,R5 ADDRESS OF IRMBLOK @V326538 00639000
CALL DMKFRET RETURN STORAGE @V326538 00640000
SR R1,R1 ZERO REG @V326538 00641000
ST R1,0(,R3) ZERO IRMBLOK POINTER @V326538 00642000
B SETCOMP RETURN @V326538 00643000
SPACE 3 00644000
RECDON EQU * @V326538 00645000
LR R8,R6 RESTORE RDEVBLOK ADDRESS @V326538 00646000
LTR R5,R5 IRM IN PROGRESS ? @V326538 00647000
BZ GETIRM NO - MUST GET STORAGE FOR IRMBLOK@V326538 00648000
NI RDEVSTAT,255-RDEVIRM TURN OFF PRESENT IRM @V326538 00649000
B IRMCLEAR @V326538 00650000
GETIRM LA R0,IRMSIZE LOAD IRMBLOK SIZE @V326538 00651000
CALL DMKFREE GET THE STORAGE @V326538 00652000
ST R1,0(,R3) STORE ADDRESS OF BLOK IN DMKIOEIR@V326538 00653000
LR R5,R1 ADDR. TO GPR5 @V326538 00654000
IRMCLEAR XC IRMBLOK(IRMSIZE*8),IRMBLOK ZERO BLOK @V326538 00655000
CALL DMKSCNFD LOCATE NXT ARG; SHOULD BE RADDR @V326538 00656000
BNZ NORADDR BRANCH IF NONE FOUND @V326538 00657000
CALL DMKCVTHB CONVERT TO BINARY @V326538 00658000
BNZ NORADDR MISSING REAL ADDRESS @V326538 00659000
STH R1,IRMRLADD STORE INTO IRMBLOK @V326538 00660000
CALL DMKSCNRU GET RDEVBLOK @V326538 00661000
BNZ NORADDR2 CAN'T FIND UNIT @V326538 00662000
SPACE 00663000
RECDSCAN CALL DMKSCNFD LOCATE NEXT ARGUMENT @V326538 00664000
BNZ RECDFINI GO CLEAN UP AND EXIT @V326538 00665000
LR R2,R0 LENGTH TO GPR2 @V326538 00666000
BCTR R2,0 MINUS ONE FOR EX @V326538 00667000
EX R2,COMPLIM LIMIT REQUEST ??? @V326538 00668000
BE SETRLIM YES @V326538 00669000
EX R2,COMPAND 'AND' REQUEST ???? @V326538 00670000
BE SETRAND YES ---- @V326538 00671000
EX R2,COMPOR 'OR' REQUEST ???? @V326538 00672000
BE SETROR YEP --- @V326538 00673000
EX R2,COMPBYTE 'BYTE' ????? @V326538 00674000
BE SETRBYTE YEP @V326538 00675000
EX R2,COMPBIT 'BIT' ???? @V326538 00676000
BE SETRBIT YES ---- @V326538 00677000
B CFO003 MUST BE BAD ARGUMENT @V326538 00678000
SPACE 00679000
COMPLIM CLC 0(0,R1),=C'LIMIT ' EXECUTED COMPARE @V326538 00680000
COMPAND CLC 0(0,R1),=C'AND ' DITTO @V326538 00681000
COMPOR CLC 0(0,R1),=C'OR ' " @V326538 00682000
COMPBYTE CLC 0(0,R1),=C'BYTE ' " @V326538 00683000
COMPBIT CLC 0(0,R1),=C'BIT ' " @V326538 00684000
SPACE 3 00685000
SETRLIM CL R0,F5 RIGHT LENGTH ???? @V326538 00686000
BNE CFO003 NOPE - SEND ERROR MESSGAE @V326538 00687000
BAL R10,RECGETNN GO GET 'NN' ARGUMENT @V326538 00688000
STH R1,IRMLMT STORE LIMIT @V326538 00689000
B RECDSCAN GO GET NEXT ARGUMENT @V326538 00690000
SPACE 00691000
SETRAND CL R0,F3 PROPER LENGTH ???? @V326538 00692000
BNE CFO003 NOPE --- @V326538 00693000
TM IRMFLG,IRMOR HAS 'OR' BEEN FOUND @V326538 00694000
BO CFO013 BRANCH IF SO - CAN'T HAVE BOTH @V326538 00695000
MVI IRMFLG,IRMAND SET 'AND' FLAG @V326538 00696000
B RECDSCAN GO SCAN SOME MORE @V326538 00697000
SPACE 00698000
SETROR CL R0,F2 RIGHT LENGTH ???? @V326538 00699000
BNE CFO003 NOPE --- @V326538 00700000
TM IRMFLG,IRMAND HAS 'AND' BEEN FOUND ??? @V326538 00701000
BO CFO013 BRANCH IF SO - CAN'T HAVE BOTH @V326538 00702000
MVI IRMFLG,IRMOR SET 'OR' FLAG @V326538 00703000
B RECDSCAN GO DO MORE @V326538 00704000
SPACE 00705000
SETRBYTE CL R0,F4 RIGHT LENGTH ??? @V326538 00706000
BNE CFO003 NO --- @V326538 00707000
TM SAVEWRK1,SECBYTE DO WE HAVE TWO BYTES ALREADY?? @V326538 00708000
BO CFO003 YES - CAN'T LET THAT HAPPEN @V326538 00709000
BAL R10,RECGETNN GET 'NN' ARGUMENT @V326538 00710000
C R1,=F'23' OVER 23 ???? @V326538 00711000
BH BADRECNN BAD NEWS !!!! @V326538 00712000
TM SAVEWRK1,FRSTBYTE HAS FIRST BYTE BEEN PROCESSED @V326538 00713000
BO STBYTE2 YES - MUST BE BYTE TWO @V326538 00714000
STC R1,IRMBYT1 STORE INTO BYTE ONE @V326538 00715000
OI SAVEWRK1,FRSTBYTE INDICATE FIRST BYTE PROCESSED @V326538 00716000
B RECDSCAN TRY AGAIN @V326538 00717000
STBYTE2 EQU * @V326538 00718000
STC R1,IRMBYT2 STOR E INTO IRMBLOK @V326538 00719000
OI SAVEWRK1,SECBYTE INDICATE SECOND BYTE PROCESSED @V326538 00720000
B RECDSCAN GET NEXT ARG @V326538 00721000
SETRBIT CL R0,F3 PROPER LENGTH @V326538 00722000
BNE CFO003 NO --- @V326538 00723000
TM SAVEWRK1,SECBIT DO WE HAVE SECOND BIT ALREADY?? @V326538 00724000
BO CFO003 THAT'S AGAINST THE LAW @V326538 00725000
BAL R10,RECGETNN GET 'NN' ARGUMENT @V326538 00726000
C R1,F7 OVER 7 ????? @V326538 00727000
BH BADRECNN IS A NO-NO !!! @V326538 00728000
TM SAVEWRK1,FRSTBIT FIRST BIT BEEN PROCESSED ? @V326538 00729000
BO STBIT2 YES - MUST BE SECOND BIT @V326538 00730000
STC R1,IRMBIT1 STORE BIT NUMBER @V326538 00731000
OI SAVEWRK1,FRSTBIT INDICATE FIRST BIT PROCESSED @V326538 00732000
B RECDSCAN GO GET NEXT ARG. @V326538 00733000
STBIT2 EQU * @V326538 00734000
STC R1,IRMBIT2 STORE BIT NUMBER @V326538 00735000
OI SAVEWRK1,SECBIT INDICATE SEC BIT PROCESSED @V326538 00736000
B RECDSCAN . . @V326538 00737000
SPACE 00738000
RECGETNN CALL DMKSCNFD GET NN @V326538 00739000
BNZ CFO026 SEND ERROR MESSAGE @V326538 00740000
STM R0,R1,SAVEWRK8 SAVE LENGTH AND ADDRESS @V326538 00741000
CALL DMKCVTDB CONVERT TO BINARY @V326538 00742000
BNZ BADRECNN BAD CONVERT @V326538 00743000
BR R10 RETURN @V326538 00744000
SPACE 00745000
RECDFINI LH R0,IRMLMT CHECK IF LIMIT ARGUMENT @V326538 00746000
LTR R0,R0 HAS BEEN FOUND @V326538 00747000
BZ RECDERR SOMEBODY GOOFED @V326538 00748000
TM SAVEWRK1,FRSTBYTE NEED AT LEAST ONE BYTE @V326538 00749000
BZ RECDERR BAD IF WE DON'T HAVE IT @V326538 00750000
TM SAVEWRK1,FRSTBIT NOW CHECK FOR A BIT @V326538 00751000
BZ RECDERR ALMOST MADE IT @V326538 00752000
OI RDEVSTAT,RDEVIRM IT'S OK TO SET THE FLAG @V326538 00753000
B SETCOMP .... @V326538 00754000
DROP R5,R8 NO MORE IRMBLOK, RDEVBLOK @V326538 00755000
EJECT 00756000
***** 00757000
* 00758000
* SET MODE COMMAND 00759000
* 00760000
***** 00761000
SPACE 00762000
RECDCPU EQU * @V326538 00763000
RETRYMSG EQU X'80' RETRY MESSAGE INDICATOR @V407510 00764100
SR R2,R2 CLEAR MESSAGE INDICATOR @V407510 00764200
CLC SAVEWRK5(5),=C'MAIN ' IS ARGUMENT VALID ? @V326538 00768000
BNE RETRYTST NO, GO TEST FOR RETRY ARGUMENT @V5088AB 00768110
USING MCHAREA,R2 SET UP ADDRESSABILITY TO THE MCHAREA 00768210
* @V5088AB 00768310
L R2,AMCHAREA GET MCH COMMON AREA ADDRESS @V5088AB 00768410
CLI MCHMODEL,MOD3033 IS THIS A 3033, 3032 OR @V5088AB 00768510
* 3031 PROCESSOR? @V5088AB 00768610
* SET MODE MAIN IS NOT ALLOWED FOR EITHER OF THESE PROCESSORS @V5088AB 00768710
BE BADONOFF YES, ISSUE ERROR MESSAGE. @V5088AB 00768810
SR R2,R2 CLEAR MESSAGE INDICATOR @VA08643 00768860
B MCHMCH OK, 'SET MODE MAIN' IS VALID @V5088AA 00768910
RETRYTST CLC SAVEWRK5(6),=C'RETRY ' IS ARGUMENT VALID? @V5088AB 00769010
BNE BADONOFF NO -- ERROR MESSAGE @V326538 00771000
LA R2,RETRYMSG SET THE RETRY MESSAGE SWITCH @V407510 00772100
MCHMCH EQU * @V326538 00774000
CALL DMKMCIMS @VA10453 00775100
B SETCOMP GO TO SET CODE @V326538 00776000
EJECT 00777000
***** 00778000
* 00779000
* SET DUMP COMMAND 00780000
* 00781000
***** 00782000
SPACE 00783000
SETDUMP TM SAVEWRK1,NARGTWO ARE THERE ANY ARGUMENTS ? @V326538 00784000
BO CFO026 SEND ERROR MESSAGE @V326538 00785000
L R3,=A(DMKDMPSW) LOAD ADDRESS OF DUMP SWITCHES @V326538 00786000
CALL DMKSCNFD FIND NEXT ARGUMENT @V326538 00787000
BNZ SETDMCP NO OPERAND - SET DUMP CP @V326538 00788000
CL R0,F3 CANNOT BE MORE THAN THREE CHARS @V326538 00789000
BH CFO003 INVALID OPERAND IF IT IS @V326538 00790000
CLC 0(3,R1),=C'ALL' DUMP ALL STORAGE ? @V326538 00791000
BE SETDALL YES - TURN ON 'ALL' FLAG @V326538 00792000
CLC 0(3,R1),=C'CP ' DUMP CP ? @V326538 00793000
BE SETDMCP YES--DUMP CP STORGE ONLY @V326538 00794000
CL R0,F2 ARE THERE 2 CHARACTERS? @V326538 00795000
BNE CFO003 NO-- INVALID OPTION @V326538 00796000
CLC 0(2,R1),=C'CP' DUMP CP ONLY? @V326538 00797000
BNE CFO003 NO -- INVALID OPERAND @V326538 00798000
SETDMCP EQU * @V326538 00799000
NI 0(R3),255-DUMPALL DUMP ONLY CP STORAGE @V326538 00800000
B SETDMP1 @V326538 00801000
SPACE 00802000
SETDALL EQU * SET DUMP ALL SPECIFIED @V326538 00803000
OI 0(R3),DUMPALL DUMP ALL OF REAL STORAGE @V326538 00804000
SPACE 00805000
SETDMP1 DS 0H @V407510 00806100
SWITCH @V407510 00806200
L R3,=A(DMKDMPDV) ADDRESS OF DUMP DEVICE WORD @V407510 00806300
ICM R1,B'1111',0(R3) IS THERE A DUMP DEVICE? @V407438 00806500
BZ SETDMP2 NOPE, BR. @V407438 00807000
CALL DMKSCNRU GO GET RBLOKS @V407438 00807500
USING RCHBLOK,R6 ADDRESS THE CHANNEL BLOCK @V407438 00808000
USING RCUBLOK,R7 ADDRESS THE CTLUNIT BLOCK @V407438 00808500
USING RDEVBLOK,R8 ADDRESS THE DEVICE BLOCK @V407438 00809000
CLI RDEVTYPC,CLASTAPE TAPE DEVICE ???? @V326538 00810000
BNE SETDMP2 BRANCH IF NOT @V326538 00811000
NI RDEVFLAG,255-RDEVSYS REMOVE SYSTEM FLAG @V326538 00812000
SETDMP2 EQU * @V326538 00813000
LA R1,SAVEWRK5 LOAD ADDRESS OF ARGUMENT @V326538 00814000
LA R0,1(,R4) LOAD LENGTH OF ARGUMENT @V326538 00815000
CL R0,F4 MAYBE 'AUTO' SPECIFIED @V326538 00816000
BE DUMPAUTO GO FIND OUT IF IT WAS @V326538 00817000
BH CFO003 INVALID IF MORE THAN 4 CHARS @V326538 00818000
CALL DMKCVTHB CONVERT ADDRESS @V326538 00819000
BNZ CFO021 BAD CONVERT @V326538 00820000
CALL DMKSCNRU GET BLOK ADDRESSES @V326538 00821000
BNZ CFO040 DOES NOT EXIST @V326538 00822000
CLI RDEVTYPC,CLASTAPE IS THIS A TAPE DEVICE ? @V326538 00823000
BNE PTRCHEK NO - GO CHEK FOR PRINTER @V326538 00824000
TM RDEVSTAT,RDEVDED IS TAPE ALREADY DEDICATED @V326538 00825000
BO CFO140 DEVICE DEDICATED @V326538 00826000
LA R10,RCUCHA ADDRESS OF FIRST CHANNEL @VA08156 00826051
LA R4,4 INCREMENT @V407438 00826100
LA R5,RCUCHD ADDRESS OF THE LAST CHANNEL @V407438 00826150
NEXTCH CL R6,0(R10) R6 PRESENT THIS CU ->CH PATH? @VA08156 00826210
BE *+8 YES, PATH FOUND, BR. @V407438 00826250
BXLE R10,R4,NEXTCH NOPE, LOOK AT ALL CHANNEL PATHS @VA08156 00826310
LA R4,RCUCHA ADDRESS OF THE BEGINNING AGAIN @V407438 00826350
SLR R10,R4 FIND HOW FAR DOWN WE FOUND IT @VA08156 00826400
SRL R10,2 CONVERT TO INDEX FROM 0 TO 3 @VA08156 00826450
IC R5,DISATBL(R10) GET CORRECTPATH OFFLINE BIT @VA08156 00826500
EX R5,CUCHDISA (TM RCUSTAT,RCUCHXOF) PTH AVAIL? @V407438 00826550
BO CFO046 NOPE, OFFLINE... ERROR @V407438 00826600
TM RCUSTAT,RCUDISA ... DON'T BE FOOLED BY... @V407438 00826650
BO CFO046 ... ALTERNATE PATHS @V407438 00826700
TM RDEVSTAT,RDEVDISA TAPE OFFLINE ?? @V326538 00827000
BO CFO046 YEP ----- @V326538 00828000
TM RDEVFLAG,RDEVSYS SYSTEM VOLUME NOW? @V326538 00829000
BO CFO143 YUP, MUST BE DUE TO MONITOR @V326538 00830000
OI RDEVFLAG,RDEVSYS TURN ON SYSTEM FLAG @V326538 00831000
STODEV ST R1,0(R3) STORE DEVICE ADDRESS (CCU) @V407438 00832000
B SETCOMP @V326538 00833000
SPACE 2 00834000
PTRCHEK CLI RDEVTYPC,CLASURO IS THIS UR OUTPUT DEVICE ? @V326538 00835000
BNE CFO006 INVALID DEVICE TYPE --- @V326538 00836000
TM RDEVTYPE,TYPPRT IS THIS A PRINTER DEVICE ? @V326538 00837000
BZ CFO006 NO - SEND INVALID TYPE MSG @V326538 00838000
B STODEV GO SET UP DUMP DEVICE WORD @V326538 00839000
SPACE 2 00840000
DUMPAUTO EQU * @V326538 00841000
CLC SAVEWRK5(4),=C'AUTO' SET DUMP AUTO ? @V326538 00842000
BNE CFO003 NO -- INVALID OPERAND @V326538 00843000
L R1,=A(DMKDMPAU) GET CCU FOR AUTO DEVICE @V407438 00844000
L R1,0(R1) ... @V407438 00845000
B STODEV --- @V326538 00846000
DROP R8 @V326538 00847000
SPACE 3 00848000
DUMPALL EQU X'80' FLAG FOR DUMP ALL @V326538 00849000
SPACE 00849100
* RCU TO RCH BLOCK PATH AVAILABLE BITS IN RCUSTAT 00849200
DISATBL DC AL1(RCUCHAOF,RCUCHBOF,RCUCHCOF,RCUCHDOF) @V407438 00849300
CUCHDISA TM RCUSTAT,0 CHECK RCU -> RCH PATH AVAILBILITY@V407438 00849400
EJECT 00850000
***** 00851000
* 00852000
* SET LOGMSG COMMAND 00853000
* 00854000
***** 00855000
SPACE 00856000
SETLOGM L R8,ASYSLC ADDRESS OF SYSLOCS @V326538 00857000
USING SYSLOCS,R8 @V326538 00858000
LA R8,DMKSYSLG ADDRESS OF FIRST LOG MESSAGE @V326538 00859000
DROP R8 @V326538 00860000
TM SAVEWRK1,NARGTWO WAS THERE ANY ARGUMENT @V326538 00861000
BO ADDLOG NO - ADD TO LOG MSG @V326538 00862000
CLC SAVEWRK5(5),=C'NULL ' NULL REQUEST ???? @V326538 00863000
BE NULLOG YES - TAKE BRANCH @V326538 00864000
LA R1,SAVEWRK5 POINT R1 TO ARG @V326538 00865000
LA R0,1(,R4) LENGTH TO R0 @V326538 00866000
CALL DMKCVTDB CONVERT @V326538 00867000
BNZ CFO026 HAVE AN ERROR @V326538 00868000
LR R3,R1 REMEMBER IT @VA08818 00868100
BAL R10,LOGFND FIND THE LOGMSG LINE @VA08818 00869100
BZ CFO041 LINE NUMBER NOT FOUND @VA08818 00869110
LR R9,R5 REMEMBER THIS ADDRESS @VA08818 00869120
LA R0,11 LOAD THE SIZE OF THE MSG BLOK @VA08818 00869130
CALL DMKFREE GET CORE FOR NEW MSG BLOK @VA08818 00869140
LR R8,R1 ADDRESS OF BUFFER TO R8 @VA08818 00869150
STH R3,6(,R8) PUT LINE MUNBER IN NEW BUFFER @VA08818 00869160
BAL R10,READLOG GO READ LOG MESSAGE @V326538 00875000
BZ DELINE NULL INPUT - DELETE LINE @V326538 00876000
BAL R10,LOGFND IS OUR LINE NUMBER STILL THERE @VA08818 00876100
BZ FRETNEW NO, SOMEONE DELETED IT @VA08818 00876110
CR R5,R9 SAME STORAGE LOCATION ? @VA08818 00876120
BNE FRETNEW NO, LEAVE IT ALONE @VA08818 00876130
MVC 0(4,R8),0(R5) POINTER TO THE NEXT LINE @VA08818 00876140
ST R8,0(0,R6) CHAIN LINE TO PREVIOUS LINE @VA08818 00876150
LR R8,R5 FRET THE OLD MSG BUFFER @VA08818 00876160
FRETNEW BAL R10,FRETLOG @VA08818 00876170
B LOGFINI GET OUT @V326538 00877000
SPACE 00878000
DELINE EQU * @V326538 00879000
BAL R10,LOGFND IS OUR LINE NUMBER STILL THERE @VA08818 00879100
BZ FRNEW NO, IT'S GONE @VA08818 00879110
CR R5,R9 SAME STORAGE LOCATION @VA08818 00879120
BNE FRNEW NO, LEAVE IT ALONE @VA08818 00879130
MVC 0(4,R6),0(R5) UP CHAIN PTR TO BYPASS BLOK @VA08818 00879140
LA R0,11 LENGTH OF BUFFER FOR FRET @VA08818 00879150
LR R1,R5 START OF LOGMSG BUFFER @VA08818 00879160
CALL DMKFRET FRET THE LOGMSG BUFFER @VA08818 00879170
FRNEW BAL R10,FRETLOG FRET NEW LOGMSG BLOK @VA08818 00879180
B SEQLOG GO RESEQUENCE MESSAGES @V326538 00882000
SPACE 00883000
ADDLOG LR R6,R8 SAVE PREVIOUS POINTER @V326538 00884000
ICM R8,15,0(R8) REACHED THE END YET ? @V326538 00885000
BNZ ADDLOG NO - KEEP GOING @V326538 00886000
NXTLOG EQU * READ NEXT LOGMSG LINE @V326538 00887000
LA R0,11 LOAD SIZE OF MESSAGE BLOK @V326538 00888000
CALL DMKFREE GET CORE FOR NEW MESSAGE BLOK @V326538 00889000
XC 0(4,R1),0(R1) ZERO POINTER @V326538 00890000
LR R8,R1 BUFFER FOR NEXT LINE @V326538 00891000
BAL R10,READLOG READ NEXT LOGMSG LINE @V326538 00892000
BZ DONE NULL LINE = END OF INPUT @VA08818 00892100
ST R8,0(0,R6) CHAIN NEW LINE TO PREVIOUS @V326538 00894000
LR R6,R8 THIS IS NOW THE LAST LINE @V326538 00895000
B NXTLOG GO GET ANOTHER BUFFER @V326538 00896000
SPACE 2 00896100
DONE DS 0H @VA08818 00896200
MVC 0(4,R6),0(R8) UPD CHAIN TO BYPASS THIS BLOK @VA08818 00896300
BAL R10,FRETLOG FRET LOGMSG LINE BUFFER @VA08818 00896400
B SEQLOG GO SEQUENCE MESSAGES @VA08818 00896500
SPACE 2 00896600
EJECT 00897000
NULLOG EQU * SET LOGMSG NULL @V326538 00898000
L R7,0(0,R8) POINTER TO FIRST LINE (IF ANY) @V326538 00899000
MVC 0(4,R8),ZEROES CLEAR LOGMSG POINTER @V326538 00900000
NULLOG1 EQU * DELETE ALL LOGMSG LINES @V326538 00901000
LTR R8,R7 NEXT LOGMSG LINE, MAYBE @V326538 00902000
BNP LOGFINI JUMP OUT WHEN FINISHED @V326538 00903000
L R7,0(0,R8) SAVE FORWARD POINTER @V326538 00904000
BAL R10,FRETLOG FRET ONE LOGMSG LINE BUFFER @V326538 00905000
B NULLOG1 CONTINUE FOR THEM ALL @V326538 00906000
SPACE 00907000
READLOG LA R0,8 LOAD SIZE OF PROMPT @V326538 00908000
LA R1,=C'LOGMSG: ' PROMPT MESSAGE @V326538 00909000
CALL DMKQCNWT,PARM=NORET+NOAUTO @V326538 00910000
LA R0,76 LOAD MAX LENGTH @V326538 00911000
LA R1,8(0,R8) START OF LOGMSG DATA @V326538 00912000
CALL DMKQCNRD,PARM=UCASE+EDIT READ MESSAGE @V326538 00913000
BZ GOODQCN BRANCH, IF CONDITION CODE=0 @VA10128 00913200
SR R0,R0 MAKE IT LOOK LIKE NULL LINE @VA10128 00913400
GOODQCN DS 0H @VA10128 00913600
STH R0,4(0,R8) SET DATA LENGTH IN BUFFER @V326538 00914000
LTR R0,R0 SET CONDITION CODE @V326538 00915000
BR R10 RETURN TO CALLER @V326538 00916000
SPACE 00917000
LOGFND L R5,ASYSLC ADDRESS OF SYSLOCS @VA08818 00917100
USING SYSLOCS,R5 @VA08818 00917110
LA R5,DMKSYSLG ADDRESS OF FIRST LOGMSG @VA08818 00917120
DROP R5 @VA08818 00917130
LOOP LR R6,R5 SAVE POINTER @VA08818 00917140
L R5,0(,R5) GET NEXT MSG BLOK @VA08818 00917150
LTR R5,R5 END REACHED? @VA08818 00917160
BZR R10 LINE NUMBER NOT FOUND @VA08818 00917170
CH R3,6(,R5) IS THIS REQUESTED LINE NUMBER ? @VA08818 00917180
BNE LOOP NO, TRY NEXT ONE @VA08818 00917190
LTR R5,R5 SET CONDITION CODE @VA08818 00917200
BR R10 AND RETURN TO CALLER @VA08818 00917210
SPACE 2 00917220
SEQLOG L R8,ASYSLC ADDRESS OF SYSLOCS @V326538 00918000
USING SYSLOCS,R8 @V326538 00919000
LA R8,DMKSYSLG ADDRESS OF FIRST LOG MESSAGE @V326538 00920000
DROP R8 @V326538 00921000
LA R1,1 START OF SEQUENCE @V326538 00922000
SEQLOG1 L R8,0(,R8) GET NEXT MESSAGE BLOK @V326538 00923000
LTR R8,R8 END REACHED ? @V326538 00924000
BZ LOGFINI YES @V326538 00925000
STH R1,6(,R8) SET SEQUENCE NUMBER @V326538 00926000
LA R1,1(,R1) BUMP SEQUENCE NUMBER @V326538 00927000
B SEQLOG1 GO DO NEXT @V326538 00928000
SPACE 00929000
LOGFINI L R4,ASYSLC ADDRESS OF SYSLOCS @V326538 00930000
USING SYSLOCS,R4 @V326538 00931000
LA R1,DMKSYSDT POINT TO LOG DATE @V326538 00932000
LA R2,DMKSYSTM POINT TO LOG TIME @V326538 00933000
CALL DMKCVTDT GET DATE/TIME @V326538 00934000
MVC DMKSYSLW(12),DMKSYSDW MOVE IN DAY/WEEK @V326538 00935000
B SETCOMP @V326538 00936000
DROP R4 @V326538 00937000
EJECT 00938000
FRETLOG EQU * RELEASE A LOGMSG BUFFER @V326538 00939000
LR R1,R8 START OF BUFFER @V326538 00940000
LA R0,11 SIZE = 11 DBL-WDS @V326538 00941000
CALL DMKFRET RETURN IT TO FREE STORAGE @V326538 00942000
BR R10 RETURN @V326538 00943000
EJECT 00944000
***** 00944010
* 00944020
* SET MAX NN COMMAND 00944030
* 00944040
***** 00944050
SPACE 1 HRC018DK 00944060
SETMAX L R8,ASYSLC GET SYSLOCS ADDRESS HRC018DK 00944070
USING SYSLOCS,R8 HRC018DK 00944080
SLR R2,R2 ZERO R2 JUST IN CASE HRC018DK 00944090
TM SAVEWRK1,NARGTWO TEST FOR 'NN' NOT FOUND HRC018DK 00944100
BO SETMAX0 IF YES USE DEFAULT OF 0 HRC018DK 00944110
CALL DMKCVTDB CONVERT TO BINARY HRC018DK 00944120
BNZ CFO026 BAD OPTION HRC018DK 00944130
LR R2,R1 COPY 'NN' HRC018DK 00944140
SETMAX0 ST R2,DMKSYSMA SET IN SYSLOCS HRC018DK 00944150
B SETCOMP ALL DONE - NO MESSAGE HRC018DK 00944160
EJECT , HRC018DK 00944170
***** HRC068DK 00944180
* HRC068DK 00944190
* SET STBYPASS VR/OFF COMMAND HRC068DK 00944200
* HRC068DK 00944210
***** HRC068DK 00944220
SETSTB EQU * HRC068DK 00944230
TM SAVEWRK1,NARGTWO Are there any arguments?HRC068DK 00944240
BO CFO026 No, send error msg HRC068DK 00944250
* 00944260
C R11,AVMREAL Am I the V=R user? HRC068DK 00944270
BNE CFO063 No, send message HRC068DK 00944280
TM VMFSTAT,VMSTFRST User has STFIRST auth? HRC068DK 00944290
BZ CFO063 No, OPTION STFIRST req'dHRC068DK 00944300
TM VMPSTAT,VMV370R User is ECMODE capable? HRC068DK 00944310
BZ CFO062 No, ECMODE must be ON HRC068DK 00944320
CLC SAVEWRK5(3),=C'OFF' Set bypass off? HRC068DK 00944330
BE STBOFF Yes HRC068DK 00944340
CLC SAVEWRK5(3),=C'VR ' Set bypass vr? HRC068DK 00944350
BNE CFO026 N, invalid argument HRC068DK 00944360
TM VMCXSTAT,VMSTBYPS STBYPASS VR already set?HRC068DK 00944370
BO SETCOMP Y, no action, no responsHRC068DK 00944380
TM VMESTAT,VMSHADT Shadow tables present? HRC068DK 00944390
BZ CFO063 No, STB not allowed HRC068DK 00944400
CALL DMKVATBC Release old shadow tbls HRC068DK 00944410
* VMSTBYPS must be set *AFTER* DMKVATBC is called! HRC068DK 00944420
OI VMCXSTAT,VMSTBYPS Turn on STBYPASS VR HRC068DK 00944430
CALL DMKVATAB Set up guest CR1 & PG 0 HRC068DK 00944440
TM VMCXSTAT,VMSTBYPS STBYPS VR off after VAT?HRC068DK 00944450
BZ CFO063 Y, bad CR0/1, set off. HRC068DK 00944460
SR R15,R15 Clear for ICM HRC068DK 00944470
ICM R15,7,VMMADDR -> MICBLOK HRC068DK 00944480
BZ STBON None, ECPS:VM not activeHRC068DK 00944490
USING MICBLOK,R15 HRC068DK 00944500
MVI MICEVMA2,MICSTBAL Set on all STB ECPS asstHRC068DK 00944510
DROP R15 HRC068DK 00944520
* HRC068DK 00944530
STBON EQU * HRC068DK 00944540
MVC STBMSGA,=CL8'BYPASSED' Set msg HRC068DK 00944550
B STBMSGS Send msg HRC068DK 00944560
* HRC068DK 00944570
STBOFF EQU * HRC068DK 00944580
TM VMCXSTAT,VMSTBYPS STBYPASS VR already off?HRC068DK 00944590
BZ SETCOMP Y, no action, no responsHRC068DK 00944600
L R1,VMECEXT -> ECBLOK HRC068DK 00944610
L R1,EXTCR1-ECBLOK(,R1) Get V=R user's STO HRC068DK 00944620
TM 3(R1),X'01' Segment invalid? HRC068DK 00944630
BO STBRES Yes HRC068DK 00944640
L R1,0(,R1) -> PTE for page 0 HRC068DK 00944650
TM 1(R1),X'08' Page invalid? HRC068DK 00944660
BO STBRES Yes HRC068DK 00944670
L R15,=A(DMKSLC-4096) Get real addr of page 0 HRC068DK 00944680
SRL R15,8 Put addr in PTE format HRC068DK 00944690
ICM R0,3,0(R1) Load the page 0 PTE HRC068DK 00944700
N R0,=X'0000FFF0' Keep only address bits HRC068DK 00944710
CR R0,R15 PTE point to V=R page 0?HRC068DK 00944720
BNE STBRES Not V=R relocated page 0HRC068DK 00944730
NC 0(2,R1),F15+2 Set back to user page 0 HRC068DK 00944740
* HRC068DK 00944750
STBRES EQU * HRC068DK 00944760
NI VMCXSTAT,255-VMSTBYPS Reset STBYPASS HRC068DK 00944770
CALL DMKVATMD Get new shadow tables HRC068DK 00944780
CALL DMKVATAB And mark them invalid HRC068DK 00944790
MVC STBMSGA,=CL8'RESUMED ' Set msg HRC068DK 00944800
SR R15,R15 Clear for ICM HRC068DK 00944810
ICM R15,7,VMMADDR -> MICBLOK HRC068DK 00944820
BZ STBMSGS None, ECPS:VM not activeHRC068DK 00944830
USING MICBLOK,R15 HRC068DK 00944840
MVI MICEVMA2,0 Set off all STB assists HRC068DK 00944850
DROP R15 HRC068DK 00944860
* HRC068DK 00944870
STBMSGS LA R0,STBMSGL Msg size HRC068DK 00944880
LA R1,STBMSG Msg data HRC068DK 00944890
CALL DMKQCNWT,PARM=NORET Send response HRC068DK 00944900
B SETCOMP Done HRC068DK 00944910
* HRC068DK 00944920
STBMSG DC CL25'SHADOW TABLE MAINTENANCE ' HRC068DK 00944930
STBMSGA DC CL8' ' HRC068DK 00944940
STBMSGL EQU *-STBMSG HRC068DK 00944950
***** 00945000
* 00946000
* COMMON SUBROUTINES 00947000
* 00948000
***** 00949000
SPACE 00950000
EXECONF EQU * TEST FOR ON OR OFF (SINGLE BIT) @V326538 00951000
SLR R7,R7 NOTHING ELSE IS VALID @V326538 00952000
LA R8,EXECSON RETURN IF 'ON' SPECIFIED @V326538 00953000
BAL R10,TSTONOFF GO TEST @V326538 00954000
EX 0,4(0,R9) TURN OFF WHATEVER IT IS @V326538 00955000
B SETCOMP @V326538 00956000
SPACE 00957000
EXECSON EX 0,0(0,R9) TURN ON WHATEVER IT IS @V326538 00958000
B SETCOMP @V326538 00959000
SPACE 3 00960000
* TEST FOR ON/OFF ARGUMENT. WASON BIT SET @V5DAACD 00960100
* TO 1 IF ON SPECIFIED.ISSUE MSG IF ON/OFF @V5DAACD 00960110
* NOT SPECIFIED. @V5DAACD 00960120
SETONOFF EQU * @V5DAACD 00960130
TM SAVEWRK1,NARGTWO ANY 2ND ARGUMENT? @V5DAACD 00960140
BO CFO026 NO-GO ISSUE ERROR MSG. @V5DAACD 00960150
CLC SAVEWRK5(3),=C'OFF' OFF SPECIFIED? @V5DAACD 00960160
BCR 8,R8 YES - WASON BIT=0 ON ENTRY. @V5DAACD 00960170
CLC SAVEWRK5(3),=C'ON ' ON SPECIFIED? @V5DAACD 00960180
BNE BADONOFF NEITHER ON AND/OR OFF SPECIFIED @V5DAACD 00960190
OI SAVEWRK1,WASON SET ON INDICATOR FOR @V5DAACD 00960200
BR R8 LATER USE AND RETURN @V5DAACD 00960210
SPACE 3 00960220
* TEST FOR OPTIONAL 'PROC' IN COMMAND. @V5DAACD 00960230
* RETURN +0-UP MODE OR THIS PROCESSOR @V5DAACD 00960240
* +4-AP SET BOTH PROCESSOR'S @V5DAACD 00960250
* +8-AP AND OTHER PROCESSOR SPECIFIED. @V5DAACD 00960260
SETPROC EQU * @V5DAACD 00960270
LA R8,SETCOMP SETUP EXIT. @V5DAACD 00960280
TM APSTAT1,APUOPER AP MODE? @V5DAACD 00960290
BCR 14,R10 NO RETURN R10+0 @V5DAACD 00960300
* @V5DAACD 00960310
CALL DMKSCNFD LOCATE PROC IF GIVEN @V5DAACD 00960320
BNZ 4(R10) DO BOTH PROC'S IF PROC NOT SPECIFIED @V5DAACD 00960330
CLI 0(R1),C'P' OPTIONAL 'PROC' IN COMMAND? @V5DAACD 00960340
BNE SETPROC1 NO @V5DAACD 00960350
CALL DMKSCNFD YES,LOOK FOR PROC SPECIFIED. @V5DAACD 00960360
BNZ CFO026 THEY FORGOT TO TELL US WHICH ONE @V5DAACD 00960370
SETPROC1 EQU * @V5DAACD 00960380
CALL DMKCVTDB @V5DAACD 00960390
BNZ CFO026 VALUE GIVEN WASEN'T NUMERIC @V5DAACD 00960400
L R0,F63 LARGEST PROCESSOR ADDRESS POSSIBLE @V5DAACD 00960410
CR R1,R0 @V5DAACD 00960420
BH CFO026 TOO TOO BIG.. @V5DAACD 00960430
CH R1,IPUADDR IS IT PROCESSOR RUNNING US? @V5DAACD 00960440
BE 0(R10) YES RETURN +0 @V5DAACD 00960450
CH R1,IPUADDRX THE OTHER PROCESSOR? @V5DAACD 00960460
BE 8(R10) YES RETURN +8 @V5DAACD 00960470
LA R2,188 NO WE DON'T HAVE IT.. @V5DAACD 00960480
B NOVAR @V5DAACD 00960490
SPACE 3 00960500
* ROUTINE TO GET OVER TO THE OTHER @V5DAACD 00960510
* PROCESSOR.R6 CONTAINS RETURN ADDRESS. @V5DAACD 00960520
SETOTHER EQU * @V5DAACD 00960530
LA R0,CPEXSIZE @V5DAACD 00960540
CALL DMKFREE @V5DAACD 00960550
USING CPEXBLOK,R1 @V5DAACD 00960560
STM R2,R13,CPEXR2 SAVE NEEDED REG'S @V5DAACD 00960570
ST R6,CPEXADD SETUP RETURN ADDRESS. @V5DAACD 00960580
CALL DMKSTKOP FROM WHICH WE GET RESTARTED @V5DAACD 00960590
GOTO DMKDSPCH 1ST GET OFF OF THIS PROCESSOR. @V5DAACD 00960600
TSTONOFF EQU * @V326538 00961000
TM SAVEWRK1,NARGTWO ANY SECOND ARGUMENT @V326538 00962000
BO CFO026 BAD NEWS @V326538 00963000
CLC SAVEWRK5(3),=C'ON ' WAS 'ON' SPECIFIED @V326538 00964000
BCR 8,R8 YES, TAKE BRANCH ON R8 @V326538 00965000
CLC SAVEWRK5(4),=C'OFF ' 'OFF' SPECIFIED ??? @V326538 00966000
BCR 8,R10 BRANCH IF YES @V326538 00967000
LTR R7,R7 ANYTHING ELSE LEGAL ? @V326538 00968000
BCR 7,R7 YES - RETURN TO SUBROUTINE @V326538 00969000
SPACE 00970000
BADONOFF LA R1,SAVEWRK5 ARGUMENT ADDRESS @V326538 00971000
LA R0,1(,R4) LENGTH @V326538 00972000
B CFO003 GO SEND ERROR MESSAGE @V326538 00973000
SPACE 3 00974000
IRMFRET LA R0,IRMSIZE SIZE OF IRMBLOK IN D. W. @V326538 00975000
LR R1,R5 ADDRESS OF BLOK @V326538 00976000
CALL DMKFRET RETURN TO STORAGE @V326538 00977000
SR R1,R1 ZERO REG. @V326538 00978000
ST R1,0(,R3) ZERO DMKIOEIR @V326538 00979000
BR R10 RETURN @V326538 00980000
SPACE 3 00981000
BLDADR EQU * @V326538 00982000
CALL DMKSCNRA GET THE 'CCU' DEVICE ADDRESS @V407438 00983000
CALL DMKCVTBH CONVERT IT TO HEX @V326538 00984000
BR R10 RETURN TO CALLER @V326538 00985000
EJECT 00986000
***** 00987000
* 00988000
* ERROR MESSAGES 00989000
* 00990000
***** 00991000
SPACE 00992000
SETNTERR EQU * @V326538 00993000
LA R0,1(,R3) LENGTH @V326538 00994000
LA R1,SAVEWRK2 AND ADDRESS @V326538 00995000
B CFO003 OF BAD ARGUMENT @V326538 00996000
SPACE 00997000
BADRECNN LM R0,R1,SAVEWRK8 LENGTH AND ADDRESS OF BAD ARG. @V326538 00998000
SPACE 00999000
CFO003 LA R2,3 INVALID OPTION - OPTN @V326538 01000000
B CALLERM ... @V326538 01001000
SPACE 2 01002000
CFO006 LA R2,6 INVALID DEVICE TYPE - RADDR @V326538 01003000
BAL R10,BLDADR GO BUILD DEVICE ADDRESS @V326538 01004000
STCM R1,7,SAVEWRK2 STUFF INTO SAVE AREA @V326538 01005000
LA R0,3 LENGTH @V326538 01006000
LA R1,SAVEWRK2 ADDRESS @V326538 01007000
B CALLERM ... @V326538 01008000
SPACE 2 01009000
CFO013 LA R2,13 CONFLICTING OPTION - OPTN @V326538 01010000
B CALLERM ... @V326538 01011000
SPACE 2 01012000
CFO020 LA R2,20 USERID MISSING OR INVALID @V326538 01013000
B NOVAR ... @V326538 01014000
SPACE 2 01015000
NORADDR BAL R10,IRMFRET RETURN IRMBLOK @V326538 01016000
SPACE 01017000
CFO021 LA R2,21 RADDR MISSING OR INVALID @V326538 01018000
B NOVAR ... @V326538 01019000
SPACE 2 01020000
RECDERR BAL R10,IRMFRET GET RID OF IRMBLOK @V326538 01021000
SPACE 01022000
CFO026 LA R2,26 OPERAND MISSING OR INVALID @V326538 01023000
B NOVAR ... @V326538 01024000
SPACE 2 01025000
NORADDR2 LR R9,R1 SAVE BAD ARG. @V326538 01026000
BAL R10,IRMFRET RETURN IRMBLOK @V326538 01027000
LR R1,R9 RESTORE BAD ARG. @V326538 01028000
SPACE 01029000
CFO040 CALL DMKCVTBH CONVERT BACK TO HEX @V326538 01030000
N R1,X40FFS BLANK HIGH BYTE @V326538 01031000
SLR R0,R0 ZERO LENGTH REG @V326538 01032000
LA R2,40 DEV ADDR DOES NOT EXIST @V326538 01033000
B CALLERM ... @V326538 01034000
SPACE 2 01035000
CFO041 LA R2,41 LOGMSG NN DOES NOT EXIST @V326538 01036000
LA R0,1(,R4) ARG. LENGTH @V326538 01037000
LA R1,SAVEWRK5 ARG. ADDRESS @V326538 01038000
B CALLERM ... @V326538 01039000
SPACE 2 01040000
CFO045 LA R2,45 USERID NOT LOGGED ON @V326538 01041000
LA R0,1(,R4) LENGTH @V326538 01042000
LA R1,SAVEWRK5 ADDRESS @V326538 01043000
B CALLERM ... @V326538 01044000
SPACE 2 01045000
CFO046 LA R2,46 TYPE RADDR OFFLINE @V326538 01046000
MVC SAVEWRK2(4),=C'TAPE' MOVE IN TYPE @V326538 01047000
MVI SAVEWRK3,X'00' SEPARATER @V326538 01048000
BAL R10,BLDADR BUILD REAL ADDRESS @V326538 01049000
STCM R1,7,SAVEWRK3+1 STUFF IT INTO FIELD @V326538 01050000
LA R0,8 FIELD LENGTH @V326538 01051000
LA R1,SAVEWRK2 ADDRESS @V326538 01052000
B CALLERM ... @V326538 01053000
CFO062 EQU * HRC068DK 01053010
LA R2,62 ECMODE not set on HRC068DK 01053020
B NOVAR Go send message HRC068DK 01053030
CFO063 EQU * HRC068DK 01053040
LA R2,63 STBYPASS not set HRC068DK 01053050
B NOVAR Go send message HRC068DK 01053060
SPACE 2 01054000
USING RDEVBLOK,R8 @V326538 01055000
CFO140 LA R2,140 TYPE RADDR ATTACHED TO USERID @V326538 01056000
MVC SAVEWRK2(4),=C'TAPE' MOVE TYPE TO MESSAGE @V326538 01057000
MVI SAVEWRK3,X'00' SEP. BYTE @V326538 01058000
BAL R10,BLDADR BUILD REAL ADDRESS @V326538 01059000
STCM R1,B'0111',SAVEWRK3+1 STORE INTO FIELD @V326538 01060000
MVI SAVEWRK4,X'00' SEP. BYTE @V326538 01061000
L R1,RDEVUSER USERS VMBLOK ADDRESS @V326538 01062000
MVC SAVEWRK4+1(8),VMUSER-VMBLOK(R1) INSERT USERID @V326538 01063000
LA R0,17 LENGTH @V326538 01064000
LA R1,SAVEWRK2 ADDRESS OF FIELD @V326538 01065000
B CALLERM ... @V326538 01066000
DROP R8 NO MORE RDEVBLOK @V326538 01067000
SPACE 2 01068000
CFO143 MVC SAVEWRK3+3(4),=C'TAPE' SET UP THE SUBSTITUTES @V326538 01069000
MVC SAVEWRK4+3,X'00' DELIMITER @V326538 01070000
LA R0,8 LENGTH OF SUBSTITUTE DATA @V326538 01071000
LA R1,SAVEWRK3+3 ADDRESS OF THE SUBSTITUTABLES @V326538 01072000
LA R2,143 TYPE RADDR IN USE BY SYSTEM @V326538 01073000
B CALLERM GO DO IT @V326538 01074000
SPACE 2 01075000
CFO175 LA R2,175 FAV|RES ALREADY IN USE BY USERID @V326538 01076000
B CALLERM @V326538 01077000
SPACE 01079200
CFO186 LA R2,186 ERROR CODE: CP ASSIST NOT AVAIL. @V386198 01079300
SPACE 01079400
NOVAR SLR R1,R1 ZERO PARM REG @V326538 01081000
SPACE 01082000
CALLERM ICM R0,14,MODID+3 INSERT MODULE IDENTITY @V326538 01083000
CALL DMKERMSG SEND MESSAGE @V326538 01084000
* 01085000
* ERMSG WILL RETURN TO DMKCFM INSTEAD OF HERE 01086000
SPACE 1 @V4075A0 01086100
* EXCEPT FOR SASSIST IN AP ENVIRONMENT @V4075A0 01086200
BR R8 @V4075A0 01086300
* 01087000
EJECT 01088000
LTORG @V326538 01089000
EJECT 01090000
PSA @V326538 01091000
COPY CONBUF @V326538 01092000
COPY CORE @V326538 01093000
COPY DEVTYPES @V326538 01094000
COPY EQU @V326538 01095000
COPY IOER @V326538 01096000
COPY RBLOKS @V326538 01098000
COPY SAVE @V326538 01099000
SYSLOCS @V326538 01100000
COPY VMBLOK @V326538 01101000
COPY MICBLOK HRC068DK 01101050
COPY MCHAREA @V5088AB 01101110
EJECT 01102000
* 01103000
* EQUATES FOR CLASSES 01104000
* 01105000
A EQU VMCLASSA @V326538 01106000
B EQU VMCLASSB @V326538 01107000
C EQU VMCLASSC @V326538 01108000
D EQU VMCLASSD @V326538 01109000
E EQU VMCLASSE @V326538 01110000
F EQU VMCLASSF @V326538 01111000
G EQU VMCLASSG @V326538 01112000
END DMKCFO 01113000