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 | 00074000 * | | | 00075000 * | | | 00076000 * | | RESERVE USERID XX | 00077000 * | | OFF | 00078000 * | | SASSIST ON < XX>| 00079100 * | | OFF | 00080000 * ' ' CPASSIST ON < 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