CFS TITLE 'DMKCFS (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF INPUT @V3M4037 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMKCFS 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* TO PROCESS NON PRIVILEGED SET COMMANDS 00010000
* 00011000
* ATTRIBUTES - 00012000
* 00013000
* REENTRANT, PAGEABLE, CALLED VIA SVC 00014000
* 00015000
* ENTRY POINTS - 00016000
* 00017000
* DMKCFSET - ENTRY FOR 'SET' COMMAND (CLASS G ONLY) 00018000
* 00019000
* ENTRY CONDITIONS - 00020000
* 00021000
* GPR0 = LENGTH OF THE SET ARGUMENT 00022000
* GPR1 = ADDRESS OF THE SET ARGUMENT 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
* DMKFREE - TO OBTAIN A BLOCK OF FREE STORAGE 00046000
* DMKFRET - TO RETURN A BLOCK OF STORAGE 00047000
* DMKQCNRD - TO READ A RESPONSE FROM THE TERMINAL 00048000
* DMKCVTDT - TO GET THE DATE AND TIME 00049000
* DMKSTKIO - TO STACK A TIMER REQUEST BLOK (TRQBLOK) 00050000
* DMKERMSG - TO SEND AN ERROR MESSAGE 00051000
* DMKSCHRT - TO FREE A TIMER REQUEST BLOK 00052000
* DMKSCNAU - TO FIND A USER'S VMBLOK @V4075A0 00053000
* DMKUDRFU - TO FIND THE USER'S DIRECTORY ENTRY @V4075A0 00054000
* DMKUDRMD - TO READ THE USER'S MACHINE DESCRIPTOR @V4075A0 00055000
* DMKUDRRV - TO RELEASE THE DIRECTORY PAGE IN VM VM @V4075A0 00056000
* 00057000
* TABLES/WORKAREAS - 00058000
* 00059000
* VMBLOK 00060000
* MICBLOK 00061000
* 00062000
* REGISTER USAGE - 00063000
* 00064000
* GPR0 = ARGUMENT LENGTH (RETURN BY DMKSCNFD) 00065000
* GPR1 = ADDRESS OF ARGUMENT (RETURN BY DMKSCNFD) 00066000
* GPR9 = ADDRESS OF COMMAND LINE 00067000
* GPR11 = ADDRESS OF USERS VMBLOK 00068000
* GPR12 = BASE REGISTER 00069000
* GPR13 = ADDRESS OF SAVEAREA 00070000
* 00071000
* COMMAND LINE FORMAT - 00072000
* 00073000
* CLASS G 00074000
* +-------+-------------------------+ 00075000
* | SET | ACNT ON | 00076000
* | | MSG OFF | 00077000
* | | WNG | 00078000
* | | RUN | 00079000
* | | LINEDIT | 00080000
* | | PAGEX | 00081000
* | | NOTRANS | 00082000
* | | ECMODE | 00083000
* | | IMSG | 00084000
* | | ISAM | 00085000
* | | AUTOPOLL | 00086000
* | | CPUID BBBBBB | 00087000
* | | PRIV CCCCCCC| 00087100
* | | | 00088000
* | | EMSG ON | 00089000
* | | OFF | 00090000
* | | CODE | 00091000
* | | TEXT | 00092000
* | | | 00093000
* | | TIMER ON | 00094000
* | | OFF | 00095000
* | | REAL | 00096000
* | | | 00097000
* | | ASSIST ON | 00098000
* | | OFF | 00099000
* | | SVC | 00100000
* | | NOSVC | 00101000
* | | TMR | 00102000
* | | NOTMR | 00103000
* | | | @V4075A0 00104000
* | | AFFINITY ON | @V4075A0 00105000
* | | OFF | @V4075A0 00106000
* | | XX | @V4075A0 00107000
* | | USERID | @V4075A0 00108000
* | | | @V4075A0 00109000
* +-------+-------------------------+ 00110000
* 00111000
* +-------+-----------------------------+ 00112000
* | SET | PFNN DELAYED FUNCTION | 00113000
* | | IMMED | 00114000
* +-------+-----------------------------+ 00115000
* 00116000
* +-------+-----------------------------+ 00117000
* | SET | SMSG ON | 00118000
* | | OFF | 00119000
* +-------+-----------------------------+ 00120000
* 00121000
* 00122000
* OPERATION - 00123000
* 00124000
* 1. CALL DMKSCNFD TO SEE IF THERE IS A SECOND ARGUMENT. IF 00125000
* NONE IS FOUND, SET A FLAG TO INDICATE THIS AND CONTINUE. 00126000
* IF HAVE ONE, SAVE IT IN SAVEWRK5/6. 00127000
* 2. USING THE INDEX SET BY DMKCFC, BRANCH TO THE APPROPRIATE 00128000
* ROUTINE TO HANDLE THE REQUEST. 00129000
* 00130000
* TSTONOFF - THIS IS THE SUBROUTINE TO TEST THE ON/OFF 00131000
* ARGUMENT. IF THE ARGUMENT = ON, RETURN ON REGISTER 8. 00132000
* IF THE ARGUMENT = OFF, RETURN ON REGISTER 10. IF NO 00133000
* OTHER ARGUMENTS ARE LEGAL, CALL DMKERMSG TO SEND ERROR 00134000
* MESSAGE DMKCFS026E. IF SOMETHING ELSE LEGAL, RETURN 00135000
* ON REGISTER 7. 00136000
* 00137000
* SET TIMER 00138000
* 1. SETIMER - ROUTINE TO PROCESS THE SET TIME REQUEST. SET UP 00139000
* REGISTERS 7 AND 8 FOR RETURN FROM TSTONOFF. THEN BAL R10 00140000
* TO THE SUBROUTINE LABELED TSTONOFF. 00141000
* 2. IF OFF WAS SPECIFIED, CHECK IF REAL IS NOW ACTIVE. 00142000
* IF IT IS, CALL DMKFRET TO FRET THE TIMER BLOK FOR THIS 00143000
* USER. SET THE VMTLEVEL FOR OFF, DISABLE THE VIRTUAL TIMER 00144000
* ASSIST, AND EXIT. 00145000
* 3. IF ON WAS SPECIFIED, CHECK FOR REAL ACTIVE. IF SO, 00146000
* CALL DMKFRET TO FRET THE TIMER BLOK. SET UP VMTLEVEL FOR 00147000
* ON, CHECK IF VIRTUAL TIMER ASSIST CAN BE USED, AND EXIT. 00148000
* 4. IF GET A RETURN FOR OTHER THAN ON/OFF, CHECK IF 'REAL'. 00149000
* IF NOT, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCFS003E. 00150000
* IF OK, CALL DMKFREE TO GET STORAGE FOR A TIMER BLOK. 00151000
* INITIALIZE THE TIMER BLOK, ENABLE TIMER FEATURE IF IT CAN 00152000
* BE USED, AND THEN EXIT. 00153000
* SET ISAM 00154000
* 1. SETISAM - ROUTINE FOR THE SET ISAM REQUEST. SET UP FOR 00155000
* RETURN FROM THE SUBROUTINE LABELED TSTONOFF AND BAL R10 00156000
* TO THAT ROUTINE. 00157000
* 2. IF RETURN FOR OFF, RESET THE VMISAM FLAG IN THE VMBLOK 00158000
* AND EXIT. 00159000
* 3. IF RETURN FOR ON, SET THE VMISAM FLAG IN THE VMBLOK 00160000
* AND EXIT. 00161000
* SET AUTOPOLL 00162000
* 1. SETAUTO - ROUTINE FOR THE SET AUTOPOLL REQUEST. SET UP FOR 00163000
* RETURN FROM THE SUBROUTINE LABELED TSTONOFF AND BAL R10 00164000
* TO THAT ROUTINE. 00165000
* 2. IF RETURN FOR OFF, RESET THE VMFAUTO FLAG IN THE VMBLOK 00166000
* AND EXIT. 00167000
* 3. IF RETURN FOR ON, SET THE VMFAUTO FLAG IN THE VMBLOK 00168000
* AND EXIT. 00169000
* SET EMSG 00170000
* 1. SETERROR - ROUTINE TO PROCESS THE SET EMSG REQUEST. SET 00171000
* UP REGISTERS 7 AND 8 FOR THE RETURN FROM ON/OFF TESTING. 00172000
* BAL R10 TO THE SUBROUTINE LABELED TSTONOFF TO TEST THE 00173000
* ON/OFF/CODE/TEXT. 00174000
* 2. IF RETURN FOR OFF CONDITION, SET THE VMMLEVEL FOR 00175000
* NO EMSG AND EXIT. 00176000
* 3. IF RETURN FOR ON, SET UP VMMLEVEL FOR BOTH CODE AND TEXT 00177000
* AND EXIT. 00178000
* 4. IF RETURN FOR OTHER THAN ON/OFF, CHECK FOR 'CODE'. IF 00179000
* IT IS, SET UP THE VMMLEVEL FOR ERROR CODE ONLY AND 00180000
* EXIT. IF FOR 'TEXT' SET VMMLEVEL FOR TEXT ONLY AND 00181000
* EXIT. IF NEITHER OF THESE, CALL DMKERMSG TO 00182000
* SEND ERROR MESSAGE DMKCFS003E. 00183000
* SET ACNT 00184000
* 1. SETACNT - ROUTINE FOR THE SET ACNT REQUEST. SET UP THE 00185000
* RETURNS FOR ON/OFF AND BAL R10 TO SUBROUTINE LABELED 00186000
* TSTONOFF. 00187000
* 2. IF RETURN FOR OFF, RESET THE VMACCON FLAG IN THE 00188000
* VMBLOK AND EXIT. 00189000
* 3. IF RETURN FOR ON, TURN ON THE VMACCON FLAG IN THE 00190000
* VMBLOK AND EXIT. 00191000
* SET LINEDIT 00192000
* 1. SETLINE - ROUTINE FOR THE SET LINED REQUEST. SET UP FOR 00193000
* RETURN FROM SUBROUTINE LABELED TSTONOFF AND BAL R10 TO 00194000
* THAT ROUTINE. 00195000
* 2. IF RETURN FOR OFF, RESET THE VMLINED FLAG IN THE VMBLOK 00196000
* AND EXIT. 00197000
* 3. IF RETURN FOR ON, SET THE VMLINED FLAG IN THE VMBLOK 00198000
* AND EXIT. 00199000
* SET RUN 00200000
* 1. SETRUN - ROUTINE FOR THE SET RUN REQUEST. SET UP FOR 00201000
* RETURN FROM THE SUBROUTINE LABELED TSTONOFF AND BAL R10 00202000
* TO THAT ROUTINE. 00203000
* 2. IF RETURN FOR OFF, RESET THE VMRUNON FLAG IN THE VMBLOK 00204000
* AND EXIT. 00205000
* 3. IF RETURN FOR ON, SET THE VMRUNON FLAG IN THE VMBLOK 00206000
* AND EXIT. 00207000
* SET WNG 00208000
* 1. SETWNG - ROUTINE FOR SET WNG REQUEST. SET UP FOR THE 00209000
* RETURN FROM THE SUBROUTINE LABELED TSTONOFF AND BAL R10 00210000
* TO THAT ROUTINE. 00211000
* 2. IF RETURN FOR OFF, RESET THE VMWNGON FLAG IN THE 00212000
* VMBLOK AND EXIT. 00213000
* 3. IF RETURN FOR ON, SET THE VMWNGON FLAG IN THE VMBLOK 00214000
* AND EXIT. 00215000
* SET MSG 00216000
* 1. SETMSG - ROUTINE FOR THE SET MSG REQUEST. SET UP FOR THE 00217000
* RETURN FROM THE SUBROUTINE LABELED TSTONOFF AND BAL R10 00218000
* TO THAT ROUTINE. 00219000
* 2. IF RETURN FOR OFF, RESET THE VMMSGON FLAG IN THE VMBLOK 00220000
* AND EXIT. 00221000
* 3. IF THE RETURN IS FOR ON, SET THE VMMSGON FLAG IN THE 00222000
* VMBLOK AND EXIT. 00223000
* SET NOTRANS 00224000
* 1. SETNTRAN - ROUTINE TO HANDLE NOTRAN REQUEST. IF NOT A 00225000
* VALID NOTRAN USER, CALL DMKERMSG TO SEND ERROR MESSAGE 00226000
* DMKCFS003E. IF THE USER IS A VALID ONE, SET UP REGISTERS 00227000
* FOR THE RETURN FROM THE SUBROUTINE LABELED TSTONOFF AND 00228000
* BAL R10 TO THAT ROUTINE. 00229000
* 2. IF RETURN FOR OFF, RESET THE NOTRANS FLAG IN THE VMBLOK 00230000
* AND EXIT. 00231000
* 3. IF RETURN FOR ON, SET THE NOTRANS FLAG IN THE VMBLOK 00232000
* AND EXIT. 00233000
* SET PFNN 00234000
* 1. GET IMMED OR DELAYED PARM IF ENTERED 00235000
* 2. SET PF FUNCTION RELEASING OLD ONE IF PRESENT 00236000
* 3. SCAN TO SEE IF ALL FUNCTIONS NULL AND 00237000
* FRET FUNCTION TABLE IF SO 00238000
* SET ASSIST 00239000
* 1. SETASST - ROUTINE TO PROCESS SET ASSIST REQUEST. IF THERE 00240000
* IS NO SECOND ARGUMENT, CALL DMKERMSG TO SEND ERROR MESSAGE 00241000
* DMKCFS026E. IF THERE IS ONE, ASCERTAIN WHAT IT IS. 00242000
* 2. IF ARGUMENT IS SVC, VERIFY THAT VM ASSIST IS AVAILABLE 00243000
* IF NOT, ISSUE MSG DMKCFS184E. ELSE 00244000
* TURN ON VMMICSVC BIT IN THE VMBLOK AND IF NO ADSTOP IS IN 00245000
* EFFECT TURN OFF THE VMMSVC BIT IN THE VMBLOK. GO TO STEP 8. 00246000
* 3. IF ARGUMENT IS NOSVC, TURN OFF VMMICSVC BIT AND TURN ON 00247000
* VMMSVC BIT (BOTH IN VMBLOK). GO TO STEP 8. 00248000
* 4. IF ARGUMENT IS TMR, CHECK FOR VM ASSIST AND TIMER ASSIST 00249000
* AVAILABLE, IF NOT SEND ERROR MESSAGE DMKCFS187E. ELSE TURN 00250000
* ON VMFVTMR BIT IN VMBLOK AND CHECK IF TIMER ASSIST CAN BE 00251000
* ENABLED. IF IT CAN, TURN ON VMMVTMR BIT IN VMBLOK AND SET 00252000
* UP MICVTMR POINTER IN MICBLOK. 00253000
* 5. IF ARGUMENT IS NOTMR, TURN OFF VMFVTMR BIT IN VMBLOK AND 00254000
* DISABLE VIRTUAL TIMER ASSIST. GO TO STEP 8. 00255000
* 6. IF ARGUMENT IS ON, CHECK IF VM ASSIST IS AVAILABLE FOR THE 00256000
* SYSTEM. IF NOT, ISSUE MSG DMKCFS184E. ELSE GET SPACE 00257000
* FOR MICBLOK; PUT ADDRESS OF MICBLOK INTO VMBLOK; CHECK IF 00258000
* VIRTUAL TIMER ASSIST CAN BE ENABLED; GO TO STEP 8. 00259000
* 7. IF ARGUMENT IS OFF, FRET MICBLOK; TURN OFF VMMFE, VMMVTMR 00260000
* BITS IN VMBLOK; ZERO VMMADDR IN VMBLOK; GO TO STEP 8. 00261000
* 8. CALL DMKSCNFD TO FIND ANOTHER ARGUMENT. IF FOUND, MOVE IT 00262000
* TO SAVEWRK5 AND GO TO STEP 2. ELSE CONTINUE 00263000
* 9. EXIT, GIVING USER INFORMATION DESCRIBING AVAILABILITY 00264000
* OF VM ASSIST AS FOLLOWS: 00265000
* 10. IF USER HAS VM ASSIST AND AFFINITY BUT SYSTEM VM ASSIST 00266000
* IS NOT ON FOR THE AFFINITY PROCESSOR, THEN 00267000
* A. IF PROCESSOR HAS VM ASSIST, SEND MSG DMKCFS183E 00268000
* B. IF VM ASSIST IS NOT AVAILABLE ON THAT PROCESSOR, 00269000
* SEND MSG DMKCFS184E WITH THE PROCESSOR ADDRESS 00270000
* 11. IF USER HAS VM ASSIST AND NO AFFINITY AND VM ASSIST 00271000
* IS NOT ON FOR ANY PROCESSOR, SEND MSG DMKCFS183E 00272000
* SET PAGEX 00273000
* 1. SET PAGEX ON/OFF - ENABLE/DISABLE PSEUDO PAGE FAULTS 00274000
* VERIFY THAT USER HAS ECMODE PRIVILEGES; IF NOT, CALL 00275000
* DMKERMSG FOR MESSAGE DMKCFS003E 00276000
* 2. VERIFY THAT 2ND ARGUMENT EXISTS AND IS EITHER "ON" OR 00277000
* "OFF"; IF NOT, CALL DMKERMSG FOR MESSAGE 00278000
* DMKCFS003 00279000
* 3. BASED ON ON/OFF TEST, SET OR RESET FLAG VMPAGEX IN 00280000
* VMPSTAT AND EXIT. 00281000
* SET IMSG 00282000
* 1. SETIMSG - ROUTINE TO HANDLE SET IMSG ON|OFF. VERIFY 00283000
* THAT 2ND ARGUMENT EXISTS AND THAT IT'S ON OR OFF. IF 00284000
* ARGUMENT MISSING, ISSUE MSG DMKCFS0026E, IF INVALID, 00285000
* ISSUE MSG DMKCFS003E. 00286000
* 2. BASED ON ON/OFF TEST, SET OR RESET VMMIMSG BIT IN 00287000
* VMMLVL2 AND EXIT. 00288000
* 00289000
* SET SMSG - ROUTINE TO SET SMSG FLAG IN USER'S VMBLOK 'ON' OR 'OFF' 00290000
* 1. GET ON/OFF OPTION AND VALIDATE. 00291000
* 2. IF OPTION IS INVALID, SEND MSG DMKCFS026E. 00292000
* 3. ELSE SETUP FOR RETURN FROM TSTONOFF SUBROUTINE. BAL R10 00293000
* TO THAT ROUTINE. 00294000
* 4. IF OPTION IS 'OFF', TURN OFF APPROPRIATE FLAG IN VMBLOK. 00295000
* 5. IF OPTION IS 'ON', TURN ON APPROPRIATE FLAG IN VMBLOK. 00296000
* 6. RETURN TO CALLER WITH CODE OF 0. 00297000
* 00298000
* SET CPUID BBBBBB 00299000
* 1. SETCPUID - ROUTINE TO HANDLE SET CUPID BBBBBB; 00300000
* VERIFY THAT SECOND ARGUMENT EXISTS. IF NOT, ISSUE 00301000
* DMKCFS026E MESSAGE. 00302000
* 2. IF 'BBBBBB' FIELD IS GREATER THAN 6 DIGITS, ISSUE 00303000
* MESSAGE DMKCFS026E. 00304000
* 3. OTHERWISE, CONVERT CPU SERIAL (BBBBBB) FROM HEX TO 00305000
* BINARY AND STORE IN VMCPUID FIELD. 00306000
* 00307000
* SET AFFINITY SET THE VMAFF BYTE IN THE VMBLOK TO INDICATE 00308000
* WHETHER AFFINITY IS WANTED, AND IF SO, WHICH PROCESSOR 00309000
* 00310000
* 1. SET USERID = ISSUER. IF NO ARGS, GO TO 18 00311000
* 2. USE TSTONOFF TO SEE IF 2ND ARG IS ON|OFF|NUMERIC|UID 00312000
* 3. IF RETURN FOR OFF, SET TARGET PROC = 0 AND GO TO 17 00313000
* 4. IF RETURN FOR ON, GO TO 18 00314000
* 5. CHECK USER FOR COMMAND CLASS A ELSE ISSUE MSG 26 00315000
* 6. IF ARGUMENT IS NUMERIC, GO TO 12 00316000
* 7. IF ARGUMENT IS NOT NUMERIC, SAVE AS A USERID AND GET 00317000
* NEXT ARGUMENT. IF NONE, GO TO 18 00318000
* 8. USE TSTONOFF TO SEE IF 3RD ARG IS ON|OFF|NUMERIC 00319000
* 9. IF RETURN FOR OFF, SET TARGET PROC = 0, AND GO TO 17 00320000
* 10. IF RETURN FOR ON, GO TO 18 00321000
* 11. CONVERT ARGUMENT TO BINARY 00322000
* 12. IF ARG > 63 OR NOT DECIMAL, ISSUE ERROR MSG 26 AND EXIT 00323000
* 13. OR X'40' OVER BINARY VALUE AND SAVE AS TARGET PROCESSOR 00324000
* 14. IF TARGET PROCESSOR = LPUADDR, 00325000
* A. IF SYSTEM RUNNING AP, GO TO 17 00326000
* B. ELSE, ISSUE MSG 189 AND EXIT 00327000
* 15. IF ARG ¬= LPUADDR & SYSTEM RUNNING UP, ISSUE MSG 188 00328000
* 16. IF SYSTEM RUNNING AP, 00329000
* A. IF TARGET PROCESSOR = LPUADDRX, GO TO 17 00330000
* B. ELSE ISSUE MSG 188 AND EXIT 00331000
* 17. LOOK FOR SPECIFIED USER LOGGED ON. IF NOT, ISSUE MSG 45 00332000
* SET AFFINITY INTO VMAFF IN TARGET USER'S VMBLOK 00333000
* 18. LOOK FOR TARGET USER'S DIRECTORY ENTRY 00334000
* A. IF NO AFFINITY IN DIRECTORY, GIVE MSG 190 AND EXIT 00335000
* B. ELSE, USE UMACAFF AS TARGET PROCESSOR, GO TO 14 00336000
* 00337000
* ERROR MESSAGES - 00338000
* DMKCFS003E INVALID OPTION - (OPTION) 00339000
* DMKCFS026E OPERAND MISSING OR INVALID 00340000
* DMKCFS045E (USERID) NOT LOGGED ON 00341000
* DMKCFS052E ERROR IN CP DIRECTORY 00342000
* DMKCFS053E (USERID) NOT IN CP DIRECTORY 00343000
* DMKCFS183E VM ASSIST NOT ACTIVE 00344000
* DMKCFS184E VM ASSIST NOT AVAILABLE 00345000
* DMKCFS187E TIMER ASSIST NOT AVAILABLE 00346000
* DMKCFS188E SPECIFIED PROCESSOR UNAVAILABLE @V4075A0 00347000
* DMKCFS189E AFFINITY NOT SET, SYSTEM IN UNI-PROCESSOR M@V4075A0 00348000
* DMKCFS190E NO AFFINITY SPECIFIED IN DIRECTORY @V4075A0 00349000
*. 00350000
EJECT 00351000
COPY OPTIONS 00352000
COPY LOCAL 00353000
SPACE 3 00354000
DMKCFS CSECT 00355000
SPACE 00356000
MODID DC CL8'DMKCFS' 00357000
SPACE 2 00358000
USING VMBLOK,R11 00359000
USING SAVEAREA,R13 00360000
USING PSA,R0 00361000
USING BUFFER,R9 @V200730 00362000
SPACE 3 00363000
EXTRN DMKERMSG @V326538 00364000
EXTRN DMKSCNFD 00365000
EXTRN DMKCFPRR,DMKBLDEC @V2B4320 00367000
EXTRN DMKSCHRT,DMKSCH80 00368000
EXTRN DMKCVTDB,DMKCVTBH @V326538 00369000
EXTRN DMKSCNRD @V200820 00370000
EXTRN DMKCVTHB @V407466 00371000
EXTRN DMKSCNAU @V4075A0 00372000
EXTRN DMKUDRFU,DMKUDRMD,DMKUDRRV @V4075A0 00373000
EJECT 00374000
* 00375000
* EQUATES FOR SAVEWRK1 00376000
* 00377000
NARGTWO EQU X'80' NO SECOND ARGUMENT FOUND 00378000
SPACE 00379000
DMKCFSET RELOC 00380000
SVC 16 DROP CFC --> CFS SAVE AREA @V326538 00381000
MVC SAVEWRK1(4),ZEROES ZERO OUT FLAG AREA 00382000
MVC SAVEWRK2(8),BLANKS BLANK OUT WORK AREA 00383000
MVC SAVEWRK4(24),SAVEWRK2 . . 00384000
LR R3,R0 LENGTH OF ARG. TO GPR3 @V326538 00385000
BCTR R3,0 REDUCE FOR EX @V326538 00386000
EX R3,MOVEARG1 MOVE FIRST ARG TO SAVEWRK2 @V326538 00387000
LM R0,R1,BUFNXT GET BUFFER COUNTERS @V326538 00388000
STM R0,R1,SAVEWRK7 SAVE FOR RESCAN AND DATA @V326538 00389000
CALL DMKSCNFD GET SECOND IF ANY @V326538 00390000
BNZ NOARG2 BRANCH IF NOT THERE @V326538 00391000
LR R4,R0 LENGTH OF ARG TO GPR4 @V326538 00392000
C R4,F8 ARG. MORE THAN 8 CHAR. ? @V326538 00393000
BH CHKPF YES, INVALID UNLESS SET PFNN @VA05857 00394000
* COMMAND 00395000
BCTR R4,0 @V326538 00396000
EX R4,MOVEARG2 MOVE SECOND ARG TO SAVEWRK5 @V326538 00397000
B SETBRTAB NOW GO TO APPROPRIATE ROUTINE @V326538 00398000
SPACE 00399000
CHKPF LA R4,SETPFNN-SETTAB GET INDEX INTO SET FUNCTION @VA05857 00400000
* TABLE 00401000
CR R4,R6 IS IT SET PFNN? @VA05857 00402000
BNE CFS026 NO, INVALID ARGUMENT @VA05857 00403000
B SETBRTAB YES, CONTINUE PFNN PROCESSING @VA05857 00404000
EJECT 00405000
NOARG2 OI SAVEWRK1,NARGTWO INDICATE NO SECOND ARGUMENT @V326538 00406000
SPACE 00407000
SETBRTAB B SETTAB(R6) GO TO APPROPRIATE ROUTINE @V326538 00408000
SPACE 00409000
SETTAB DS 0F BRANCH TABLE @V326538 00410000
B SETASST SET ASSIST @V326538 00411000
B SETNTRAN SET NOTRANS @V326538 00412000
B SETIMER SET TIMER @V326538 00413000
B SETERROR SET EMSG @V326538 00414000
B SETIMSG SET IMSG @V326538 00415000
B SETACNT SET ACNT @V326538 00416000
B SETPAGEX SET PAGEX @V326538 00417000
B SETLINE SET LINEDIT @V326538 00418000
B SETRUN SET RUN @V326538 00419000
B SETWNG SET WNG @V326538 00420000
B SETMSG SET MSG @V326538 00421000
B SETECMD SET ECMODE @V326538 00422000
B SETISAM SET ISAM @V326538 00423000
B SETAUTO SET AUTOPOLL @V386198 00424000
SETPFNN B SETPF SET PFNN TO VALUE SPECIFIED @VA05857 00425000
B SETCPUID SET CPUID BBBBBB COMMAND @V407466 00426000
B SETAFF SET AFFINITY @V4075A0 00427000
B SETSMSG GO SET THE SMSG FLAG @V60C2B8 00428000
B SETPRIV SET PRIV HRC018DK 00428100
SETTABE EQU * END OF BRANCH TABLE @V326538 00429000
SPACE 2 00430000
MOVEARG1 MVC SAVEWRK2(0),0(R1) @V326538 00431000
MOVEARG2 MVC SAVEWRK5(0),0(R1) @V326538 00432000
SPACE 3 00433000
SETCOMP EQU * COMMAND COMPLETE - NO MESSAGE @V326538 00434000
EXIT @V326538 00435000
EJECT 00436000
***** 00437000
* 00438000
* SET PAGEX COMMAND 00439000
* 00440000
***** 00441000
SPACE 00442000
SETPAGEX EQU * PROCESS "SET PAGEX ON/OFF" @V213135 00443000
TM VMPSTAT,VMV370R USER HAVE ECMODE OPTION ? @V213135 00444000
BZ SETNTERR NO - GIVE ERROR MESSAGE @V213135 00445000
BAL R9,EXECONF SET PAGEX ON / OFF @V213135 00446000
OI VMPSTAT,VMPAGEX @V213135 00447000
NI VMPSTAT,255-VMPAGEX @V213135 00448000
SPACE 00449000
EJECT 00450000
***** 00451000
* 00452000
* SET PFNN COMMAND 00453000
* 00454000
***** 00455000
SPACE 00456000
SETPF CLI SAVEWRK2+4,C' ' IS IT BEGGER THAN 4 CHARS? @V326538 00457000
BNE CFS026 YUP, TOO BAD @V326538 00458000
LA R0,2 ASSUME A LENGTH OF 2 @V326538 00459000
CLI SAVEWRK2+3,C' ' 2 CHARACTERS IN PF NUMBER? @V326538 00460000
BNE SETADD YES, BR. @V326538 00461000
CLI SAVEWRK2+2,C' ' MUST HAVE AT LEAST 1 CHAR @V326538 00462000
BE CFS026 NOTHING THERE, TOO BAD. @V326538 00463000
LA R0,1 SET FOR 1 CHAR OF PF DATA @V326538 00464000
SETADD LA R1,SAVEWRK2+2 ADDRESS OF THE NUMBER @V326538 00465000
CALL DMKCVTDB CONVERT WHATEVER IT IS @V326538 00466000
BNZ CFS026 GARBAGE IN, GARBAGE OUT @V326538 00467000
C R1,=F'24' CAN'T BE BIGGER THAN 24 HRC029DK 00468490
BH CFS026 BUT IT IS... @V326538 00469000
C R1,=F'1' CAN'T BE LESS THAN 1 EITHER @V326538 00470000
BL CFS026 BUT IT IS... @V326538 00471000
L R4,VMPFUNC GET FUNCTION TABLE @V326538 00472000
LTR R4,R4 IS THERE ONE ?? @V200730 00473000
BNZ SETPFD YES, CONT @V200730 00474000
LR R2,R1 SAVE PF NUMBER @V200730 00475000
LA R0,24 SIZE OF TABLE HRC029DK 00476490
CALL DMKFREE GET TABLE BUFFER @V200730 00477000
ST R1,VMPFUNC SAVE ADDRESS @V200730 00478000
XC 0(24*8,R1),0(R1) CLEAR HRC029DK 00479490
LR R4,R1 TABLE ADDRESS @V200730 00480000
LR R1,R2 PF NUMBER @V200730 00481000
SETPFD SLL R1,3 NUMBER TIMES 8 @V200730 00482000
S R1,F8 MINUS EIGHT FOR INDEX @V200730 00483000
AR R4,R1 R4 AT TABLE ENTRY FOR PFNN @V200730 00484000
LM R0,R1,SAVEWRK7 GET ADDR AND COUNT @V200730 00485000
STM R0,R1,BUFNXT RESET POINTERS @V200730 00486000
CALL DMKSCNFD RESCAN FOR PARM @V200730 00487000
BNZ SETPFZ NONE, TEST FOR NULL @V200730 00488000
LR R3,R0 SIZE @V200730 00489000
BCTR R3,R0 MINUS 1 @V200730 00490000
CL R0,F3 IS IT LESS THAN 3 CHARS ?? @V200730 00491000
BL IMMDEF YES, CANT BE AN OPTION @V200730 00492000
EX R3,CLCIMM IS IT IMMED ?? @V200730 00493000
BE SETIMM YES @V200730 00494000
EX R3,CLCDEL IS IT DELAYED ?? @V200730 00495000
BE SETDEL YES @V200730 00496000
IMMDEF MVI SAVEWRK1+1,X'00' DEFAULT DELAYED @V200730 00497000
B SETPFO SET FUNCTION @V200730 00498000
SPACE 00499000
SETPFZ L R1,BUFCNT GET DATA COUNT @V200730 00500000
LTR R1,R1 ANY DATA LEFT IN BUFFER ?? @V200730 00501000
BZ SETPFNL NO, SET FUNCTION TO NULL @V200730 00502000
SETPFO L R1,4(R4) GET OLD FUNCTION IF ANY @V200730 00503000
LTR R1,R1 IS THERE ONE ?? @V200730 00504000
BZ SETPFK NO, CONT @V200730 00505000
SR R0,R0 CLEAR @V200730 00506000
IC R0,1(R4) GET BUFFER SIZE @V200730 00507000
CALL DMKFRET FRET OLD FUNCTION @V200730 00508000
SETPFK L R0,SAVEWRK8 GET NEW SIZE @V200730 00509000
A R0,F7 ROUND TO DBL WORD @V200730 00510000
SRL R0,3 SIZE IN DBL WORDS @V200730 00511000
CALL DMKFREE GET NEW BUFFER @V200730 00512000
STC R0,1(R4) SAVE NEW SIZE @V200730 00513000
ST R1,4(R4) SAVE BUFFER ADDRESS @V200730 00514000
LM R2,R3,SAVEWRK7 GET COUNT AND ADDR @V200730 00515000
CLI 0(R2),C' ' IS NEXT CHAR A BLANK ?? @V200730 00516000
BNE TABTEST NO, CHECK IF SET PF TAB @V60A6B6 00517000
LA R2,1(R2) SKIP OVER FIRST BLANK @V200730 00518000
BCTR R3,R0 DECREMENT COUNT @V200730 00519000
LTR R3,R3 ANY DATA ? @VA02991 00520000
BNP SETPFNL NOPE -- IT'S NULL @VA02991 00521000
SPACE 00522000
TABTEST CLC 0(4,R2),=C'TAB ' TRYING TO DEFINE THE TABS ? @V60A6B6 00523000
BNE SETCNT IF NOT, SKIP TO CHECK DATA COUNT @V60A6B6 00524000
LR R10,R1 SAVE TAB DATA BUFFER ADDRESS @V60A6B6 00525000
LA R5,4(,R1) POINT TO START OF TAB DATA AREA @V60A6B6 00526000
LR R6,R5 SAVE THE STARTING ADDRESS HERE @V60A6B6 00527000
TABSCAN CALL DMKSCNFD CHECK FOR ANY MORE INPUT FOR TAB 00528000
BNZ TABSORT ALL DONE, GO SORT THE VALID TABS @V60A6B6 00529000
CALL DMKCVTDB CONVERT INPUT FIELD TO BINARY 00530000
BNZ TABSCAN BAD INPUT - JUST FORGET IT. @V60A6B6 00531000
C R1,F2 IS NUMBER ONE OR LESS ? @V60A6B6 00532000
BL TABSCAN IF SO, JUST FORGET ABOUT IT. @V60A6B6 00533000
C R1,=F'136' NUMBER BIGGER THAN INPUT AREA ? @V60A6B6 00534000
BH TABSCAN YES, TRY THE NEXT ONE. @V60A6B6 00535000
BCTR R1,0 CHANGE TO ZERO BASE DISPLACEMENT @V60A6B6 00536000
STC R1,0(,R5) SAVE IN TAB DATA FIELD @V60A6B6 00537000
LA R5,1(,R5) POINT TO NEXT SPOT IN TAB AREA @V60A6B6 00538000
B TABSCAN GO BACK TO SEE IF MORE TABS LEFT @V60A6B6 00539000
EJECT 00540000
TABSORT LR R8,R5 GET END OF TAB DATA PLUS ONE @V60A6B6 00541000
BCTR R8,0 BACK UP TO POINT TO END OF TABS @V60A6B6 00542000
SR R6,R8 WAS MORE THAN 1 TAB ENTERED? @V60A6B6 00543000
BNM TABCNT IF NOT, JUST SET COUNT. @V60A6B6 00544000
LA R7,4(,R10) ADDRESS START OF TAB DATA FIELD @V60A6B6 00545000
TABNEXT IC R6,0(,R7) LOAD THE VALUE OF THE TAB DATA @V60A6B6 00546000
LA R3,1(,R7) POINT TO NEXT BYTE FOR COMPARE @V60A6B6 00547000
LR R2,R7 INITIALIZE LOW TAB POINTER @V60A6B6 00548000
TABLOOP CLM R6,B'0001',0(R3) IS CURRENT TAB THE LOWEST ? @V60A6B6 00549000
BL TABUPDT YES, GO UPDATE AND CONTINUE SORT @V60A6B6 00550000
BE TABMOVE IF EQUAL, MUST REPLACE NEXT @V60A6B6 00551000
IC R6,0(,R3) GET NEW LOWEST TAB VALUE @V60A6B6 00552000
LR R2,R3 SAVE ADDRESS OF LOWEST TAB @V60A6B6 00553000
TABUPDT LA R3,1(,R3) ADDRESS NEXT TAB DATA BYTE @V60A6B6 00554000
CR R3,R5 BEYOND THE TAB DATA FIELD YET ? @V60A6B6 00555000
BL TABLOOP NO, KEEP SEARCHING FOR LOW TAB. @V60A6B6 00556000
SPACE 00557000
IC R1,0(,R7) LOAD VALUE OF CURRENT TAB BYTE @V60A6B6 00558000
STC R6,0(,R7) SAVE THE LOWEST TAB VALUE HERE @V60A6B6 00559000
STC R1,0(,R2) PUT CURRENT TAB DATA ELSEWHERE @V60A6B6 00560000
LA R7,1(,R7) INCREMENT CURRENT TAB POINTER @V60A6B6 00561000
CR R7,R8 AT THE END OF THE TAB FIELD ? @V60A6B6 00562000
BL TABNEXT NO, STILL MORE SORTING TO DO. @V60A6B6 00563000
TABCKS CLI 0(R8),XFF WAS ANY DUPLICATION FOUND ? @V60A6B6 00564000
BNE TABCNT NO, GO TO COMPUTE SIZE OF AREA @V60A6B6 00565000
BCT R8,TABCKS BACK UP ONE AND CONTINUE CHECKS @V60A6B6 00566000
TABCNT LA R8,1(,R8) MUST ADD FOR TOTAL TAB COUNT @V60A6B6 00567000
SLR R8,R10 COMPUTE SIZE OF TAB DATA FIELD @V60A6B6 00568000
STH R8,2(,R4) AND SAVE AS THE PF DATA COUNT @V60A6B6 00569000
MVC 0(4,R10),=C'TAB ' PUT TAB HEADER IN DATA AREA @V60A6B6 00570000
B SETFLG FINISHED WITH PF TAB @V60A6B6 00571000
SPACE 00572000
TABMOVE MVI 0(R3),XFF REPLACE DUPLICATE WITH FLAG BYTE @V60A6B6 00573000
B TABUPDT AND RETURN TO CONTINUE THE SORT @V60A6B6 00574000
SPACE 00575000
XFF EQU X'FF' @V60A6B6 00576000
SPACE 2 00577000
SETCNT STH R3,2(R4) SAVE DATA COUNT @V200730 00578000
BCTR R3,R0 DECREMENT FOR EXECUTE @V200730 00579000
EX R3,MVCBUF MOVE DATA TO BUFFER @V200730 00580000
SETFLG MVC 0(1,R4),SAVEWRK1+1 SET FLAG IMM OR DELAY @V200730 00581000
B PFSCAN SCAN FOR ALL NULLS @V200730 00582000
SPACE 00583000
MVCBUF MVC 0(*-*,R1),0(R2) EXECUTED BUFFER MOVE @V200730 00584000
CLCIMM CLC 0(*-*,R1),=CL6'IMMED ' EX COMPARE @V200730 00585000
CLCDEL CLC 0(*-*,R1),=CL8'DELAYED ' EX COMPARE @V200730 00586000
SPACE 00587000
SETIMM MVI SAVEWRK1+1,X'80' IMMED EXECUTION FLAG @V200730 00588000
B SETARG CONT @V200730 00589000
SETDEL MVI SAVEWRK1+1,X'00' DELAYED FLAG @V200730 00590000
SETARG LM R0,R1,BUFNXT GET COUNT AND ADDR @V200730 00591000
STM R0,R1,SAVEWRK7 SAVE FOR SET @V200730 00592000
LTR R1,R1 ANY DATA LEFT IN BUFFER ?? @V200730 00593000
BZ SETFLG NO, JUST SET FLAG @V200730 00594000
B SETPFO YES, TEST FOR OLD FUNC @V200730 00595000
SPACE 00596000
SETPFNL L R1,4(R4) GET BUFFER ADDRESS @V200730 00597000
LTR R1,R1 IS THERE ONE ?? @V200730 00598000
BZ PFSCAN NO, SCAN FOR ALL NULL @V200730 00599000
SR R0,R0 CLEAR @V200730 00600000
IC R0,1(R4) GET BUFFER SIZE @V200730 00601000
CALL DMKFRET FRET OLD BUFFER @V200730 00602000
SR R0,R0 CLEAR @V200730 00603000
ST R0,0(R4) CLEAR TABLE ENTRY @V200730 00604000
ST R0,4(R4) .. @V200730 00605000
PFSCAN L R1,VMPFUNC START AT TOP OF TABLE @V200730 00606000
LA R0,24 12 ENTRIES IN TABLE HRC029DK 00607490
PFTST L R2,4(R1) GET BUFFER ADDRESS @V200730 00608000
LTR R2,R2 IS THERE ONE ?? @V200730 00609000
BNZ PFRTN YES, RETURN @V200730 00610000
LA R1,8(R1) NEXT ENTRY @V200730 00611000
BCT R0,PFTST TEST NEXT ENTRY @V200730 00612000
L R1,VMPFUNC ALL WERE NULL @V200730 00613000
LA R0,24 SIZE OF TABLE HRC029DK 00614490
CALL DMKFRET ALL GONE @V200730 00615000
SR R0,R0 CLEAR @V200730 00616000
ST R0,VMPFUNC NO MORE FUNCTIONS @V200730 00617000
PFRTN SR R0,R0 CLEAR @V200730 00618000
ST R0,BUFCNT CLEAR DATA COUNT @V200730 00619000
B SETCOMP ALL DONE @V200730 00620000
EJECT 00621000
***** 00622000
* 00623000
* SET TIMER COMMAND 00624000
* 00625000
***** 00626000
SPACE 00627000
SETIMER EQU * 00628000
LA R7,SETREAL SET RETURN IF NOT ON/OFF @V200820 00629000
LR R3,R7 SET GR3 NON-ZERO FOR 'ON' @V200820 00630000
LA R8,CHEKREAL SET RETURN FOR ON @V200820 00631000
LA R6,SETCOMP RET. ADDR IF 'MICHKTMR' IS USED @V3M4026 00632000
BAL R10,TSTONOFF GO TEST FOR ON/OFF 00633000
SR R3,R3 SET UP FOR 'OFF' 00634000
B CHEKREAL GO CHECK IF REAL 'ON' 00635000
SPACE 00636000
SETREAL CL R4,F3 MUST BE FOUR CHARACTERS @V200820 00637000
BNE BADONOFF NOPE - ERROR MESSAGE @V200820 00638000
CLC SAVEWRK5(4),=C'REAL' SPELLED RIGHT ? @V200820 00639000
BNE BADONOFF NO -- ERROR MESSAGE @V200820 00640000
TM VMTLEVEL,VMRON REAL TIMER ALREADY ON ???? 00641000
BO MICHKTMR CHECK VIRT. TIMER ASSIST OPTION @V3M4026 00642000
LA R0,TRQBSIZE SIZE OF TIMER BLOK 00643000
CALL DMKFREE GET THE BLOK 00644000
USING TRQBLOK,R1 00645000
ST R1,VMTRQBLK ADDRESS OF BLOK TO VMBLOK 00646000
XC TRQBLOK(TRQBSIZE*8),TRQBLOK ZERO BLOK 00647000
ST R11,TRQBUSER VMBLOK ADDRESS TO TIMER BLOK 00648000
MVC TRQBIRA,=A(DMKSCH80) IRA ADDRESS TO TIMER BLOK 00649000
NI VMTLEVEL,255-(VMTON+VMSTMPI) TURN OFF FLAGS @V200820 00650000
OI VMTLEVEL,VMRON REAL TIMER RUNNING @V200820 00651000
B MICHKTMR TEST IF VIRT. TIMER ASSIST AVAIL @V3M4026 00652000
CHEKREAL TM VMTLEVEL,VMRON IS REAL ACTIVE ???? 00653000
BZ SETTON1 BRANCH IF NOT 00654000
L R1,VMTRQBLK ADDRESS OF TIMER BLOK 00655000
TM VMTLEVEL,VMSTMPI TIMER BLOK QUE'D ????? 00656000
BZ FRETQB BRANCH IF NOT 00657000
CALL DMKSCHRT DEQ BLOK 00658000
FRETQB LA R0,TRQBSIZE SIZE OF BLOK 00659000
CALL DMKFRET RETURN BLOK TO STORAGE 00660000
SR R1,R1 . . . 00661000
ST R1,VMTRQBLK ZERO TIMER BLOK POINTER IN VMBLOK 00662000
SETTON1 EQU * ADJUST VMTLEVEL FLAGS @V200820 00663000
NI VMTLEVEL,255-(VMRON+VMTON+VMSTMPI) TURN OFF @V200820 00664000
NI VMMCR6,X'FF'-VMMVTMR RESET VIRT. TIMER FLAG @V386198 00665000
ICM R15,B'0111',VMMADDR GET ADDRESS OF MICBLOK @V3M4037 00666000
BZ SETTON2 CAN'T ZERO MICVTMR IF NO MICBLOK @V3M4037 00667000
XC MICVTMR-MICBLOK(4,R15),MICVTMR-MICBLOK(R15) @V3M4037 00668000
SETTON2 EQU * @V3M4037 00669000
LTR R3,R3 SHOULD IT BE 'ON' ? @V200820 00670000
BZ SETCOMP NO -- ALL DONE @V200820 00671000
OI VMTLEVEL,VMTON INTERVAL TIMER RUNNING @V200820 00672000
B MICHKTMR GO TEST IF TIMER ASSIST USABLE. @V3M4026 00673000
DROP R1 @V200820 00674000
EJECT 00675000
***** 00676000
* 00677000
* SET EMSG COMMAND 00678000
* 00679000
***** 00680000
SPACE 00681000
SETERROR EQU * 00682000
LA R7,SETERCOD SET UP RETURN IF CODE WAS SPEC. 00683000
LA R8,SETERRON SET UP RETURN IF ON WAS SPEC. 00684000
BAL R10,TSTONOFF GO TEST FOR ON OFF PARM 00685000
NI VMMLEVEL,255-(VMMCODE+VMMTEXT) SET RCEIVE ERRORS OFF 00686000
B SETCOMP 00687000
SPACE 00688000
SETERCOD CL R4,F3 RIGHT LENGTH 00689000
BNE BADONOFF NOPE @V200820 00690000
CLC SAVEWRK5(4),=C'CODE' IS IT 'CODE' ? @V200820 00691000
BNE TESTTEXT NO - GO TEST FOR TEXT 00692000
OI VMMLEVEL,VMMCODE TURN ON CODE BIT 00693000
NI VMMLEVEL,255-VMMTEXT TURN OFF TEXT BIT 00694000
B SETCOMP 00695000
SPACE 00696000
TESTTEXT EQU * TRY 'SET EMSG TEXT' @V200820 00697000
CLC SAVEWRK5(4),=C'TEXT' IS THAT CORRECT ? @V200820 00698000
BNE BADONOFF NO -- ERROR MESSAGE @V200820 00699000
OI VMMLEVEL,VMMTEXT TURN ON TEXT BIT 00700000
NI VMMLEVEL,255-VMMCODE TURN OFF CODE 00701000
B SETCOMP RETURN 00702000
SPACE 00703000
SETERRON OI VMMLEVEL,VMMTEXT+VMMCODE TURN ON RECEIVE ERROR MESSAGE 00704000
B SETCOMP 00705000
EJECT 00706000
***** 00707000
* 00708000
* SET ISAM, AUTOPOLL, RUN, LINEDIT, ACNT, WNG, MSG, IMSG 00709000
* 00710000
***** 00711000
SPACE 00712000
SETISAM BAL R9,EXECONF SET ISAM CHECKING @V2B4320 00713000
OI VMPSTAT,VMISAM ON @V2B4320 00714000
NI VMPSTAT,255-VMISAM OFF @V2B4320 00715000
SPACE 00716000
SETAUTO BAL R9,EXECONF SET AUTOPOLL CHECKING @V386298 00717000
OI VMFSTAT,VMFAUTO ON @V386298 00718000
NI VMFSTAT,X'FF'-VMFAUTO OFF @V386298 00719000
SPACE 1 @V386298 00720000
SETRUN BAL R9,EXECONF SET CFRUN MODE @V2B4320 00721000
OI VMOSTAT,VMCFRUN ON @V2B4320 00722000
NI VMOSTAT,255-VMCFRUN OFF @V2B4320 00723000
SPACE 00724000
SETLINE BAL R9,EXECONF SET INPUT LINE EDITING @V2B4320 00725000
OI VMMLEVEL,VMMLINED ON @V2B4320 00726000
NI VMMLEVEL,255-VMMLINED OFF @V2B4320 00727000
SPACE 00728000
SETACNT BAL R9,EXECONF SET ACCOUNTING MESSAGES @V2B4320 00729000
OI VMMLEVEL,VMMACCON ON @V2B4320 00730000
NI VMMLEVEL,255-VMMACCON OFF @V2B4320 00731000
SPACE 00732000
SETWNG BAL R9,EXECONF SET WARNING MESSAGES @V2B4320 00733000
OI VMMLEVEL,VMWNGON ON @V2B4320 00734000
NI VMMLEVEL,255-VMWNGON OFF @V2B4320 00735000
SPACE 00736000
SETMSG BAL R9,EXECONF SET USER MESSAGES @V2B4320 00737000
OI VMMLEVEL,VMMSGON ON @V2B4320 00738000
NI VMMLEVEL,255-VMMSGON OFF @V2B4320 00739000
SPACE 00740000
SETIMSG BAL R9,EXECONF SET USER INFO MESSAGES @V2B4320 00741000
OI VMMLVL2,VMMIMSG ON @V2B4320 00742000
NI VMMLVL2,255-VMMIMSG OFF @V2B4320 00743000
SPACE 00744000
EXECONF EQU * TEST FOR ON OR OFF (SINGLE BIT) @V200820 00745000
SLR R7,R7 NOTHING ELSE IS VALID @V200820 00746000
LA R8,EXECSON RETURN IF 'ON' SPECIFIED @V200820 00747000
BAL R10,TSTONOFF GO TEST @V200820 00748000
EX 0,4(0,R9) TURN OFF WHATEVER IT IS @V200820 00749000
B SETCOMP @V200820 00750000
SPACE 00751000
EXECSON EX 0,0(0,R9) TURN ON WHATEVER IT IS @V200820 00752000
B SETCOMP @V200820 00753000
EJECT 00754000
***** 00755000
* 00756000
* SET ECMODE COMMAND 00757000
* 00758000
***** 00759000
SPACE 00760000
SETECMD EQU * SET ECMODE ON / OFF @V2B4320 00761000
SR R7,R7 ONLY TWO VALID PARAMETERS @V2B4320 00762000
LA R8,SETECON RETURN IF 'ON' @V2B4320 00763000
BAL R10,TSTONOFF TEST FOR 'ON' OR 'OFF' @V2B4320 00764000
CALL DMKCFPRR RESET THE VIRTUAL MACHINE FIRST @V2B4320 00765000
TM VMPSTAT,VMV370R IS ECMODE ENABLED NOW ? @V2B4320 00766000
BZ SETCOMP NO -- ALL DONE @V2B4320 00767000
L R10,VMECEXT GR10 = ADDRESS OF THE ECBLOK @V2B4320 00768000
USING ECBLOK,R10 . . . @V2B4320 00769000
LA R4,EXTCPTRQ POINT TO THE CPU TIMER TRQBLOK @V2B4320 00770000
BAL R8,FRETRQB RELEASE THE TRQBLOK STORAGE @V2B4320 00771000
LA R4,EXTCCTRQ POINT TO THE CLOCK COMPARATOR BLK@V2B4320 00772000
BAL R8,FRETRQB RELEASE THE TRQBLOK STORAGE @V2B4320 00773000
LA R0,EXTSIZE SIZE OF THE ECBLOK ITSELF @V2B4320 00774000
LR R1,R10 . . . @V2B4320 00775000
CALL DMKFRET RELEASE THE ECBLOK @V2B4320 00776000
NI VMPSTAT,255-VMV370R ECMODE NOT ALLOWED @V2B4320 00777000
OI VMMCR6,VMM360 DISABLE ASSISTED EC MODE OPS @VA04064 00778000
LA R1,X'00E0' RESET VALUE FOR C-REG 0 @V2B4320 00779000
ST R1,VMVCR0 SET AND CLEAR ECBLOK POINTER @V2B4320 00780000
ICM R1,7,VMMICRO+1 IS THERE A MICBLOK ACTIVE ? @V2B4320 00781000
BZ SETCOMP NO -- ALL DONE HERE @V2B4320 00782000
LA R2,VMVCR0 POINT TO VIRTUAL C-REG 0 @V2B4320 00783000
ST R2,MICCREG-MICBLOK(,R1) . . . @V2B4320 00784000
B SETCOMP @V2B4320 00785000
SPACE 00786000
FRETRQB EQU * RELEASE A TRQBLOK @V2B4320 00787000
ICM R1,15,0(R4) LOAD AND TEST FOR THE BLOCK @V2B4320 00788000
BZR R8 NOT THERE - FORGET IT @V2B4320 00789000
LA R0,TRQBSIZE SIZE IN DOUBLE-WORDS @V2B4320 00790000
CALL DMKFRET RELEASE THE FREE STORAGE @V2B4320 00791000
SLR R1,R1 @V2B4320 00792000
ST R1,0(0,R4) CLEAR THE POINTER FIELD @V2B4320 00793000
BR R8 RETURN @V2B4320 00794000
SPACE 00795000
SETECON EQU * ENABLE ECMODE FOR THIS V.M. @V2B4320 00796000
CALL DMKCFPRR RESET THE VIRTUAL MACHINE FIRST @V2B4320 00797000
TM VMPSTAT,VMV370R IS ECMODE ALREADY ALLOWED ? @V2B4320 00798000
BO SETCOMP YES - COMMAND COMPLETE @V2B4320 00799000
CALL DMKBLDEC BUILD AND INTIALIZE THE ECBLOK @V2B4320 00800000
NI VMMCR6,X'FF'-VMM360 ENABLE ASSISTED EC MODE OPS @VA04064 00801000
SR R1,R1 CLEAR A WORK REGISTER @V2B4320 00802000
ICM R1,7,VMMICRO+1 IS THERE AN ACTIVE MICBLOK ?@V2B4320 00803000
BZ SETCOMP NO -- COMMAND COMPLETE @V2B4320 00804000
L R2,VMECEXT POINTER TO THE ECBLOK C-REGS @V2B4320 00805000
ST R2,MICCREG-MICBLOK(,R1) . . . @V2B4320 00806000
B SETCOMP @V2B4320 00807000
EJECT 00808000
***** 00809000
* 00810000
* SET NOTRANS COMMAND 00811000
* 00812000
***** 00813000
SPACE 00814000
SETNTRAN EQU * 00815000
AIF (NOT &VIRREAL).V1 00816000
CL R11,AVMREAL AUTHORIZED USER ???? 00817000
BNE SETNTERR NOPE - SEND ERROR MESSAGE 00818000
SLR R7,R7 ONLY ON/OFF VALID 00819000
LA R8,SETNTRON SET UP FOR ON 00820000
BAL R10,TSTONOFF GO TEST ARGUMENT 00821000
NI VMPSTAT,X'FF'-VMNOTRAN RESET NOTRAN FLAG 00822000
MVC TRMSGA,=CL8'RESTORED' SET MSG 00823000
TRMSGS LA R0,28 MSG SIZE 00824000
LA R1,TRMSG MSG DATA 00825000
CALL DMKQCNWT,PARM=NORET SEND RESPONSE @V326538 00826000
B SETCOMP DONE @V326538 00827000
SPACE 00828000
SETNTRON OI VMPSTAT,VMNOTRAN SET TRANS FLAG 00829000
MVC TRMSGA,=CL8'BYPASSED' SET MSG 00830000
B TRMSGS SEND MSG 00831000
SPACE 00832000
TRMSG DC CL20'I/O CCW TRANSLATION ' 00833000
TRMSGA DC CL8' ' 00834000
.V1 ANOP 00835000
SETNTERR EQU * 00836000
LA R0,1(,R3) LENGTH 00837000
LA R1,SAVEWRK2 AND ADDRESS 00838000
B CFS003 OF BAD ARGUMENT 00839000
SPACE 3 00840000
TSTONOFF EQU * 00841000
TM SAVEWRK1,NARGTWO ANY SECOND ARGUMENT 00842000
BO CFS026 BAD NEWS 00843000
CLC SAVEWRK5(3),=C'ON ' WAS 'ON' SPECIFIED 00844000
BCR 8,R8 YES, TAKE BRANCH ON R8 00845000
CLC SAVEWRK5(4),=C'OFF ' 'OFF' SPECIFIED ??? 00846000
BCR 8,R10 BRANCH IF YES 00847000
LTR R7,R7 ANYTHING ELSE LEGAL ? 00848000
BCR 7,R7 YES - RETURN TO SUBROUTINE @VM08567 00849000
SPACE 00850000
BADONOFF LA R1,SAVEWRK5 ARGUMENT ADDRESS 00851000
LA R0,1(,R4) LENGTH 00852000
B CFS003 SEND ERROR MESSAGE 00853000
EJECT 00854000
***** 00854010
* 00854020
* SET PRIV C ON|OFF COMMAND 00854030
* 00854040
***** 00854050
SPACE 1 HRC018DK 00854060
SETPRIV TM SAVEWRK1,NARGTWO CLASS SPECIFIED? HRC018DK 00854070
BO CFS026 NO. HRC018DK 00854080
LR R2,R0 SAVE ACROSS CALL TO SCNFD HRC018DK 00854090
MVC SAVEWRK2(8),BLANKS INITIALIZE BLANK HRC018DK 00854100
MVC SAVEWRK2(8),SAVEWRK5 SAVE CLASSES HERE HRC018DK 00854110
MVC SAVEWRK5(8),BLANKS INITIALIZE BLANK HRC018DK 00854120
CALL DMKSCNFD GET NEXT PARM HRC018DK 00854130
BNZ CFS026 ERROR IF NONE GIVEN HRC018DK 00854140
LR R4,R0 GET LENGTH IN GPR4 HRC018DK 00854150
BCTR R4,0 DECREMENT FOR EXECUTE HRC018DK 00854160
EX R4,MOVEARG2 ON|OFF TO SAVEWRK5 HRC018DK 00854170
LA R1,SAVEWRK2 ADDR CLASS FOR GETCLASS ROUTINE HRC018DK 00854180
LR R0,R2 AND LENGTH HRC018DK 00854190
SR R7,R7 INDICATE ON|OFF ONLY HRC018DK 00854200
LA R8,SETCLON HERE TO TURN ON HRC018DK 00854210
BAL R10,TSTONOFF RETURN TO NEXT FOR TURN OFF HRC018DK 00854220
SETCLOFF BAL R10,GETCLASS GO GET A CLASS HRC018DK 00854230
X R3,F255 SET UP FOR AND HRC018DK 00854240
EX R3,PRIVOFF TURN THIS ONE OFF HRC018DK 00854250
BCT R0,SETCLOFF DO THEM ALL HRC018DK 00854260
B SETCOMP DONE FOR NOW. HRC018DK 00854270
SETCLON BAL R10,GETCLASS GO GET A CLASS HRC018DK 00854280
EX R3,PRIVON TURN THIS ONE ON HRC018DK 00854290
BCT R0,SETCLON DO ANOTHER HRC018DK 00854300
B SETCOMP ALL DONE HRC018DK 00854310
SPACE , HRC018DK 00854320
GETCLASS SR R2,R2 GET THE PRIV CLASS HRC018DK 00854330
IC R2,0(R1) GET A PRIV CLASS HRC018DK 00854340
SH R2,=X'00C0' IS IT GT A X'C0'? HRC018DK 00854350
BNP BADPRIV NO... HRC018DK 00854360
CL R2,F8 IS IT GREATER THAN "H"? HRC018DK 00854370
BH BADPRIV NO... HRC018DK 00854380
L R3,F256 CONVERT TO CLASS CODE. HRC018DK 00854390
SRL R3,0(R2) HRC018DK 00854400
EX R3,TESTPRIV DOES USER REALLY HAVE THIS PRIV? HRC018DK 00854410
BNO BADPRIV NO... SHOOT HIM DOWN. HRC018DK 00854420
LA R1,1(,R1) POSSIBLE NEXT PARM HRC018DK 00854430
BR R10 RETURN TO CALLER HRC018DK 00854440
BADPRIV LA R1,0(,R1) ADDRESS BAD PRIV HRC018DK 00854450
LA R0,1(,R0) RE-ADJUST LENGTH HRC018DK 00854460
B CFS003 REMAINING CLASSES INVALID HRC018DK 00854470
SPACE , HRC018DK 00854480
PRIVON OI VMCLEVEL,X'00' EXECUTED OR HRC018DK 00854490
PRIVOFF NI VMCLEVEL,X'00' EXECUTED AND HRC018DK 00854500
TESTPRIV TM VMHRCPRV,X'00' EXECUTED TEST HRC018DK 00854510
EJECT , HRC018DK 00854520
***** 00855000
* 00856000
* SET ASSIST COMMAND 00857000
* 00858000
***** 00859000
SPACE 00860000
SETASST EQU * @V326538 00861000
MVC SAVEWRK1+1(1),CPSTAT2 SAVEWRK1+1 WILL CONTAIN @V4M0134 00862000
TM APSTAT1,APUOPER A SYSTEM-WIDE DESCRIPTION OF @V4M0134 00863000
BZ ASSTSUMD VM ASSIST FOR ALL PROCESSORS @V4M0134 00864000
L R15,PREFIXB POINT TO OTHER PSA AND FORM @V4M0134 00865000
OC SAVEWRK1+1(1),CPSTAT2-PSA(R15) LOGICAL SUM @V4M0134 00866000
ASSTSUMD EQU * @V4M0134 00867000
L R1,VMMICRO GET VMA CONTROL BLOCK @V326538 00868000
LA R1,0(R1) CLEAR FLAGS @V201530 00869000
LA R10,MICOFF RETURN IF 'OFF' SPECIFIED @V200820 00870000
LA R8,MICON ON RETURN @V201530 00871000
LA R6,MICLAST EXIT ADDRESS FROM 'MICHKTMR' @V3M4026 00872000
BAL R7,TSTONOFF TEST FOR ON/OFF/OTHER @V200820 00873000
SPACE 00874000
ASTSVC CLC SAVEWRK5(4),=CL4'SVC ' IS IT SVC ?? @V201530 00875000
BE MICSVC YES, DO IT @V201530 00876000
CLC SAVEWRK5(6),=CL6'NOSVC ' IS IT NOSVC ?? @V201530 00877000
BE MICNOSVC YES, DO IT @V201530 00878000
CLC SAVEWRK5(4),=CL4'TMR ' IS IT TMR ?? @V3M4026 00879000
BE MICTMR YES, DO IT @V3M4026 00880000
CLC SAVEWRK5(4),=CL6'NOTMR ' IS IT NOTMR ?? @V3M4026 00881000
BE MICNOTMR YES, DO IT @V3M4026 00882000
LR R4,R5 LENGTH-1 IN R4 FOR "BADONOFF" RTN@VM08617 00883000
B BADONOFF ERROR ARG @V201530 00884000
SPACE 1 00885000
MICSVC EQU * CHECK ASSIST AVAILABILITY @V200820 00886000
TM SAVEWRK1+1,CPMICAVL ANY PROCESSOR HAVE ASSIST @V4M0134 00887000
BNO CFS184 NO, SEND ERROR MESSAGE @V4M0134 00888000
OI VMESTAT,VMMICSVC USER WANTS MICRO TO DO SVCS @V201537 00889000
L R15,VMADSTOP IS AN ADSTOP IN EFFECT? @V201537 00890000
LTR R15,R15 @V201537 00891000
BNE MICLAST YES - SKIP SETTING VMMCR6 FLAG @V3M4026 00892000
NI VMMCR6,X'FF'-VMMSVC NO, SET CR6: MICRO DO SVCS @V201537 00893000
B MICLAST CHECK FOR OTHER OPTION @V3M4026 00894000
SPACE 1 00895000
MICNOSVC NI VMESTAT,X'FF'-VMMICSVC USER WANTS CP DO SVCS @V201537 00896000
OI VMMCR6,VMMSVC SET CR6 TO INDICATE CP HANDL SVCS@V201537 00897000
B MICLAST CHECK IF OTHER OPTIONS PRESENT @V3M4026 00898000
SPACE 00899000
MICTMR TM SAVEWRK1+1,CPMICAVL+CPASTAVL TIMER AVAILABLE@V4M0134 00900000
BNO CFS187 IF NOT, SEND ERROR MESSAGE @V3M4026 00901000
OI VMFSTAT,VMFVTMR USER WANTS VIRT. TIMER ASSIST @V3M4026 00902000
B MICHKTMR TEST IF TIMER ASSIST CAN BE USED @V3M4026 00903000
SPACE 00904000
MICNOTMR NI VMFSTAT,X'FF'-VMFVTMR USER WANTS CP RUN TIMER @V3M4026 00905000
NI VMMCR6,X'FF'-VMMVTMR CLEAR ASSIST ENABLE FLAG @V3M4026 00906000
ICM R15,B'0111',VMMADDR DOES MICBLOK STILL EXIST? @V3M4037 00907000
BZ MICLAST CAN'T ZERO MICVTMR IF NO MICBLOK @V3M4037 00908000
XC MICVTMR-MICBLOK(4,R15),MICVTMR-MICBLOK(R15) @V3M4037 00909000
B MICLAST CHECK FOR OTHER SET ASSIST OPTS. @V3M4037 00910000
EJECT 00911000
MICON EQU * SET ASSIST ON SPECIFIED @V200820 00912000
TM SAVEWRK1+1,CPMICAVL ANY PROCESSOR HAVE ASSIST @V4M0134 00913000
BNO CFS184 NO, SEND ERROR MESSAGE @V4M0134 00914000
OI VMMCR6,VMMFE TURN ON ASSIST @VA03090 00915000
LTR R1,R1 IS VM ASSIST ALREADY SET ON ? @V3M4026 00916000
BNZ MICHKTMR YES, THEN SKIP BUILDING MICBLOK @V3M4026 00917000
SPACE 00918000
LA R0,MICSIZE GET STORAGE FOR MICBLOK @V201537 00919000
CALL DMKFREE @V201537 00920000
USING MICBLOK,R1 @V201537 00921000
STCM R1,B'0111',VMMADDR SET ADDRESS OF MICBLOK @V201537 00922000
XC MICBLOK(MICSIZE*8),MICBLOK ZERO MICBLOK SPACE @V3M4026 00923000
LA R15,VMPSW GET ADDRESS OF VIRTUAL PSW @V201537 00924000
ST R15,MICVPSW PUT IN MICBLOK @V201537 00925000
LA R15,TEMPSAVE GET ADDR OF WORKSPACE FOR MICRO @V201537 00926000
ST R15,MICWORK PUT IN MICBLOK @V201537 00927000
MVC MICRSEG,VMSEG PUT SEG TABLE PTR IN MICBLOK @V201537 00928000
L R15,PREFIXA POINT TO ABSOLUTE PSA @VA14280 00929000
MVC MICEVMA,PSAEVMA-PSA(R15) COPY EVMA CONTROLS @VA14280 00929500
LA R15,VMVCR0 POINT TO BC-MODE CREG0 @V200820 00930000
TM VMPSTAT,VMV370R DOES V. MACH. HAVE EC OPTION @V201537 00931000
BZ *+8 NO -- GR15 IS CORRECT @V200820 00932000
L R15,0(0,R15) POINT TO START OF ECBLOK @V200820 00933000
ST R15,MICCREG PUT IN MICBLOK @V201537 00934000
SPACE 00935000
MICHKTMR EQU * TEST IF TIMER ASSIST CAN BE USED @V3M4035 00936000
* R6 = EXIT ADDRESS, R11 -> VMBLOK @V3M4035 00937000
TM VMFSTAT,VMFVTMR DOES USER WANT IT ANYWAY ? @V3M4026 00938000
BZR R6 NO, EXIT. @V3M4026 00939000
ICM R1,B'0111',VMMADDR CURRENTLY USING VM ASSIST? @V3M4026 00940000
BZR R6 NO, THEN CAN'T USE TIMER ASSIST @V3M4026 00941000
TM VMTLEVEL,VMRON+VMTON USING AN INTERVAL TIMER? @V3M4026 00942000
BZR R6 NO, WHY BOTHER WITH TIMER ASSIST @V3M4026 00943000
TM VMTRCTL,VMTREX TRACE EXTERNALS IS INCOMPATIBLE @V3M4026 00944000
BOR R6 AND TIMER ASSIST CAN'T BE USED @V3M4026 00945000
* IF PASSED ALL TESTS, DO SET UP 00946000
OI VMMCR6,VMMVTMR 1ST, ENABLE VIRTUAL TIMER ASSIST @V3M4026 00947000
LCTL C1,C1,VMSEG NOW, GET CORRECT ADDRESS SPACE @V3M4026 00948000
LRA R15,TIMER-PSA IS THE VIRTUAL LOC. 80 RESIDENT? @V3M4026 00949000
BZ STMCVTMR YES, POINT TO IT FOR UPDATING @V3M4035 00950000
LA R15,VMTIMER ELSE USE VMBLOK VALUE @V3M4026 00951000
STMCVTMR ST R15,MICVTMR SAVE IN MICBLOK @V3M4035 00952000
BR R6 TIMER ASSIST ALL SET UP, EXIT @V3M4026 00953000
DROP R1 @V201537 00954000
EJECT 00955000
MICOFF LTR R1,R1 MICBLOK EXIST? @V201537 00956000
BE MICLAST NO. ALREADY OFF, SO JUST EXIT @V201537 00957000
LA R0,MICSIZE GET MICBLOK SIZE @V201537 00958000
CALL DMKFRET RELEASE MICBLOK STORAGE @V201537 00959000
NI VMMCR6,X'FF'-(VMMFE+VMMVTMR) RESET ENABLE BITS @V386198 00960000
SR R8,R8 @V201537 00961000
STCM R8,B'0111',VMMADDR ZERO OUT MICBLOK POINTER @V201537 00962000
* BUT LEAVE FLAG BYTE AS IS 00963000
SPACE 1 00964000
MICLAST CALL DMKSCNFD SCAN FOR ANOTHER ARGUMENT @V201537 00965000
BNZ EXASSIST ALL DONE IF NONE FOUND @V4M0134 00966000
MVC SAVEWRK5(8),BLANKS BLANK OUT WORK AREA @V201537 00967000
LR R5,R0 LENGTH OF PARM TO R5 @V201537 00968000
C R5,F8 PARM MORE THAN 8 CHARS? @V201537 00969000
BH CFS026 BRANCH IF MORE THAN 8 @V201537 00970000
BCTR R5,0 REDUCE FOR EX @V201537 00971000
EX R5,MOVEARG2 MOVE PARM TO SAVEWRK5 @V201537 00972000
B ASTSVC GO CHECK FOR OTHER OPTIONS @V3M4026 00973000
SPACE 1 @V4M0134 00974000
EXASSIST EQU * SEE ABOUT MESSAGES FOR USER @V4M0134 00975000
TM VMMCR6,VMMFE DOES USER HAVE VM ASSIST ON? @V4M0134 00976000
BNO SETCOMP NO -- NO MESSAGES @V4M0134 00977000
TM VMAFF,VMAFFON IF USER HAS PROCESSOR AFFINITY@V4M0134 00978000
BO AFFVMA GIVE MESSAGES FOR THAT PROC @V4M0134 00979000
TM SAVEWRK1+1,CPMICON ELSE IF NO PROCESSOR HAS VM @V4M0134 00980000
BNO CFS183 ASSIST ON, GIVE 'NOT ACTIVE' @V4M0134 00981000
B SETCOMP @V4M0134 00982000
SPACE 1 @V4M0134 00983000
AFFVMA SR R15,R15 POINT TO OUR PSA @V4M0134 00984000
CLC VMAFF,LPUADDR+1 AFFINITY TO US? @V4M0134 00985000
BE *+8 YES @V4M0134 00986000
L R15,PREFIXB NO, POINT TO OTHER PSA @V4M0134 00987000
TM CPSTAT2-PSA(R15),CPMICAVL+CPMICON ASSIST STATUS@V4M0134 00988000
BO SETCOMP NO MSG IF UP AND RUNNING @V4M0134 00989000
BM CFS183 MUST BE AVAIL, NOT OPERATING @V4M0134 00990000
* VM ASSIST IS NOT AVAILABLE ON THE AFFINITY PROCESSOR @V4M0134 00991000
LH R1,IPUADDR-PSA(R15) CONVERT PROCESSOR ADDRESS @V4M0134 00992000
CALL DMKCVTBH @V4M0134 00993000
MVC SAVEWRK2(9),OPT184 OPTIONAL PART OF MSG @V4M0134 00994000
STCM R1,B'0011',SAVEWRK4+1 PROCESSOR ADDR @V4M0134 00995000
LA R0,11 LENGTH OF OPTIONAL PART @V4M0134 00996000
LA R1,SAVEWRK2 WHERE IT'S AT @V4M0134 00997000
LA R2,184 MESSAGE NUMBER @V4M0134 00998000
B CALLERM SEND MSG ABOUT NON-AVAIL @V4M0134 00999000
EJECT 01000000
***** 01001000
* 01002000
* SET SMSG ON|OFF 01003000
* 01004000
***** 01005000
SPACE 01006000
SETSMSG EQU * SET SPECIAL MESSAGE OPTION @V60C2B8 01007000
TM SAVEWRK1,NARGTWO WAS 2ND ARGUMENT SPECIFIED? @V60C2B8 01008000
BO CFS026 NO - OPERAND MISSING @V60C2B8 01009000
SPACE 01010000
SLR R7,R7 ONLY ON OR OFF VALID @V60C2B8 01011000
LA R8,SETSPMON RETURN IF ON SPECIFIED @V60C2B8 01012000
BAL R10,TSTONOFF GO TEST OPTION @V60C2B8 01013000
SPACE 01014000
XC SAVEWRK6(1),FFS REVERSE BITS IN OPTION @V60C2B8 01015000
NC VMSPMFLG,SAVEWRK6 TURN OFF FLAG @V60C2B8 01016000
B SETCOMP ALL DONE @V60C2B8 01017000
SPACE 01018000
SETSPMON OC VMSPMFLG,SAVEWRK6 TURN ON SMSG FLAG @V60C2B8 01019000
B SETCOMP ALL DONE @V60C2B8 01020000
EJECT 01021000
***** @V4075A0 01022000
* @V4075A0 01023000
* SET AFFINITY ON|OFF CLASS G @V4075A0 01024000
* <USERID> ON|OFF|XX CLASS A @V4075A0 01025000
* @V4075A0 01026000
* @V4075A0 01027000
* NOTES: R6 IS USED TO HOLD THE PROCESSOR ADDR 01028000
* SAVEWRK2 IS USED FOR THE TARGET USER'S ID 01029000
* 01030000
***** @V4075A0 01031000
SPACE 2 01032000
SETAFF EQU * @V4075A0 01033000
MVC SAVEWRK2(8),VMUSER DEFAULT USERID = US @V4075A0 01034000
TM SAVEWRK1,NARGTWO IS THERE A 2ND OPERAND? @V4075A0 01035000
BO SETAFFON NO -> DEFAULT = ON, UID=US @V4075A0 01036000
LA R10,SETAFFOF @V4075A0 01037000
LA R8,SETAFFON @V4075A0 01038000
BAL R7,TSTONOFF WHO WILL RETURN IF NOT ON|OFF @V4075A0 01039000
* A NUMERIC PROCESSOR ADDRESS IS VALID FOR CLASS A USERS 01040000
TM VMCLEVEL,VMCLASSA THIS PATH IS NOT @V4075A0 01041000
BZ CFS026 FOR THE COMMON MAN, GIVE HIM ERR MSG@V4075A0 01042000
* LA R0,1(R4) R0 STILL HAS LENGTH OF 2ND ARG @V4075A0 01043000
LA R1,SAVEWRK5 POINT TO 2ND ARG FOR CONVERTER @V4075A0 01044000
CALL DMKCVTDB @V4075A0 01045000
B AFFUID CHECK IF USER ID SPEC'D @VA08267 01046000
CHKNUMBA EQU * 01047000
C R1,F63 MAX ADDR (NOT CPUID) WE SUPPORT @V4075A0 01048000
BH CFS026 YOU ASKED FOR TOO MUCH, SORRY @V4075A0 01049000
LA R6,VMAFFON(R1) TURN ON THE VMAFFON BIT @V4075A0 01050000
SPACE 1 01051000
CMPADDR CH R6,LPUADDR OUR PROC ADDR REQUESTED @V4075A0 01052000
BNE OTHRAD NO @V4075A0 01053000
TM APSTAT1,APUOPER @V4075A0 01054000
BO STPRAD IN AP MODE, SET AFFINITY @V4075A0 01055000
SPACE 1 @V4075A0 01056000
CFS189 LA R2,189 SYSTEM NOT IN ATTACHED PROCESSOR MOD@V4075A0 01057000
B NOVAR SET UP REST OF PARMS FOR ERMSG @V4075A0 01058000
SPACE 1 @V4075A0 01059000
OTHRAD TM APSTAT1,APUOPER IS THERE ANOTHER PROCESSOR? @V4075A0 01060000
BZ CFS188 NON, WE DON'T HAVE WHAT HE WANT@V4075A0 01061000
CH R6,LPUADDRX OTHER PROC ADDR @V4075A0 01062000
BNE CFS188 WE DON'T HAVE WHAT HE WANTS. @V4075A0 01063000
SPACE 1 @V4075A0 01064000
STPRAD EQU * NOW FIND TARGET USER'S VMBLOK@V4075A0 01065000
LA R0,8 @V4075A0 01066000
LA R1,SAVEWRK2 @V4075A0 01067000
CALL DMKSCNAU @V4075A0 01068000
BNZ CFS045 NOT THERE @V4075A0 01069000
STC R6,VMAFF-VMBLOK(R1) SET AFFINITY @V4075A0 01070000
B SETCOMP @V4075A0 01071000
SPACE 3 @V4075A0 01072000
AFFUID EQU * IS A USERID SPECIFIED @V4075A0 01073000
MVC SAVEWRK2(8),SAVEWRK5 SAVE PARM AS USERID @V4075A0 01074000
CALL DMKSCNFD LOOK FOR MORE PARMS @V4075A0 01075000
BNZ SETAFFON NONE, DEFAULT IS TO SET ON @V4075A0 01076000
C R0,F8 MAX LENGTH OF COMMAND PARM @V4075A0 01077000
BH CFS026 USER INPUT ERROR @V4075A0 01078000
MVC SAVEWRK5(8),BLANKS NO LEFTOVERS FROM LAST ARG@V4075A0 01079000
LR R15,R0 MOVE PARM LENGTH TO A USEFUL REG@V4075A0 01080000
BCTR R15,0 DECREMENT FOR EXECUTE INSTR @V4075A0 01081000
EX R15,MOVEARG2 TO SAVEWRK5 FOR TSTONOFF @V4075A0 01082000
BAL R7,TSTONOFF RETURN REGS STILL VALID R8, R10 @V4075A0 01083000
CALL DMKCVTDB @V4075A0 01084000
BNZ CFS026 ONLY NUMERIC VALID AT THIS POINT@V4075A0 01085000
B CHKNUMBA @V4075A0 01086000
SPACE 1 01087000
SETAFFOF DS 0H @VA07492 01088000
SR R6,R6 SET AFFINITY OFF @VA07492 01089000
B STPRAD @V4075A0 01090000
SPACE 1 @V4075A0 01091000
SETAFFON EQU * @V4075A0 01092000
* GET USER'S DIRECTORY BLOCK & SET AFFINITY FROM UMACAFF @V4075A0 01093000
LA R0,UDBFSIZE SPACE FOR DMKUDR @V4075A0 01094000
CALL DMKFREE @V4075A0 01095000
LR R2,R1 DMKUDR LIKES HIS BUFFER POINTER IN R2 @V4075A0 01096000
LA R1,SAVEWRK2 POINT TO APPROPRIATE USERID @V4075A0 01097000
LA R0,8 @V4075A0 01098000
CALL DMKUDRFU FIND ITS DIRECTORY ENTRY @V4075A0 01099000
BC 4,CFS053 USER NOT FOUND IN DIRECTORY @V4075A0 01100000
BC 1,CFS052 OTHER DIRECTORY PROBS @V4075A0 01101000
USING UDIRBLOK,R2 @V4075A0 01102000
LA R1,UDIRDISP @V4075A0 01103000
USING UDBFBLOK,R2 OVERLAY UDIRBLOK, THAT'S O.K@V4075A0 01104000
MVC UDBFVADD(8),ZEROES 0-OUT LAST 8 BYTES FOR UDR @V4075A0 01105000
CALL DMKUDRMD GET THE MACHINE BLOCK ENTRY FROM DIR@V4075A0 01106000
BNZ CFS052 CAN'T READ THE DIRECTORY @V4075A0 01107000
USING UMACBLOK,R2 @V4075A0 01108000
SR R6,R6 @V4075A0 01109000
IC R6,UMACAFF THAT'S THE BYTE WE WANT @V4075A0 01110000
CALL DMKUDRRV RELEASE DIRECTORY PAGE @V4075A0 01111000
LA R0,UDBFSIZE AND FREE STORAGE WE USED @V4075A0 01112000
LR R1,R2 @V4075A0 01113000
CALL DMKFRET @V4075A0 01114000
LTR R6,R6 USER HAVE AFFINITY IN DIRECTORY? @V4075A0 01115000
BNZ CMPADDR GO SET IT, ELSE ... @V4075A0 01116000
SPACE 2 @V4075A0 01117000
CFS190 LA R2,190 NO AFFINITY SPECIFIED IN THE DIRECTO@V4075A0 01118000
B NOVAR SET UP REST OF PARMS FOR ERMSG @V4075A0 01119000
SPACE 1 @V4075A0 01120000
CFS052 LA R2,52 ERROR IN CP DIRECTORY @V4075A0 01121000
B NOVAR SET UP REST OF PARMS FOR ERMSG @V4075A0 01122000
SPACE 1 01123000
CFS188 LA R2,188 SPECIFIED PROCESSOR NOT AVAILABLE @V4075A0 01124000
B NOVAR SET UP REST OF PARMS FOR ERMSG @V4075A0 01125000
SPACE 1 @V4075A0 01126000
CFS045 LA R2,45 $ NOT LOGGED ON @@V4075A0 01127000
B CFS053U TELL WHO $ IS @V4075A0 01128000
SPACE 1 01129000
CFS053 LA R2,53 $ NOT IN CP DIRECTORY @V4057A0 01130000
CFS053U LA R1,SAVEWRK2 $ NOW UNMASKED @V4075A0 01131000
LA R0,8 @V4075A0 01132000
B CALLERM @V4075A0 01133000
EJECT 01134000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01135000
* SET CPUID BBBBBB COMMAND * 01136000
* * 01137000
* THE 'BBBBBB' CPU SERIAL IS CONVERTED FROM HEXADECIMAL TO BINARY * 01138000
* AND THE RESULT STORED IN THE VMBLOK. THIS CPU SERIAL WILL BECOME * 01139000
* PART OF THE CPUID STORED IN RESPONSE TO A 'STIDP' INSTRUCTION. * 01140000
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 01141000
SPACE 2 01142000
SETCPUID EQU * @V407466 01143000
TM SAVEWRK1,NARGTWO ANY SECOND ARGUMENT @V407466 01144000
BO CFS026 BAD NEWS @V407466 01145000
C R0,=F'6' BBBBBB > 6 ? @V407466 01146000
BH CFS026 INVALID OPERAND @V407466 01147000
CALL DMKCVTHB CONVERT TO BINARY @V407466 01148000
BNZ CFS026 DOES NOT PASS VALIDITY CHECK @V407466 01149000
STCM R1,B'0111',VMCPUID STORE IN VMBLOK @V407466 01150000
B SETCOMP EXIT @V407466 01151000
***** 01152000
* 01153000
* ERROR MESSAGES 01154000
* 01155000
***** 01156000
SPACE 01157000
CFS003 LA R2,3 ERROR CODE 01158000
B CALLERM ... 01159000
SPACE 01160000
CFS026 LA R2,26 ERROR CODE 01161000
B NOVAR ... 01162000
SPACE 1 01163000
CFS183 LA R2,183 ERROR CODE FOR 'NOT ACTIVE' @V4M0134 01164000
B NOVAR @V4M0134 01165000
SPACE 1 @V4M0134 01166000
CFS184 LA R2,184 ERROR CODE FOR 'NOT AVAILABLE' @V4M0134 01167000
B NOVAR @V4M0134 01168000
SPACE 01169000
CFS187 LA R2,187 ERROR CODE TIMER ASSIST NOT AVL. @V3M4026 01170000
SPACE 01171000
NOVAR SLR R1,R1 ZERO PARM REG 01172000
SPACE 01173000
CALLERM ICM R0,14,MODID+3 INSERT MODULE IDENTITY 01174000
CALL DMKERMSG SEND MESSAGE 01175000
* 01176000
* ERMSG WILL RETURN TO DMKCFM INSTEAD OF HERE 01177000
* 01178000
EJECT 01179000
F63 DC F'63' @V4075A0 01180000
OPT184 DC C' ON PROC ' @V4M0134 01181000
LTORG 01182000
EJECT 01183000
PSA , @V306638 01184000
COPY CONBUF @V306638 01185000
COPY EQU @V306638 01186000
COPY MICBLOK @V306638 01187000
COPY SAVE @V306638 01188000
SYSLOCS , @V306638 01189000
COPY TIMER @V306638 01190000
COPY VMBLOK @V306638 01191000
COPY UDIRECT @V4075A0 01192000
EJECT 01193000
* EQUATES FOR CLASSES 01194000
* 01195000
A EQU VMCLASSA 01196000
B EQU VMCLASSB 01197000
C EQU VMCLASSC 01198000
D EQU VMCLASSD 01199000
E EQU VMCLASSE 01200000
F EQU VMCLASSF 01201000
G EQU VMCLASSG 01202000
END DMKCFS 01203000