ibm:vm370-lib:cp:dmkcfo.assemble_src
Table of Contents
DMKCFO Source
References
- Fixes Applied : 6
- This Source Date : Thursday, December 7, 1978
- Last Fix ID : [HRC068DK]
Source Listing
- DMKCFO.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkcfo.assemble_src.txt · Last modified: 2023/08/06 13:36 by Site Administrator