CDS TITLE 'DMKCDS (CP) VM/370 - RELEASE 6' 00001000 ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000 *. 00003000 * MODULE NAME - 00004000 * 00005000 * DMKCDS 00006000 * 00007000 * FUNCTION - 00008000 * EXECUTES THE STORE AND STCP COMMANDS. 00009000 * 00010000 * ATTRIBUTES - 00011000 * REENTRANT, PAGEABLE,CALLED VIA SVC 00012000 * 00013000 * ENTRY POINTS - 00014000 * DMKCDSTO - STORE DATA INTO VIRTUAL STORAGE. 00015000 * DMKCDSCP - STORE DATA INTO REAL STORAGE. 00016000 * 00017000 * ENTRY CONDITIONS - 00018000 * GPR9 - ADDRESS OF THE COMMAND LINE BUFFER. 00019000 * GPR11- ADDRESS OF THE USERS VMBLOK. 00020000 * GPR12 - ADDRESS OF THE ENTRY POINT. 00021000 * GPR13 - ADDRESS OF THE STANDARD SAVE AREA. 00022000 * 00023000 * EXIT CONDITIONS - 00024000 * NORMAL - 00025000 * GPR2 = 0 00026000 * 00027000 * ERROR - 00028000 * GPR2 = ERROR MESSAGE CODE NUMBER. 00029000 * 00030000 * CALLS TO OTHER ROUTINES - 00031000 * DMKSCNFD - LOCATE THE NEXT ARGUMENT IN THE COMMAND LINE BUFFER 00032000 * DMKCVTBH - CONVERT A BINARY NUMBER TO HEXADECIMAL 00033000 * DMKCVTDB - TO CONVERT A DECIMAL NUMBER TO BINARY 00034000 * DMKCVTHB - TO CONVERT A HEXADECIMAL NUMBER TO BINARY 00035000 * DMKVATAB - TO MAINTAIN SHADOW PAGE AND SEGMENT TABLES 00036000 * DMKVATMD - TO ALLOCATE AND INITIALIZE SHADOW TABLES 00037000 * DMKPSASC - TO CHECK IF STORE IS BEING MADE INTO A SHARED PAGE 00038000 * DMKPSACC - TO VERIFY IF THE SHARED PAGE WAS CHANGED BY RUNUSER 00039000 * DMKATSCF - TO UNSHARE A NAMED SYSTEM FOR THIS USER 00040000 * DMKPAGIO - TO WRITE OUT A SHARED PAGE TO BACK-UP STORAGE 00041000 * DMKVMASH - TO SCAN/UNSHARE A NAMED SYSTEM FROM RUNUSER 00042000 * DMKVATBC - TO RELEASE SHADOW PAGE ANDSEGMENT TABLE 00043000 * DMKQCNWT - TO SEND MESSAGE TO THE TERMINAL 00044000 * DMKPTRAN - TO BRING USER PAGE INTO STORAGE 00045000 * DMKERMSG - TO SEND ERROR MESSAGES TO THE TERMINAL. 00046000 * DMKTRCPB - TO PUT BACK OLD USER INSTRUCTIONS (IF TRACING) 00047000 * DMKTRCIT - TO SET NEW "SVC B2" FOR TRACING INSTRUCTIONS 00048000 * DMKPGTPG - ALLOCATE A NEW SLOT FOR A CHANGED SHARED PAGE 00048100 * 00049000 * TABLES/WORKAREAS - 00050000 * ECBLOK 00051000 * 00052000 * REGISTER USAGE - 00053000 * GPR0 - FIELD LENGTH REGISTER 00054000 * GPR1 - ADDRESS OF ARGUMENT IN COMMAND LINE BUFFER 00055000 * GPR2 - PARAMETER REGISTER FOR CALLED ROUTINES 00056000 * GPR3 - VIRTUAL STORAGE ADDRESS FOR STORE FUNCTION 00057000 * GPR4 - WORK REGISTER 00058000 * GPR5 - WORK REGISTER 00059000 * GPR6 - WORK REGISTER 00060000 * GPR7 - WORK REGISTER 00061000 * GPR8 - BAL REGISTER 00062000 * GPR9 - ADDRESS OF THE COMMAND LINE BUFFER 00063000 * GPR10- WORK REGISTER 00064000 * GPR11- ADDRESS OF VMBLOK 00065000 * GPR12- BASE REGISTER FOR THIS MODULE 00066000 * GPR13- ADDRESS OF STANDARD SAVE AREA 00067000 * GPR14- LINKAGE REGISTER 00068000 * GPR15- LINKAGE REGISTER 00069000 * 00070000 * NOTES - 00071000 * NONE 00072000 * 00073000 * OPERATION - 00074000 * THE DESCRIPTION FOR THIS MODULE ARE LISTED IN SEPARATE PROLOGS 00075000 * BELOW. 00076000 * 00077000 *. 00078000 EJECT 00079000 COPY OPTIONS 00080000 COPY LOCAL 00081000 DMKCDS START 00082000 SPACE 00083000 MODID DC CL8'DMKCDS' 00084000 USING PSA,R0 00085000 USING VMBLOK,R11 00086000 USING SAVEAREA,R13 00087000 SPACE 3 00088000 EXTRN DMKERMSG 00089000 EXTRN DMKVSPRT @V200820 00090000 EXTRN DMKCVTBD,DMKCVTBH,DMKCVTDB,DMKCVTHB,DMKCVTFP 00091000 EXTRN DMKSYSRM 00092000 EXTRN DMKSCNFD 00093000 EXTRN DMKPSASC,DMKPSACC,DMKPTRWQ,DMKPAGIO @V60BC11 00094000 EXTRN DMKATSCF @V60BC11 00094500 EXTRN DMKPGTPG @V4075A0 00095100 EXTRN DMKDMPTR 00096000 EXTRN DMKVATMD,DMKVATBC,DMKVATAB 00097000 EXTRN DMKVMASH @VA07351 00097100 AIF (NOT &TRACE(6)).NTR1 00098000 EXTRN DMKTRCPB,DMKTRCIT 00099000 .NTR1 ANOP 00100000 SPACE 3 00101000 EXTRN DMKSYSAP @V4075A0 00101100 * 00102000 * EQUATES USED IN SAVEWRK1 FOR STORE FUNCTIONS 00103000 * 00104000 REALM EQU X'00' 00105000 VIRTM EQU X'80' 00106000 STORED EQU X'40' 00107000 CALTRCIT EQU X'20' 00108000 SHPGNWRT EQU X'10' @V4075A0 00108100 MPREF EQU X'08' @V4075A0 00108200 NPREF EQU X'04' @V4075A0 00108300 SHRPAGE EQU X'02' @V304735 00109000 STOBIT EQU X'01' 00110000 * 00110100 * EQUATES USED IN SAVEWRK1+3 00110200 * 00110300 STOWORD EQU X'08' @VA07033 00110400 NEEDDATA EQU X'04' INDICATE SEARCHING FOR DATA @VA07340 00110500 SPACE 2 00111000 ********************************************************************** 00112000 * SWITCH DEFINITIONS 00113000 * X'80' - 0= REAL STORAGE, 1= VIRTUAL STORAGE 00114000 * X'40' - 0= NOTHING STORED, 1= SOMETHING STORED 00115000 * X'20' - 0=NOT TRACING, 1= CALL TO DMKTRCIT NEEDED BEFORE EXIT 00116000 * X'10' - 1= CHANGED SHARED PAGE NOT WRITTEN OUT @V4075A0 00116100 * X'08' - 1= TREAT ADDRESS AS MAIN PREFIXED @V4075A0 00116200 * X'04' - 1= TREAT ADDRESS AS ATTACHED PROC PREFIXED @V4075A0 00116300 * X'02' - 0= NOT A SHARED PAGE, 1= SHARED PAGE 00117000 * X'01' - TURNED ON THROUGHOUT STORE OPERATION 00118000 ********************************************************************** 00119000 EJECT 00120000 *********************************************************************** 00121000 * * 00122000 * STCP * 00123000 * * 00124000 *********************************************************************** 00125000 *. 00126000 * SUBROUTINE NAME - 00127000 * DMKCDSCP 00128000 * 00129000 * FUNCTION - 00130000 * TO ALTER THE CONTENTS OF REAL STORAGE. 00131000 * 00132000 * COMMAND FORMAT - 00133000 * +--------+-------------------------+ 00134000 * | STCP | (M|N| )||HEXLOC HEXDATA . . .| 00135000 * | | (ML|NL|L)||HEXLOC | 00136000 * | | (MS|NS|S)||HEXLOC | 00137000 * +--------+-------------------------+ 00138000 * 00139000 * OPERATION - 00140000 * 1. SET A BIT IN SAVEWRK1 TO INDICATE THAT THIS IS A STORE 00141000 * TO REAL STORAGE. IN AN AP SYSTEM THE LETTER 'M' CAUSES THE 00142000 * ADDRESS TO BE TREATED AS SEEN THROUGH THE MAIN PROCESSOR'S 00142100 * PREFIX REGISTER. THE LETTER 'N' DESIGNATES THE ATTACHED 00142200 * PROCESSOR. OTHERWISE THE ADDRESS IS TREATED AS AN ABSOLUTE 00142300 * ADDRESS. 'N' IS VALID ONLY WHEN THE ATTACHED PROCESSOR IS 00142400 * IN OPERATION. 'M' IS VALID IF THE SYSTEM HAS BEEN GEN'D 00142500 * FOR AP. THE REST OF THE OPERATION IS DESCRIBED IN THE PRO- 00142600 * LOGUE FOR STORE. 00142700 * 00144000 * RESPONSES - 00145000 * 00146000 * STORE COMPLETE 00147000 * 00148000 * ERROR MESSAGES - 00149000 * DMKCDS004E INVALID HEXLOC - (HEXLOC) 00150000 * DMKCDS005E INVALID HEXDATA - (HEXDATA) 00151000 * DMKCDS026E OPERAND MISSING OR INVALID 00152000 * DMKCDS033E HEXLOC MISSING OR INVALID 00153000 * DMKCDS160E HEXLOC (HEXLOC) EXCEEDS STORAGE 00154000 *. 00155000 SPACE 2 00156000 DMKCDSCP RELOC STORE INTO REAL STORAGE 00157000 MVI SAVEWRK1,REALM+STOBIT REMEMBER TO STORE INTO REAL STORAG 00158000 B STONEXT CONTINUE 00159000 SPACE 20 00160000 *********************************************************************** 00161000 * * 00162000 * STORE * 00163000 * * 00164000 *********************************************************************** 00165000 *. 00166000 * SUBROUTINE NAME - 00167000 * DMKCDSTO 00168000 * 00169000 * FUNCTION - 00170000 * 00171000 * TO ALTER THE CONTENTS OF VIRTUAL STORAGE LOCATIONS, REGISTERS, 00172000 * OR PSW. 00173000 * 00174000 * COMMAND FORMAT - 00175000 * +---------+--------------------------------+ 00176000 * | STORE | HEXLOC HEXDATA . . . . | 00177000 * | | LHEXLOC | 00178000 * | ST | SHEXLOC | 00179000 * | | GREG | 00180000 * | | YREG | 00181000 * | | XREG | 00182000 * | | | 00183000 * | | PSW HEXDATA1 HEXDATA2 | 00184000 * | | | 00185000 * | | STATUS | 00186000 * +---------+--------------------------------+ 00187000 * 00188000 * OPERATION - 00189000 * 1. SET A FLAG TO INDICATE A STORE VIRTUAL REQUEST. THEN GO TO 00190000 * STEP 2 WHICH IS THE START OF THE SUBROUTINES COMMON TO BOTH 00191000 * STORE AND STCP. 00192000 * 2. SET UP RETURN REG 8 TO GO TO HEXLOC PROCESSING IN THE 00193000 * EVENT NONE OF THE OTHER TYPES OF REQUEST ARE FOUND IN THE 00194000 * COMMAND LINE. 00195000 * 3. CALL DMKSCNFD TO LOCATE THE NEXT ARGUMENT. IF NONE FOUND, 00196000 * GO TO STEP 3A. CHECK THE ARGUMENT TO DETERMINE THE TYPE 00197000 * OF REQUEST. IF ONE IS FOUND, GO TO THE APPROPRIATE 00198000 * SUBROUTINE. IF NOT RETURN ON REG 8. 00199000 * 3A. IF NO ARGUMENTS AT ALL HAVE BEEN FOUND IN THE COMMAND 00200000 * LINE, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS026 -EXIT. 00201000 * IF SOME PROCESSING HAS BEEN DONE, JUST EXIT. 00202000 * 4. STOLOC - THIS SUBROUTINE WILL PROCESS THE HEXLOC REQUESTS. 00203000 * FIRST CHECK IF ANY ADDRESS HAS BEEN SPECIFIED. IF NOT, 00204000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS033E - EXIT. 00205000 * IF THE LENGTH OF THE ARGUMENT IS OVER SIX CHARACTERS, CALL 00206000 * DMKERMSG TO SEND ERROR MESSAGE DMKCDS004E AND EXIT. 00207000 * IF LENGTH IS VALID, CALL DMKCVTHB TO CONVERT THE 00208000 * ADDRESS TO BINARY. IF CONVERT FAILS, CALL DMKERMSG TO 00209000 * SEND ERROR MESSAGE DMKCDS004E - EXIT.IF ADDRESS IS VALID, 00210000 * BAL ON REG 8 TO STEP 3 TO SCAN FOR DATA ARGUMENT. CALL 00211000 * DMKCVTHB TO CONVERT THE DATA ARGUMENT TO BINARY. IF CON- 00212000 * VERT FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS173E 00213000 * AND EXIT. IF DATA OK, GO TO STEP 4A TO GET THE REAL 00214000 * STORAGE ADDRESS FOR THE STORE. WHEN RETURN FROM STEP 4A, 00215000 * STORE THE DATA AND BUMP THE ADDRESS TO THE NEXT STORAGE 00216000 * LOCATION. THEN BAL BACK TO STEP 3 FOR MORE DATA IF ANY. 00217000 * 4A. STOLOCA - THIS SUBROUTINE SETS UP THE REAL STORAGE 00218000 * ADDRESS FOR THE STORE. A CHECK IS MADE TO DETERMINE 00219000 * IF THE REQUESTED ADDRESS EXCEEDS THE MAXIMUM STORAGE 00220000 * LOCATION (EITHER REAL OR VIRTUAL). IF IT DOES, CALL 00221000 * DMKERMSG TO SEND ERROR MESSAGE DMKCDS160 - EXIT. 00222000 * IF A REAL REQUEST, SET UP AND RETURN. IF VIRTUAL, TRANS 00223000 * IN THE REQUESTED VIRTUAL ADDRESS. IF LOCATION IS IN A 00224000 * SHARED PAGE, CALL DMKERMSG TO SEND ERROR MESSAGE 00225000 * DMKCDS161 - EXIT. IF OK, SET UP THE REAL STORAGE ADDRESS 00226000 * AND RETURN. 00227000 * IN AN AP SYSTEM WE RELOCATE ADDRESSES FOR STCP BASED UPON 00227100 * THE M/N SPECIFICATION AND WHICH PROCESSOR WE ARE EXECUTING 00227200 * ON. THE PURPOSE IS TO REACH THE PROPER PAGE GIVEN THE 00227300 * VALUES OF THE TWO PREFIX REGISTERS 00227400 * 5. STOLOS - THIS SUBROUTINE WILL PROCESS A SINGLE LOCATION 00228000 * REQUEST. FIRST CHECK IF ANY HEXLOC HAS BEEN SPECIFIED. IF 00229000 * NOT, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS033E - EXIT. 00230000 * IF LENGTH IS OVER SIX CHARACTERS, CALL DMKERMSG TO SEND 00231000 * MESSAGE DMKCDS004E - EXIT. IF OK, CALL DMKCVTHB TO CONVERT 00232000 * THE HEXLOC TO BINARY. IF THE CONVERT FAILS, CALL DMKERMSG 00233000 * TO SEND ERROR MESSAGE DMKCDS004E - EXIT. ELSE, BAL ON REG 8 00234000 * TO STEP 3 TO GET A DATA ARGUMENT. CALL DMKCVTHB TO 00235000 * CONVERT THE DATA ARGUMENT TO BINARY. IF CONVERT FAILS, CALL 00236000 * DMKERMSG TO SEND ERROR MESSAGE DMKCDS005E. IF OK, STORE THE 00237000 * DATA AND BUMP THE STORAGE ADDRESS. THEN BAL ON R8 TO 00238000 * STEP 3 TO GET MORE DATA IF ANY. 00239000 * 6. STOPSW - THIS SUBROUTINE WILL PROCESS THE STORE INTO THE 00240000 * VIRTUAL PSW. FIRST BAL ON REG 8 TO STEP 3 TO GET THE FIRST 00241000 * DATA WORD TO STORE. THEN CALL DMKCVTHB TO CONVERT THE 00242000 * DATA TO BINARY. IF THE CONVERT FAILS, CALL DMKERMSG TO 00243000 * SEND ERROR MESSAGE DMKCDS005E - EXIT. ELSE, STORE THE DATA 00244000 * INTO THE VIRTUAL PSW. THEN BAL ON REG 8 AGAIN TO STEP 3 TO 00245000 * GET THE NEXT DATA WORD IF ANY. THEN CALL DMKCVTHB TO 00246000 * CONVERT THIS WORD TO BINARY. AGAIN, IF THE CONVERT FAILS, 00247000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS005E - EXIT. 00248000 * ELSE, STORE THE DATA AND GO BACK TO STEP 2 . 00249000 * 7. STOGPR - THIS SUBROUTINE WILL PROCESS THE STORE INTO A 00250000 * VIRTUAL GENERAL PURPOSE REGISTER. FIRST CHECK THE LENGTH 00251000 * OF THE ADDRESS ARGUMENT. IF INVALID, CALL DMKERMSG TO SEND 00252000 * ERROR MESSAGE DMKCDS010E - EXIT. IF OK, CALL DMKCVTDB TO 00253000 * TRY A DECIMAL TO BINARY CONVERT. IF THIS FAILS, CALL 00254000 * DMKCVTHB TO TRY A HEX TO BINARY CONVERT. IF THIS FAILS, 00255000 * CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS010E - EXIT. 00256000 * IF EITHER CONVERT IS GOOD GO TO NEXT STEP. 00257000 * 7A. BAL ON REG 8 TO STEP 3 TO GET NEXT DATA ARGUMENT. THEN 00258000 * CHECK IF REGISTER ADDRESS IS OVER 15. IF IT IS, CALL 00259000 * DMKERMSG TO SEND ERROR MESSAGE DMKCDS163E - EXIT. IF 00260000 * OK, CALL DMKCVTHB TO CONVERT THE DATA TO BINARY. IF 00261000 * CONVERT FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE 00262000 * DMKCDS005E - EXIT. ELSE, STORE THE DATA AND BUMP THE 00263000 * REGISTER ADDRESS. REPEAT THIS STEP UNTIL EITHER RUN 00264000 * OUT OF DATA OR A DIFFERENT REQUEST TYPE IS ENCOUNTERED 00265000 * IN THE COMMAND LINE IN STEP 3. 00266000 * 8. STOFPR - THIS SUBROUTINE WILL PROCESS THE STORE INTO THE 00267000 * VIRTUAL FLOATING POINT REGISTERS. FIRST CHECK THE LENGTH 00268000 * OF THE ADDRESS ARGUMENT. IF NOT VALID, CALL DMKERMSG TO 00269000 * SEND ERROR MESSAGE DMKCDS010E - EXIT. CALL DMKCVTDB TO 00270000 * CONVERT THE ADDRESS TO BINARY. IF CONVERT FAILS, CALL 00271000 * DMKERMSG TO SEND ERROR MESSAGE DMKCDS010E - EXIT. IF OK, 00272000 * GO ON TO NEXT STEP. 00273000 * 8A. BAL ON REG 8 TO STEP 3 TO GET NEXT DATA ARGUMENT. IF 00274000 * RETURN HERE WITH DATA, CHECK IF REGISTER ADDRESS IS OVER 00275000 * SIX. IF IT IS, CALL DMKERMSG TO SEND ERROR MESSAGE 00276000 * DMKCDS163E - EXIT. IF OK, CALL DMKCVTHB TO CONVERT THE 00277000 * DATA TO BINARY. IF CONVERT FAILS, CALL DMKERMSG TO 00278000 * SEND ERROR MESSAGE DMKCDS005E - EXIT. IF OK, STORE THE 00279000 * DATA INTO THE VIRTUAL FLOATING POINT REGISTER AND BUMP 00280000 * THE REGISTER ADDRESS. REPEAT THIS STEP UNTIL RUN OUT OF 00281000 * DATA OR A DIFFERENT REQUEST IS ENCOUNTERED IN THE COMMAND 00282000 * LINE. 00283000 * 9. STOCRG - THIS SUBROUTINE WILL PROCESS THE STORE INTO 00284000 * VIRTUAL CONTROL REGISTERS. FIRST CHECK THE LENGTH OF THE 00285000 * ADDRESS ARGUMENT. IF INVALID, CALL DMKERMSG TO SEND THE 00286000 * DMKCDS010E ERROR MESSAGE. CALL DMKCVTDB TO TRY A DECIMAL 00287000 * TO BINARY CONVERT. IF THIS FAILS, CALL DMKCVTHB TO TRY A 00288000 * HEX TO BINARY CONVERT. IF THIS FAILS, CALL DMKERMSG TO 00289000 * SEND ERROR MESSAGE DMKCDS010E - EXIT. IF EITHER CONVERT IS 00290000 * GOOD, GO ON TO NEXT STEP. 00291000 * 9A. BAL ON REG 8 TO STEP 3 TO GET NEXT DATA ARGUMENT. THEN 00292000 * CHECK IF REGISTER ADDRESS IS OVER 15. IF IT IS, CALL 00293000 * DMKERMSG TO SEND ERROR MESSAGE DMKCDS163E - EXIT. IF OK, 00294000 * CALL DMKCVTHB TO CONVERT THE DATA TO BINARY. IF CONVERT 00295000 * FAILS, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS005E AND 00296000 * EXIT. IF STORING INTO CREG 0, CHECK IF THE DATA IS THE 00297000 * RESET VALUE. IF SO, CALL DMKERMSG TO SEND THE DMKCDS162W 00298000 * WARNING MESSAGE AND COMPLETE THE STORE. IF NOT THE RESET 00299000 * VALUE, CHECK FOR VALID CREG0 DATA. IF NOT VALID, CALL 00300000 * DMKERMSG TO SEND ERROR MESSAGE DMKCDS162E. IF STORING INTO 00301000 * CREG 1, CHECK THE DATA FOR VALIDITY. IF NOT VALID CREG 1 00302000 * DATA, CALL DMKERMSG TO SEND ERROR MESSAGE DMKCDS162E. IF 00303000 * EVERYTHING IS OK, STORE THE DATA INTO THE VIRTUAL CONTROL 00304000 * REGISTER AND BUMP THE REGISTER ADDRESS BY ONE. REPEAT THIS 00305000 * STEP UNTIL THE DATA ARGUMENTS ARE EXHAUSTED. 00306000 * 10. STOSTAT - THIS SUBROUTINE SIMULATES THE HARDWARE STORE 00307000 * STATUS FACILITY. FIRST CHECK TO SEE IF USER HAS ECMODE 00308000 * OPTION. IF NOT CALL DMKERMSG TO SEND DMKCDS026E ERROR 00309000 * MESSAGE. IF SO CHECK TO SEE IF USER ISSUED A 'STCP' 00310000 * TO STORE INTO REAL MAIN STORAGE. IF SO, ISSUE 00311000 * DMKCDS026E ERROR MESSAGE. IF NOT CONTINUE PROCESSING, 00312000 * TRANS IN THE USER'S PAGE ZERO AND STORE PSW AND 00313000 * PROGRAM ADDRESSABLE REGISTERS AS FOLLOWS: 00314000 * 00315000 * FIELD ADDRESS LENGTH 00316000 * (IN DEC.) IN BYTES 00317000 * ______________________________________________ 00318000 * CPU TIMER 216 8 00319000 * CLOCK COMPARATOR 224 8 00320000 * CURRENT PSW 256 8 00321000 * F-P REGISTERS 0-6 352 32 00322000 * GENERAL REGISTERS 0-15 384 64 00323000 * CONTROL REGISTERS 0-15 448 64 00324000 * 00325000 * RESPONSES - 00326000 * 00327000 * STORE COMPLETE 00328000 * 00329000 * ERROR MESSAGES - 00330000 * DMKCDS004E INVALID HEXLOC - (HEXLOC) 00331000 * DMKCDS005E INVALID HEXDATA - (HEXDATA) 00332000 * DMKCDS010E INVALID REGISTER - (REGISTER) 00333000 * DMKCDS012E INVALID PSW - (PSW) 00334000 * DMKCDS026E OPERAND MISSING OR INVALID 00335000 * DMKCDS033E HEXLOC MISSING OR INVALID 00336000 * DMKCDS160E HEXLOC (HEXLOC) EXCEEDS STORAGE 00337000 * DMKCDS161E SHARED PAGE (HEXLOC) ALTERED BY (USERID) 00338000 * DMKCDS162E INVALID ECR (X) - (HEXDATA) 00339000 * DMKCDS162W INVALID ECR (X) - (HEXDATA) 00340000 * DMKCDS163E STORE EXCEEDS MAXIMUM REGISTER 00341000 *. 00342000 SPACE 4 00343000 DMKCDSTO RELOC STORE INTO VIRT. STORAGE 00344000 MVI SAVEWRK1,VIRTM+STOBIT REMEMBER TO STORE INTO VIRT. STORA 00345000 B STONEXT 00346000 EJECT 00347000 STONEXT DS 0H START OF COMMON CODE @VA07033 00348100 MVI SAVEWRK1+3,X'00' CLEAR NEW FLAG BYTE @VA07033 00348200 LA R8,STOLOCD LOAD RETURN ADDR FOR NO TYPE CODE@VA07033 00348300 STOSCAN CALL DMKSCNFD SCAN FOR THE NEXT FIELD IN THE BUFFER 00349000 BNZ STOEXIT BRANCH IF NO MORE ARGUMENTS 00350000 TM SAVEWRK1+3,NEEDDATA WANT DATA SPECIFICALLY?? @VA07340 00350110 BOR R8 YES, DON'T SEARCH FOR KEYWORDS @VA06311 00350200 CLC 0(6,R1),=C'STATUS' IS IT STORE STATUS? 00351000 BNE NOTSTAT NO - CHECK OTHER OPTIONS 00352000 CL R0,F6 LENGTH OF SIX? 00353000 BE STOSTAT YES - GO STORE STATUS 00354000 NOTSTAT DS 0H 00355000 CLI 0(R1),C'0' IF IT'S NUMERIC, NOT TYPE-DESIGN @V4075A0 00355100 BNLR R8 SO RETURN / SKIP TEST FOR TYPE @V4075A0 00355150 CLI 0(R1),C'F' ALSO IF HEX DIGIT @V4075A0 00355200 BNHR R8 RETURN @V4075A0 00355250 NI SAVEWRK1,X'FF'-(MPREF+NPREF) RESET PREFIX FLAGS @V4075A0 00355300 CLI 0(R1),C'N' IF USER SPECIFIED M|N, @V4075A0 00355350 BH NOTMORN @V4075A0 00355400 CLI 0(R1),C'M' @V4075A0 00355450 BNL ITSMORN CHECK VALIDITY AND SET FLAGS @V4075A0 00355500 NOTMORN EQU * @V4075A0 00355550 CLI 0(R1),C'S' STORE INTO STORAGE ON A BYTE BOUNDARY ? 00356000 BE STOLOS BRANCH IF YES 00357000 CLI 0(R1),C'L' WAS 'L' SPECIFIED ??? 00358000 BE STOLOC BRANCH IF YES 00359000 TM SAVEWRK1,VIRTM IS THIS STORE INTO VIRTUAL STORAGE ? 00360000 BCR 8,R8 NO, NO OTHER TYPE CODES FOR STCP 00361000 CLI 0(R1),C'P' STORE PSW ? 00362000 BE STOPSW MAYBE, CHECK FURTHER 00363000 CLI 0(R1),C'G' STORE GENERAL PURPOSE REGISTER(S) ? 00364000 BE STOGPR BRANCH IF YES 00365000 CLI 0(R1),C'Y' STORE FLOATING POINT REGISTER(S) ? 00366000 BE STOFPR BRANCH IF YES 00367000 CLI 0(R1),C'X' STORE CONTROL REGISTER(S) ? 00368000 BE STOCRG BRANCH IF YES 00369000 BR R8 NO TYPE DESIGNATION 00370000 STOSTAT DS 0H STORE STATUS SIMULATION 00371000 TM VMPSTAT,VMV370R CHECK FOR ECMODE OPTION 00372000 BZ CDS026 NO EC, WRITE ERROR MESSAGE 00373000 TM SAVEWRK1,VIRTM WAS HE TRYING TO STCP ? 00374000 BZ CDS026 YES - DON'T LET HIM DO IT 00375000 SR R1,R1 ZERO R1 FOR TRANS 00376000 TRANS 2,1,OPT=(BRING,DEFER) GET USER PAGE ZERO 00377000 L R5,VMECEXT GET EC EXTENSION BLOK ADDRESS 00378000 USING ECBLOK,R5 ADDRESSABILITY FOR ECBLOK 00379000 MVC 216(8,R2),EXTCPTMR CPU TIMER 00380000 L R14,EXTCCTRQ GET ADDRESS OF TIMER REQ BLOK 00381000 USING TRQBLOK,R14 ADDRESSABILITY FOR TIMER BLOK 00382000 MVC 224(8,R2),TRQBVAL CLOCK COMPARATOR 00383000 MVC 256(8,R2),VMPSW PSW 00384000 MVC 352(32,R2),VMFPRS FLOATING POINT REGS 00385000 MVC 384(64,R2),VMGPRS GENERAL PURPOSE REGS 00386000 MVC 448(64,R2),EXTCR0 CONTROL REGS 00387000 DROP R5 00388000 DROP R14 00389000 OI SAVEWRK1,STORED INDICATE THAT STORE IS COMPLETE 00390000 B STONEXT SCAN FOR MORE OPERANDS @VA04212 00390100 SPACE 2 00390200 SPACE 2 00391000 ITSMORN TM SAVEWRK1,VIRTM IF IT'S VIRTUAL STORE, @V4075A0 00391100 BNZ CDS026 M,N ARE NOT ACCEPTABLE @V4075A0 00391125 L R15,=A(DMKSYSAP) IF NOT GEN'D FOR AP, @V4075A0 00391150 CLI 0(R15),C'Y' (VIA THE SYSCOR MACRO) @V4075A0 00391175 BNE CDS026 M,N NOT ACCEPTABLE @V4075A0 00391200 CLI 0(R1),C'N' @V4075A0 00391225 BE ITSN @V4075A0 00391250 OI SAVEWRK1,MPREF USER SPECIFIED 'M' @V4075A0 00391275 PASSMN STM R0,R1,SAVEWRK2 DECREMENT PARM LEN OF FIELD @V4075A0 00391300 BCT R0,NOERRA @V4075A0 00391325 LA R0,1 IF NO MORE IN FIELD, PARM IS@V4075A0 00391350 B CDS033 INVALID @V4075A0 00391375 NOERRA LA R1,1(R1) @V4075A0 00391400 STM R0,R1,SAVEWRK2 SEE IF THERE IS ANOTHER @V4075A0 00391425 B NOTMORN TYPE DESIGNATOR @V4075A0 00391450 SPACE 2 @V4075A0 00391475 ITSN TM APSTAT1,APUOPER 'N' IS NOT VALID WHEN THE @V4075A0 00391500 BNO CDS026 ATTACHED PROCESSOR NOT UP @V4075A0 00391525 OI SAVEWRK1,NPREF USER SPECIFIED 'N' @V4075A0 00391550 B PASSMN @V4075A0 00391575 SPACE 2 @V4075A0 00391600 STOEXIT TM SAVEWRK1,STORED HAS ANY DATA BEEN STORED ? 00392000 BZ CDS026 BRANCH IF NO ARGUMENTS FOUND 00393000 MSG 0,'STORE COMPLETE' 00394000 CALL DMKQCNWT,PARM=NORET 00395000 B EXIT RETURN 00396000 SPACE 00397000 EJECT 00398000 * 00399000 * STORE INTO STORAGE 00400000 * 00401000 STOLOC STM R0,R1,SAVEWRK2 SAVE ADDRESS AND LENGTH OF ARGUMENT 00402000 BCT R0,STOBMPLL SUBTRACT ONE FOR TYPE CODE 00403000 LA R0,1 BUMP BACK TO '1' FOR ERROR MSG. 00404000 B CDS033 BRANCH IF INVALID ARGUMENT 00405000 STOBMPLL LA R1,1(,R1) BUMP PAST TYPE CODE 00406000 STOLOCD STM R0,R1,SAVEWRK2 SAVE ARGUMENT LENGTH AND ADDRESS 00407000 CL R0,F6 FIELD LONGER THAN SIX CHARACTERS ??? 00408000 BH CDS004 IF IT IS -- GOT AN ERROR 00409000 CALL DMKCVTHB ... 00410000 BNZ BADADDR1 BRANCH ON INVALID HEXLOC 00411000 N R1,=XL4'FFFFFFFC' TRUNCATE TO A FULL WORD BOUNDARY 00412000 LR R3,R1 SAVE THE ADDRESS 00413000 OI SAVEWRK1+3,NEEDDATA INDICATE DATA SEARCH @VA07340 00413110 STOLOCL BAL R8,STOSCAN SCAN FOR THE DATA TO STORE 00414000 NI SAVEWRK1+3,X'FF'-NEEDDATA @VA07340 00414110 STM R0,R1,SAVEWRK8 SAVE LENGTH AND ADR. OF HEXDATA ARG 00415000 CL R0,F8 MAX OF 8 DIGITS PER WORD 00416000 BH CDS005 ERROR IF THERE ARE MORE 00417000 CALL DMKCVTHB CONVERT THE DATA TO BINARY 00418000 BNZ CDS005 BRANCH IF INVALID HEXDATA FOUND 00419000 LR R4,R1 SAVE THE DATA 00420000 OI SAVEWRK1+3,STOWORD INDICATE STORING A FULL WORD @VA07033 00420500 ALTER1 BAL R8,STOLOCA GET THE REAL STORAGE ADDRESS @V304735 00421000 NI SAVEWRK1+3,X'FF'-STOWORD @VA07033 00421500 SLR R0,R0 CLEAR FOR PROTECT KEY OF ZERO @V304735 00422000 CALL DMKPSASC CHECK FOR SHARED PAGE. @V304735 00423000 BZ NOTSHR1 NOT A SHARED PAGE @V304735 00424000 TM APSTAT1,APUOPER IF WE ARE IN AP MODE, @V4075A0 00424100 BNO NOAPSHR1 @V4075A0 00424200 TM SAVEWRK1,VIRTM STCP TO SHARED PAGES @V4075A0 00424300 BNO CDS004 GETS ERROR MESSAGES @V4075A0 00424400 NOAPSHR1 EQU * @V4075A0 00424500 OI SAVEWRK1,SHRPAGE INDICATE A SHARED PAGE @V304735 00425000 CALL DMKPSACC CHECK IF PAGE CHANGED BY RUNUSER @V304735 00426000 BZ NOTCHG1 NOT CHANGED BY RUNUSER @V304735 00427000 TM SAVEWRK1,VIRTM WAS REQUEST FOR VIRT STORAGE ? @V304735 00428000 BZ CDS161 NO - SEND ERROR MESSAGE @V304735 00429000 NOTSHR1 EQU * @V304735 00430000 NOTCHG1 EQU * @V304735 00431000 TM SAVEWRK1,SHRPAGE IS IT A SHARED PAGE ? @V304735 00432000 BZ NOTSHR2 NO @V304735 00433000 TM SAVEWRK1,VIRTM WAS REQUEST FOR REAL STORAGE ? @V304735 00434000 BZ NOTSHR2 YES - @V304735 00435000 LR R2,R3 GET VITURAL ADDRESS @VA12533 00435500 CALL DMKATSCF GIVE USER NON-SHARED SYSTEM @V60BC11 00436000 NI SAVEWRK1,X'FF'-SHRPAGE UNFLAG SHARED @V304735 00437000 B ALTER1 RE-ISSUE TRANS CALL @V304735 00438000 SPACE 1 00439000 NOTSHR2 ST R4,0(,R1) STORE 4 BYTES OF DATA @V304735 00440000 OI SAVEWRK1,STORED INDICATE DATA STORED @V304735 00441000 AL R3,F4 BUMP ADDRESS BY 4 BYTES @V304735 00442000 TM SAVEWRK1,SHRPAGE SHARED PAGE ? @V304735 00443000 BO WRTOUT1 YES - WRITE TO BACK-UP STORAGE. @V304735 00444000 TM SAVEWRK1,VIRTM REQUEST FOR VIRTUAL STORAGE ? @V304735 00445000 BO STOLOCL YES - GET NEXT ARGUMENT @V304735 00446000 WRTOUT1 BAL R8,WRTSHR WRITE DATA TO BACK-UP STORAGE @V304735 00447000 B STOLOCL PROCESS NEXT ARGUMENT @V304735 00448000 EJECT 00449000 * 00450000 * STORE DATA ON A BYTE BOUNDARY 00451000 * 00452000 STOLOS STM R0,R1,SAVEWRK2 SAVE ARGUMENT LENGTH AND ADDRESS 00453000 BCT R0,STOBMPSL SUBTRACT ONE FOR TYPE CODE 00454000 LA R0,1 BUMP BACK FOR ERR MSG 00455000 B CDS033 BRANCH ON INVALID ARGUMENT 00456000 STOBMPSL LA R1,1(,R1) BUMP PAS TTYPE CODE 00457000 STM R0,R1,SAVEWRK2 SAVE LENGTH AND ADDRESS OF ARGUMENT 00458000 C R0,F6 IS ADDRESS FIELD LONGER THAN 6 CHARS ? 00459000 BH CDS004 BRANCH ON INVALID ADDRESS 00460000 CALL DMKCVTHB CONVERT THE ADDRESS TO BINARY 00461000 BNZ BADADDR1 GBR. IF BAD 00462000 LR R3,R1 SAVE THE ADDRESS 00463000 OI SAVEWRK1+3,NEEDDATA INDICATE DATA SEARCH @VA07340 00463110 BAL R8,STOSCAN SCAN FOR THE DATA TO STORE 00464000 NI SAVEWRK1+3,X'FF'-NEEDDATA @VA07340 00464110 LR R5,R0 SAVE THE DATA LENGTH 00465000 LR R6,R1 SAVE THE DATA LOCATION 00466000 STOLOSL LA R0,2 LOAD A DATA LENGTH OF 2 00467000 LR R1,R6 LOAD THE DATA LOCATION 00468000 STM R0,R1,SAVEWRK8 SAVE IN CASE OF ERROR 00469000 CALL DMKCVTHB CONVERT 1 BYTE OF DATA TO BINARY 00470000 BNZ CDS005 INVALID HEXDATA 00471000 LR R4,R1 SAVE THE DATA 00472000 ALTER2 BAL R8,STOLOCA GET THE REAL STORAGE ADDRESS @V304735 00473000 SLR R0,R0 CLEAR FOR PROTECT KEY OF ZERO @V304735 00474000 CALL DMKPSASC CHECK FOR SHARED PAGE. @V304735 00475000 BZ NOTSHR3 NOT A SHARED PAGE @V304735 00476000 TM APSTAT1,APUOPER IF WE ARE IN AP MODE, @V4075A0 00476100 BNO NOAPSHR2 @V4075A0 00476200 TM SAVEWRK1,VIRTM STCP TO SHARED PAGES @V4075A0 00476300 BNO CDS004 GETS ERROR MESSAGES @V4075A0 00476400 NOAPSHR2 EQU * @V4075A0 00476500 OI SAVEWRK1,SHRPAGE INDICATE A SHARED PAGE @V304735 00477000 CALL DMKPSACC CHECK IF PAGE CHANGED BY RUNUSER @V304735 00478000 BZ NOTCHG3 NOT CHANGED BY RUNUSER @V304735 00479000 TM SAVEWRK1,VIRTM WAS REQUEST FOR VIRT STORAGE ? @V304735 00480000 BZ CDS161 NO - SEND ERROR MESSAGE @V304735 00481000 NOTSHR3 EQU * @V304735 00482000 NOTCHG3 EQU * @V304735 00483000 TM SAVEWRK1,SHRPAGE IS IT A SHARED PAGE ? @V304735 00484000 BZ NOTSHR4 NO @V304735 00485000 TM SAVEWRK1,VIRTM WAS REQUEST FOR REAL STORAGE ? @VA04923 00486100 BZ NOTSHR4 YES - @V304735 00487000 LR R2,R3 GET VITURAL ADDRESS @VA12533 00487500 CALL DMKATSCF GIVE USER NON-SHARED SYSTEM @V60BC11 00488000 NI SAVEWRK1,X'FF'-SHRPAGE UNFLAG SHARED @V304735 00489000 B ALTER2 RE-ISSUE TRANS CALL @V304735 00490000 SPACE 1 00491000 NOTSHR4 STC R4,0(,R1) STORE 1 BYTES OF DATA @V304735 00492000 OI SAVEWRK1,STORED INDICATE DATA STORED @V304735 00493000 S R5,F2 SUBTRACT 2 FROM LENGTH @V304735 00494000 TM SAVEWRK1,SHRPAGE CHANGING A SHARED PAGE ? @V304735 00495000 BO WRTOUT2 YES - WRITE IT TO BACK-UP STORAGE@V304735 00496000 TM SAVEWRK1,VIRTM REQUEST FOR VIRTUAL STORAGE ? @V304735 00497000 BO CHKLEN YES- CHECK REMAINING LENGTH @V304735 00498000 WRTOUT2 BAL R8,WRTSHR WRITE DATA TO BACK-UP STORAGE @V304735 00499000 CHKLEN LTR R5,R5 ANY MORE DATA LEFT TO PROCESS @V304735 00500000 BNP STONEXT EXIT IF NO MORE DATA @V304735 00501000 AL R3,F1 BUMP THE ADDRESS BY 1 @V304735 00502000 LA R6,2(,R6) POINT TO NEXT BYTE OF DATA @V304735 00503000 B STOLOSL STORE IN THE NEXT DATA BYTE @V304735 00504000 EJECT 00505000 STOLOCA TM SAVEWRK1,VIRTM IS THIS STORE INTO VIRTUAL STORAGE ? 00506000 BZ STOLOCR NO, INTO REAL STORAGE 00507000 CL R3,VMSIZE IS THIS A VALID VIRTUAL STORAGE ADDRESS ? 00508000 BNL BIGADDR NO, IT IS TOO HIGH 00509000 LR R1,R3 LOAD ADDRESS FOR TRANS MACRO 00510000 TRANS 2,1,OPT=(BRING,DEFER),ADEX=CDS164 BRING IN @V304635 00511000 * USER'S PAGE 00512000 * INTO REAL STORAGE 00513000 LR R1,R2 SAVE THE REAL ADDRESS 00514000 TM SAVEWRK1+3,STOWORD IS A FULLWORD TO BE STORED? @VA07033 00514300 BZ STOLOCAB NO @VA07033 00514600 C R3,=XL4'50' IS THIS THE ADDRESS OF THE TIMER ? 00515000 BNER R8 BRANCH IF NOT @V304735 00516000 ST R4,VMTIMER YES - ALSO SAVE IT ON VMBLOK @V304735 00517000 BR R8 RETURN REAL ADDRESS @V304735 00518000 STOLOCAB DS 0H @VA07033 00518100 C R3,=XL4'50' IS BYTE TO BE STORED IN TIMER? @VA07033 00518200 BLR R8 NO - RETURN TO CALLER @VA07033 00518300 C R3,=XL4'53' IS BYTE TO BE STORED IN TIMER? @VA07033 00518400 BHR R8 NO - RETURN TO CALLER @VA07033 00518500 STC R4,VMTIMER-X'50'(R3) UPDATE TIMER IN VMBLOK @VA07033 00518600 BR R8 @VA07033 00518700 SPACE 00519000 STOLOCR L R2,=A(DMKSYSRM) 00520000 L R2,0(,R2) LOAD THE REAL STORAGE SIZE 00521000 CLR R3,R2 IS THIS A VALID REAL STORAGE ADDRESS ? 00522000 BNL BIGADDR NO, IT IS TOO HIGH 00523000 LR R1,R3 REAL ADDRESS TO R1 FOR STORE 00524000 L R15,=A(DMKSYSAP) IF THE SYSTEM HAS THE @V4075A0 00524100 CLI 0(R15),C'Y' USER SPEC'D SYSCOR @V4075A0 00524125 BNE EQATR2R1 AP OPTION, WE CHECK AND@V4075A0 00524150 L R0,XPAGNUM @V4075A0 00524175 TM SAVEWRK1,MPREF+NPREF PERHAPS RECOMPUTE THE @V4075A0 00524200 BZ ABSPEC EFFECTIVE ADDRESS @V4075A0 00524225 TM SAVEWRK1,NPREF DID USER SAY 'M' OR 'N' @V4075A0 00524250 BO RWEN GO FIX UP FOR 'N' SPECIFIED @V4075A0 00524275 RWEM TM APSTAT1,PROCIO HE SAID 'M', ARE WE 'M' ? @V4075A0 00524300 BO EQATR2R1 YES, DO NOT RECOMPUTE ADDRES@V4075A0 00524325 PFIXCOMP NR R0,R1 GET PAGE NUMBER @V4075A0 00524350 BZ ADDPREFB OTHER PROCESSOR'S PSA. POINT 2 IT@V4075A0 00524375 C R0,PREFIXB ABSOLUTE 0 IN OTHER PROCESSOR'S @V4075A0 00524400 BNE ISITPRFA NO. GO SEE IF IT IS OUR PSA! @V4075A0 00524425 GETABS0 S R1,PREFIXB YES, POINT TO ABSOLUTE 0 VIA OUR @V4075A0 00524450 ADDPREFA A R1,PREFIXA PREFIX REGISTER @V4075A0 00524475 B EQATR2R1 @V4075A0 00524500 SPACE 2 00524525 ADDPREFB A R1,PREFIXB POINT TO OTHER PROCESSOR PSA @V4075A0 00524550 B EQATR2R1 @V4075A0 00524575 SPACE 2 00524600 RWEN TM APSTAT1,PROCIO USER SAID 'N'. ARE WE 'N' ? @V4075A0 00524625 BNO EQATR2R1 YES @V4075A0 00524650 B PFIXCOMP NO. SEE ABOUT RECOMPUTING @V4075A0 00524675 SPACE 2 00524700 ABSPEC NR R0,R1 ABSOLUTE 0 ? @V4075A0 00524725 BZ ADDPREFA YES, UNDO EFFECT OF PREFIX REG @V4075A0 00524750 ISITPRFA C R0,PREFIXA OUR PSA ? @V4075A0 00524775 BNE EQATR2R1 NO @V4075A0 00524800 SUBPREFA S R1,PREFIXA YES, UNDO OUR PREFIX REG @V4075A0 00524825 EQATR2R1 LR R2,R1 SAVE ADDRESS IN R2 ALSO @V4075A0 00524850 BR R8 RETURN REAL ADDRESS 00526000 SPACE 2 00527000 EJECT 00528000 * 00529000 * STORE PSW 00530000 * 00531000 STOPSW EQU * 00532000 LR R2,R0 LENGTH TO R2 00533000 BCTR R2,0 MINUS ONE FOR 'EX' 00534000 EX R2,PSWCOMP MAKE SURE IS PSW 00535000 BNE CDS026 BRANCH IF NO GOOD 00536000 OI SAVEWRK1+3,NEEDDATA INDICATE DATA SEARCH @VA07340 00536110 BAL R8,STOSCAN SCAN FOR DATA 00537000 NI SAVEWRK1+3,X'FF'-NEEDDATA @VA07340 00537110 STM R0,R1,SAVEWRK8 SAVE FOR POSSIBLE ERR MSG 00538000 CL R0,F8 MORE THAN EIGHT DIGITS 00539000 BH CDS005 INVALID IF IT IS 00540000 CALL DMKCVTHB CONVERT THE DATA TO BINARY 00541000 BNZ CDS005 INVALID HEXDATA 00542000 MVC SAVEWRK4(4),VMPSW+4 MAY HAVE TO PUT BACK LATER @VA04210 00542300 ST R1,SAVEWRK5 SAVE 1ST ARG IN BINARY FORM @VA04210 00542600 ST R1,VMPSW+4 STORE IN THE 2ND HALF OF THE VIRTUAL PSW 00543000 OI SAVEWRK1,STORED INDICATE DATA STORED 00544000 AIF (NOT &TRACE(6)).NTR2 00545000 BAL R8,CHKTRACE CHECK WHETHER TRACE CALLS ARE NEEDED 00546000 .NTR2 BAL R8,STOSCAN SCAN FOR THE NEXT ARGUMENT 00547000 STM R0,R1,SAVEWRK8 SAVE ADDR AND LENGTH @VA04214 00547100 MVC VMPSW+4(4),SAVEWRK4 RESTORE VMPSW TO ORIG VALUE @VA04210 00547200 CL R0,F8 ARGUMENT TOO LONG ??? 00548000 BH CDS005 YES - GO SEND ERROR MESSAGE @VA04210 00549100 CALL DMKCVTHB CONVERT 2ND ARG TO BINARY @VA04210 00550100 BNZ CDS005 BRANCH ON INVALID HEXDATA @VA04210 00551100 L R0,SAVEWRK5 RESTORE 1ST ARG IN BINARY FORM @VA04210 00552100 STM R0,R1,VMPSW ESTABLISH NEW VMPSW @VA04210 00553100 TM VMPSTAT,VMV370R ALLOWED EC MODE ??? 00554000 BZ STONOTR BRANCH IF NO 00555000 TM VMPSW+1,EXTMODE EXTENDED PSW? 00556000 BO STOPSWEX YES - CHECK IT 00557000 TM VMESTAT,VMEXTCM OUT OF EC MODE? 00558000 BZ STONEXT NO - GET THE NEXT ARGUMENT @VA04210 00559100 CALL DMKVATBC CLEAR SHADOW TABLES 00560000 NI VMESTAT,X'FF'-VMEXTCM ...AND STATUS BIT 00561000 B STONEXT GET THE NEXT ARGUMENT @VA04210 00562000 EJECT 00562500 STOPSWEX EQU * EC-MODE PSW STORED 00563000 OI VMESTAT,VMEXTCM INTO EC MODE 00564000 TM VMPSW,TRANMODE TRANSLATE MODE ALSO? 00565000 BZ STOPSWEC NO 00566000 TM VMOSTAT,VMSHR IS USER EC,TRANSLATE AND SHARED? @VA09151 00566100 BNO NOTSHR NO NOT SHARED....... @VA09151 00566200 CALL DMKVATBC YES MUST THROW AWAY SHADOW TABLES@VA09151 00566300 NOTSHR DS 0H @VA09151 00566400 CALL DMKVATMD ENTER TRANSLATE MODE 00567000 STOPSWEC EQU * CHECK "MUST BE ZERO" BITS 00568000 TM VMPSW,X'B8' ARE BITS 0 AND 2-4 ZERO ???? 00569000 BNZ STOPSWBD NO - THAT'S ILLEGAL @VA04210 00570500 TM VMPSW+2,X'C0' HOW ABOUT BITS 16, 17 ???? @VA04210 00571000 BNZ STOPSWBD NO - INVALID PSW @VA04210 00571500 CLC VMPSW+3(2),ZEROES BITS 24-39 ???? @VA04210 00572000 BE STONEXT OK - ALL TESTS PASSED @VA04210 00572500 STOPSWBD EQU * ILLEGAL PSW STORED @VA04210 00573000 CALL DMKCVTBH GET 2ND HALF IN PRT'BLE HEX FORM @VA04210 00573500 STCM R0,15,SAVEWRK4+2 STASH AWAY 00575000 STCM R1,15,SAVEWRK5+2 . . . 00576000 L R1,VMPSW LOAD BAD FIRST HALF 00577000 CALL DMKCVTBH CONVERT TO PRINTABLE FORM 00578000 STM R0,R1,SAVEWRK2 STASH IT AWAY 00579000 MVC SAVEWRK4(2),BLANKS BLANK SPACE BETWEEN FIRST & LAST 00580000 LA R0,18 LENGTH OF FIELD 00581000 LA R1,SAVEWRK2 ADDRESS OF FIELD 00582000 AIF (NOT &TRACE(6)).NTR3 00584000 NI SAVEWRK1,255-CALTRCIT DON'T TRY TO CALL DMKTRCIT 00585000 .NTR3 ANOP 00586000 B CDS012 GO SEND THE ERROR MESSAGE 00587000 SPACE 00588000 STONOTR EQU * 00589000 TM VMPSW+1,EXTMODE ASCII BIT ON? 00590000 BO STOPSWBD YES - ILLEGAL 00591000 B STONEXT GET THE NEXT ARGUMENT 00596000 SPACE 2 00597000 PSWCOMP CLC 0(0,R1),=C'PSW ' EXECUTED COMPARE 00598000 AIF (NOT &TRACE(6)).NTR4 00599000 CHKTRACE TM VMTRCTL,VMTRBRIN TRACING INSTRUCTIONS / BRANCHES ? 00600000 BCR 8,R8 NOPE - FORGET IT. 00601000 CALL DMKTRCPB PUT BACK OLD USER INSTRUCTIONS 00602000 OI SAVEWRK1,CALTRCIT SET FLAGBIT TO CALL DMKTRCIT LATER 00603000 BR R8 AND EXIT 00604000 .NTR4 ANOP 00605000 EJECT 00606000 * 00607000 * STORE GENERAL PURPOSE REGISTER(S) 00608000 * 00609000 STOGPR STM R0,R1,SAVEWRK2 SAVE ARGUMENT LENGTH AND ADDRESS 00610000 BCT R0,STOBMPGP SUBTRACT ONE FOR TYPE CODE 00611000 LA R0,1 BUMP BACK FOR ERR MSG 00612000 B CDS010 BRANCH IF NO REG. ADDRESS 00613000 STOBMPGP LA R1,1(,R1) BUMP PAST TYPE CODE 00614000 C R0,F2 IS ADDRESS FIELD LONGER THAN 2 CHARS ? 00615000 BH CDS010 INVALID REG REQUEST 00616000 CALL DMKCVTDB ASSUME DECIMAL NUMBER - TRY TO CONVERT 00617000 BZ STOGPRA BRANCH IF SUCCESSFUL CONVERSION 00618000 CALL DMKCVTHB TRY HEX TO BINARY CONVERSION 00619000 BNZ BADREG BRANCH IF ERROR IN CONVERT 00620000 STOGPRA LR R3,R1 SAVE THE REGISTER NUMBER 00621000 OI SAVEWRK1+3,NEEDDATA INDICATE DATA SEARCH @VA07340 00621110 STOGPRL BAL R8,STOSCAN SCAN FOR THE DATA TO STORE 00622000 NI SAVEWRK1+3,X'FF'-NEEDDATA @VA07340 00622110 STM R0,R1,SAVEWRK8 SAVE LEN AND ADR FOR POSSIBLE ERROR 00623000 CL R3,F15 IS THE REGISTER NUMBER GREATER THAN 15 ? 00624000 BH CDS163 BRANCH IF MAX. REG. ADDRESS EXCEEDED 00625000 CL R0,F8 MAX OF 8 DIGITS 00626000 BH CDS005 SEND ERROR MESSAGE IF THERE ARE MORE 00627000 CALL DMKCVTHB CONVERT THE DATA TO BINARY 00628000 BNZ CDS005 BR. ON INVALID HEXDATA 00629000 LR R4,R3 SAVE THE REGISTER NUMBER 00630000 SLA R4,2 CONVERT IT TO A FULL WORD DISPLACEMENT 00631000 ST R1,VMGPRS(R4) STORE THE DATA INTO THE VIRTUAL GPR 00632000 OI SAVEWRK1,STORED INDICATE DATA STORED 00633000 LA R3,1(,R3) ADD 1 TO THE REGISTER NUMBER 00634000 B STOGPRL STORE INTO THE NEXT REGISTER 00635000 EJECT 00636000 * 00637000 * STORE FLOATING POINT REGISTER(S) 00638000 * 00639000 STOFPR STM R0,R1,SAVEWRK2 SAVE ARGUMENT LENGTH AND ADDRESS 00640000 BCT R0,STOBMPFP SUBTRACT ONE FOR TYPE CODE 00641000 LA R0,1 BUMP BACK FOR ERR MSG 00642000 B CDS010 BRANCH IF NO REG ADDRESS IS FOUND 00643000 STOBMPFP LA R1,1(,R1) BIMP PAST TYPE CODE 00644000 C R0,F1 IS ADDRESS FIELD LONGER THAN 1 CHAR ? 00645000 BH CDS010 INVALID REG. REQUEST 00646000 CALL DMKCVTDB CONVERT THE REGISTER NUMBER TO BINARY 00647000 BNZ CDS010 ADDRESS DIDN'T CONVERT - TAKE BRANCH 00648000 N R1,=XL4'FFFFFFFE' TRUNCATE IT TO AN EVEN NUMBER 00649000 LR R3,R1 SAVE THE REGISTER NUMBER 00650000 OI SAVEWRK1+3,NEEDDATA INDICATE DATA SEARCH @VA07340 00650110 STOFPRL BAL R8,STOSCAN SCAN FOR THE DATA TO STORE 00651000 NI SAVEWRK1+3,X'FF'-NEEDDATA @VA07340 00651110 STM R0,R1,SAVEWRK8 SAVE FOR POSSIBLE ERROR 00652000 CL R3,F6 IS THE REGISTER NUMBER GREATER THAN 6 ? 00653000 BH CDS163 MAX. REG. ADDRESS EXCEEDED 00654000 CL R0,F16 UP TO 16 DIGITS ALLOWED FOR FPR 00655000 BH CDS005 ERROR IF HAVE MORE 00656000 MVI SAVEWRK2,X'F0' MOVE HEX ZEROES INTO WORK AREA 00657000 MVC SAVEWRK2+1(15),SAVEWRK2 ... 00658000 LR R2,R0 SAVE THE FIELD LENGTH 00659000 BCTR R2,0 SUBTRACT 1 FROM LENGTH FOR THE MVC INSTR 00660000 EX R2,MVCFPR MOVE THE DATA TO THE WORK AREA 00661000 LA R0,8 LOAD A DATA LENGTH OF 8 00662000 LA R1,SAVEWRK2 LOAD THE DATA ADDRESS 00663000 CALL DMKCVTHB CONVERT THE 1ST HALF TO BINARY 00664000 BNZ CDS005 INVALID HEXDATA FOUND IF BRANCH 00665000 LR R4,R3 SAVE THE REGISTER NUMBER 00666000 SLA R4,2 CONVERT IT TO A DOUBLE WORD DISPLACEMENT 00667000 ST R1,VMFPRS(R4) STORE IN THE 1ST HALF OF THE VIRTUAL FPR 00668000 OI SAVEWRK1,STORED INDICATD DATA STORED 00669000 LA R0,8 LOAD A DATA LENGTH OF 8 00670000 LA R1,SAVEWRK4 LOAD THE DATA ADDRESS 00671000 CALL DMKCVTHB CONVERT THE 2ND HALF TO BINARY 00672000 BNZ CDS005 INVALID HEXDATA-TAKE BRANCH 00673000 ST R1,VMFPRS+4(R4) STORE IN 2ND HALF OF THE VIRTUAL FPR 00674000 LA R3,2(,R3) ADD 2 TO THE REGISTER NUMBER 00675000 B STOFPRL STORE INTO THE NEXT REGISTER 00676000 SPACE 3 00677000 MVCFPR MVC SAVEWRK2(0),0(R1) MOVE THE DATA TO THE WORK AREA 00678000 EJECT 00679000 * 00680000 * STORE CONTROL REGISTER(S) 00681000 * 00682000 STOCRG EQU * 00683000 MVI SAVEWRK1+2,X'00' ZIP THE FLAG BYTE 00684000 STM R0,R1,SAVEWRK2 SAVE ADDRESS AND LENGTH OF ARGUMENT 00685000 BCT R0,STOBMPCR SUBTRACT ONE FOR TYPE CODE 00686000 LA R0,1 BUMP BACK FOR ERR MSG 00687000 B CDS010 NO REG ADDRESS FOUND 00688000 STOBMPCR LA R1,1(,R1) BUMP PAST TYPE CODE 00689000 C R0,F2 IS ADDRESS FIELD LONGER THAN 2 CHARS ? 00690000 BH CDS010 INVALID REG REQUEST 00691000 CALL DMKCVTDB ASSUME DECIMAL NUMBER - TRY TO CONVERT 00692000 BZ STOCRGB BRANCH IF SUCCESSFUL CONVERSION 00693000 CALL DMKCVTHB TRY HEX TO BINARY CONVERSION 00694000 BNZ BADREG REG. ADDRESS DIDN'T CONVERT 00695000 STOCRGB LR R3,R1 SAVE THE REGISTER NUMBER 00696000 OI SAVEWRK1+3,NEEDDATA INDICATE DATA SEARCH @VA07340 00696110 STOCRGL BAL R8,STOSCAN SCAN FOR THE DATA TO STORE 00697000 NI SAVEWRK1+3,X'FF'-NEEDDATA @VA07340 00697110 STM R0,R1,SAVEWRK8 SAVE FOR POSSIBLE ERROR 00698000 CL R3,F15 IS THE REGISTER NUMBER GREATER THAN 15 ? 00699000 BH CDS163 MAX. REG. ADDRESS EXCEEDED 00700000 CL R0,F8 MAX OF 8 DIGITS 00701000 BH CDS005 SEND ERROR MESSAGE IF MORE 00702000 CALL DMKCVTHB CONVERT THE DATA TO BINARY 00703000 BNZ CDS005 INVALID HEXDATA FOUND 00704000 LTR R4,R3 SAVE REGISTER NUMBER 00705000 BZ STOCRG0 CHECK DATA VALIDITY 00706000 TM VMPSTAT,VMV370R ANY OTHER C-REGS? 00707000 BZ STOCRGA NO - SKIP ALL OF THEM 00708000 C R4,F1 C-REG 1? 00709000 BE STOCRG1 YES - CHECK VALIDITY 00710000 STOCRGS EQU * STORE CONTROL REG DATA 00711000 SLA R4,2(0) CONVERT REG NO. TO FULL-WORD INDEX 00712000 L R5,VMECEXT LOAD ECBLOK BASE REGISTER 00713000 USING ECBLOK,R5 00714000 ST R1,EXTCR0(R4) STORE DATA INTO VIRTUAL CONTROL REGISTER 00715000 OI SAVEWRK1,STORED INDICATE DATA STORED 00716000 DROP R5 00717000 STOCRGA LA R3,1(,R3) ADD 1 TO THE REGISTER NUMBER 00718000 B STOCRGL STORE INTO THE NEXT REGISTER 00719000 EJECT 00720000 STOCRG0 EQU * C-REG 0 SPECIFIED 00721000 TM VMPSTAT,VMV370R C - REGS IN ECBLOK ??? 00722000 BZ STOCRGC NO - SKIP THE ERROR-CHECKING 00723000 AIF (NOT &TRACE(6)).NTR5 00724000 BAL R8,CHKTRACE CHECK WHETHER TRACE CALLS ARE NEEDED 00725000 .NTR5 ANOP 00726000 LA R8,STOCREG0 SET "RETURN REGISTER" IN CASE OF AN ERROR 00727000 CL R1,=X'000000E0' RESET VALUE ??? 00728000 BE STOCRGE YES - SEND WARNING 00729000 STCM R1,4,SAVEWRK1+1 SAVE CONTROL BYTE 00730000 TM SAVEWRK1+1,X'C0' CHECK PAGE SIZE BITS 00731000 BNM STOCRGE NO GOOD - SEND WARNING 00732000 TM SAVEWRK1+1,X'0F' MUST BE ZERO BITS OFF ??? 00733000 BNZ STOCRGE NO - SEND WARNING 00734000 STOCREG0 EQU * 00735000 OI VMESTAT,VMNEWCR0 NEW C-REG 0 00736000 B STOCRGS CONTINUE SCAN 00737000 STOCRGC EQU * BC-MODE MACHINE "ST X0" 00738000 ST R1,VMVCR0 C-REG 0 IS IN VMBLOK 00739000 OI SAVEWRK1,STORED INDICATE DATA STORED 00740000 B STOCRGL CONTINUE SCAN 00741000 SPACE 00742000 STOCRG1 EQU * C-REG 1 SPECIFIED 00743000 AIF (NOT &TRACE(6)).NTR6 00744000 BAL R8,CHKTRACE CHECK WHETHER TRACE CALLS ARE NEEDED 00745000 .NTR6 ANOP 00746000 LA R5,X'3F' CHECK LOW SIX BITS 00747000 NR R5,R1 ...MUST BE ZERO 00748000 BZ STOCREG1 IT'S OK 00749000 BAL R8,STOCRGE NO GOOD - SEND WARNING (& CONTINUE) 00750000 STOCREG1 OI VMESTAT,VMINVSEG NEW SEGMENT TABLE ORIGIN 00751000 B STOCRGS GO DO STORE 00752000 SPACE 00753000 STOCRGE EQU * SEND 'W' ERROR MESSAGE (R8 = RETURN-REGISTER) 00754000 STM R0,R2,SAVEWRK5 REMEMBER R0 THRU R2 (RESTORED LATER) 00755000 AIF (NOT &TRACE(6)).NTR7 00756000 NI SAVEWRK1,255-CALTRCIT DON'T TRY TO CALL DMKTRCIT 00757000 .NTR7 ANOP 00758000 MVC SAVEWRK2+2(2),ZEROES BINARY ZEROS TO SEP. THE FIELDS 00759000 CALL DMKCVTBH CONVERT THE HEXDATA 00760000 STM R0,R1,SAVEWRK3 STORE HEXDATA FIELD 00761000 LR R1,R4 REG NUMBER TO R1 00762000 CALL DMKCVTBH CONVERT THIS NUMBER 00763000 STH R1,SAVEWRK2 STORE REG NUMBER 00764000 LA R0,12 LENGTH OF FIELDS 00765000 LA R1,SAVEWRK2 WHERE ITS AT 00766000 STOWRNG L R2,=X'80E600A2' LOAD PARM REG FOR ERM 00767000 ICM R0,14,MODID+3 LOAD MODULE ID 00768000 CALL DMKERMSG SEND THE WARNING 00769000 LM R0,R2,SAVEWRK5 RESTORE REGISTERS FOR STORE 00770000 BR R8 RETURN TO STOCREG0 OR STOCREG1. 00771000 EJECT 00772000 BADADDR LM R0,R1,SAVEWRK2 LOAD LENGTH AND ADDRESS OF BAD ARG. 00773000 BCTR R0,0 REDUCE COUNT BY ONE 00774000 LA R1,1(,R1) SKIP PAST TYPE CODE 00775000 B CDS004 . . . 00776000 SPACE 00777000 BADADDR1 LM R0,R1,SAVEWRK2 LENGTH AND ADDRESS OF BAD ARG. 00778000 B CDS004 . . . 00779000 SPACE 00780000 BIGADDR LM R0,R1,SAVEWRK2 LOAD LENGTH AND ADDRESS OF BAD ARG. 00781000 B CDS160 . . . 00782000 SPACE 00783000 BADREG LM R0,R1,SAVEWRK2 LENGTH AND ADDRESS OF BAD ARG. 00784000 B CDS010 . . . 00785000 SPACE 00786000 CDS004 LA R2,4 ERROR CODE 00787000 B CALLERM . . . 00788000 SPACE 00789000 CDS005 LM R0,R1,SAVEWRK8 LOAD LEN AND ADR OF FIELD 00790000 LA R2,5 ERROR CODE 00791000 B CALLERM . . . 00792000 SPACE 00793000 CDS010 LA R2,10 ERROR CODE 00794000 B CALLERM . . . 00795000 SPACE 00796000 CDS012 LA R2,12 ERROR CODE 00797000 B CALLERM . . . 00798000 SPACE 00799000 CDS026 LA R2,26 ERROR CODE 00800000 B NOVAR . . . 00801000 SPACE 00802000 CDS033 LA R2,33 ERROR CODE 00803000 B NOVAR . . . 00804000 SPACE 00805000 CDS160 LA R2,160 ERROR CODE 00806000 B CALLERM . . . 00807000 SPACE 00808000 CDS161 DS 0H @VA07351 00809100 CALL DMKVMASH FLAG ALL CHANGED SHARED PAGES @VA07351 00809200 XC SAVEWRK2(20),SAVEWRK2 CLEAR AREA FOR MESSAGE @V304735 00810000 LR R1,R2 CONVERT ADDRESS TO PRINTABLE @V304735 00811000 CALL DMKCVTBH ..... @V304735 00812000 STCM R0,B'0011',SAVEWRK2 SAVE FIRST PART @V304735 00813000 STCM R1,B'1111',SAVEWRK2+2 COMPLETE FULL ADDRESS @V304735 00814000 L R15,RUNUSER GET VMBLOK FOR CURRENT RUNUSER @V304735 00815000 MVC SAVEWRK4(8),VMUSER-VMBLOK(R15) GET USERID @V304735 00816000 LA R0,16 LENGTH FOR MESSAGE WRITTER @V304735 00817000 LA R1,SAVEWRK2 AND ADDRESS OF MESSAGE @V304735 00818000 LA R2,161 AND THE MESSAGE NUMBER @V304735 00819000 B CALLERM NOW CALL THE MESSAGE WRITTER @V304735 00820000 LA R2,161 ERROR CODE 00821000 B CALLERM . . . 00822000 SPACE 00823000 CDS162 LA R2,162 ERROR CODE 00824000 B CALLERM . . . 00825000 SPACE 00826000 CDS163 LA R2,163 ERROR CODE 00827000 B NOVAR ... @V304635 00828000 SPACE 1 00829000 CDS164 LM R0,R1,SAVEWRK2 LENGTH AND ADDRESS OF FIELD @V304635 00830000 LA R2,164 ERROR = NON-ADDRESSABLE STORAGE @V304635 00831000 B CALLERM ... @V304635 00832000 SPACE 1 00833000 SPACE 00834000 NOVAR SR R1,R1 ZERO ARGUMENT REG 00835000 CALLERM ICM R0,14,MODID+3 LOAD MODULE ID 00836000 ST R2,SAVER2 STASH THE RETURN CODE 00837000 O R2,=XL4'80000000' INDICATE TO RETURN HERE 00838000 CALL DMKERMSG 00839000 SPACE 00840000 EJECT 00841000 EXIT EQU * 00842000 TM SAVEWRK1,SHPGNWRT DID WE FAIL TO WRITE A @V4075A0 00842100 BNO SHPGWTN CHANGED SHARED PAGE ? @V4075A0 00842200 NI SAVEWRK1,X'FF'-SHPGNWRT YES, RESET FLAG TO @V4075A0 00842300 LA R2,166 SEND ERROR MSG @V4075A0 00842400 B NOVAR VIA DMKERMSG @V4075A0 00842500 SHPGWTN EQU * @V4075A0 00842600 TM VMPSTAT,VMV370R EXTENDED-CONTROL MACHINE? 00843000 BZ RETURN NO - CONTINUE 00844000 TM VMESTAT,VMNEWCR0+VMINVSEG+VMINVPAG 00845000 BZ RETURN NOTHING NEEDS CLEANUP 00846000 CALL DMKVATAB CLEAN UP SHADOW TABLES 00847000 RETURN EQU * NOW EXIT (SHORTLY, ANYHOW) ... 00848000 AIF (NOT &TRACE(6)).NTR8 00849000 TM SAVEWRK1,CALTRCIT CALL TO DMKTRCIT NEEDED ? 00850000 BZ RETURNX NOPE - NO PROBLEM. 00851000 TM VMPSW+1,WAIT IS USER IN THE WAIT STATE ? 00852000 BO RETURNX IF YES, LEAVE WELL ENOUGH ALONE. 00853000 L R1,VMPSW+4 OK - WHERE-TO-GO INTO R1, 00854000 CALL DMKTRCIT CALL INSTRUCTION-TRACE SETTER-UPPER 00855000 RETURNX DS 0H NOW REALLY EXIT ... 00856000 .NTR8 EXIT 00857000 EJECT 00858000 WRTSHR LR R15,R1 TRANSFER REAL PAGE ADDRESS @V304735 00859000 N R15,XPAGNUM DROP OFF DISPLACEMENT @V304735 00860000 SRL R15,8 GET INDEX INTO CORTABLE @V304735 00861000 AL R15,ACORETBL NOW ADDRESS OF CORTABLE ENTRY @V304735 00862000 TM CORFLAG-CORTABLE(R15),CORSHARE SHARED PAGE ? @V304735 00865000 BZR R8 RETURN IF NOT SHARED PAGE @V304735 00866000 LR R2,R1 SAVE REAL PAGE ADDRESS @V304735 00867000 LA R0,CPEXSIZE SIZE OF ONE CPEXBLOK @V304735 00868000 CALL DMKFREE GET IT FROM FREE STORAGE @V304735 00869000 USING CPEXBLOK,R1 ADDRESSABILITY @V304735 00870000 STM R0,R15,CPEXR0 SAVE ALL REGISTERS @V304735 00871000 ST R5,CPEXR14 R5 WILL BE DESTROYED @V304735 00872000 ST R7,CPEXR15 SAME HOLDS TRUE FOR R7 @V304735 00873000 LA R15,WRTRTN CPEXBLOK RETURN ADDRESS @V304735 00874000 ST R15,CPEXADD STORE IT AWAY @V304735 00875000 LR R15,R2 LOAD REAL PAGE ADDRESS @V304735 00876000 N R15,XPAGNUM STRIP OFF DISPLACEMENT @V304735 00877000 LR R14,R15 SAVE PAGE ADDRESS MINUS DISP. @V304735 00878000 SRL R15,8 GET INDEX INTO CORTABLE @V304735 00879000 AL R15,ACORETBL FIND ACTUAL CORTABLE ENTRY @V304735 00880000 ST R15,CPEXR7 SAVE THE ADDRESS FOR DMKPAG @V304735 00881000 ISK R0,R14 GET REAL STORAGE KEY @V304735 00882000 N R0,=A(X'FFFFF8') CLEAR REF/CHG BITS. @V304735 00883000 SSK R0,R14 SET HARDWARE KEY @V304735 00884000 LA R14,2048(,R14) SECOND HALF OF REAL PAGE @V304735 00885000 ISK R0,R14 GET REAL STORAGE KEY @V304735 00886000 N R0,=A(X'FFFFF8') CLEAR REF/CHG BITS @V304735 00887000 SSK R0,R14 SET IN NEW STORAGE KEY @V304735 00888000 MVC CPEXR0,F5 INDICATE 'WRITE' TO DMKPAG @V304735 00889000 L R14,CORSWPNT-CORTABLE(,R15) GET SWAP TABLE ENTRY@V304735 00890000 TM SWPFLAG-SWPFLAG(R14),SWPRECMP DO WE HAVE TO @V4075A0 00890100 BNO GOTSLOT REALLOCATE AUX STOR FOR PAGE@V4075A0 00890150 ST R14,TEMPR14 SAVE OVER PGT CALL @VA09046 00890175 LR R0,R1 YES, TUCK AWAY CPEXBLOK POINTER @V4075A0 00890200 LR R9,R14 SAVE SWAPTABLE ENTRY ADDRESS @VA09046 00890210 LR R10,R15 SAVE CORE TABLE ENTRY ADDRESS @VA09046 00890220 CALL DMKPGTPG ASK FOR NEW AUX STOR SLOT @V4075A0 00890250 LR R14,R9 RESTORE SWAPTABLE ENTRY ADDRESS @VA09046 00890260 LR R15,R10 RESTORE CORE TABLE ENTRY ADDRESS @VA09046 00890270 LTR R1,R1 DID WE GET ONE @V4075A0 00890300 BZ NOAUXAVL NO, TELL USER @V4075A0 00890350 L R14,TEMPR14 RESTORE @VA09046 00890375 NI SWPFLAG-SWPFLAG(R14),X'FF'-SWPRECMP @V4075A0 00890400 ST R1,SWPCYL-SWPFLAG(R14) SET NEW AUX POINTER @V4075A0 00890450 LR R1,R0 RESTORE CPEXBLOK ADDRESSING @V4075A0 00890500 GOTSLOT EQU * @V4075A0 00890550 ST R14,CPEXR5 SAVE IT FOR DMKPAG @V304735 00891000 OI SWPFLAG-SWPFLAG(R14),SWPTRANS FLAG PAGE IN @V304735 00892000 * TRANS. 00893000 L R14,CORPGPNT-CORTABLE(,R15) GET ADDRESS OF @V304735 00894000 * PAGE TBL 00895000 OI PAGCORE+1-PAGCORE(R14),PAGINVAL ENQUEUE ON PAGE @V304735 00896000 L R14,=A(DMKPTRWQ) STACK OF WRITE QUEUE FOR DMKPAG@V304735 00897000 L R0,0(,R14) PUSH DOWN PAGE @V304735 00898000 ST R1,0(,R14) WRITE REQUEST @V304735 00899000 ST R0,CPEXFPNT PUT IT IN THE CHAIN @V304735 00900000 GOTO DMKPAGIO START UP THIS I/O @V304735 00901000 SPACE 1 00902000 WRTRTN STM R14,R15,TEMPR14 SAVE ORIGINAL R5+R7 @V304735 00903000 L R14,CORPGPNT-CORTABLE(,R7) PAGE TABLE ENTRY @V304735 00904000 NI PAGCORE+1-PAGCORE(R14),X'FF'-PAGINVAL DEQUEUE @V304735 00905000 * IT... 00906000 NI SWPFLAG-SWPFLAG(R5),X'FF'-SWPTRANS NO-LONGER @V304735 00907000 * TRANS 00908000 NI SAVEWRK1,X'FF'-(SHRPAGE+SHPGNWRT) UNSET FLAGS @V4075A0 00909100 L R5,TEMPR14 RESTORE REGISTER @V304735 00910000 L R7,TEMPR15 ..... @V304735 00911000 LR R1,R2 RESTORE REAL PAGE ADDRESS @V304735 00912000 BR R8 RETURN TO CALLER @V304735 00913000 SPACE 1 00914000 DROP R1 @V304735 00915000 SPACE 2 00916199 NOAUXAVL EQU * @V4075A0 00916299 OI SAVEWRK1,SHPGNWRT INDICATE NOT WRITTEN @V4075A0 00916399 LR R1,R0 CPEXBLOK ADDRESS @V4075A0 00916499 LA R0,CPEXSIZE DOUBLEWORD SIZE @V4075A0 00916599 CALL DMKFRET GIVE IT BACK @V4075A0 00916699 LR R1,R2 RESTORE REAL PAGE ADDR @V4075A0 00916799 BR R8 RETURN TO USER @V4075A0 00916899 EJECT @V4075A0 00916999 *********************************************************************** 00917000 * 00918000 * CONSTANTS * 00919000 * * 00920000 KEYEQ DC C'KEY =' 00921000 SUPPLMSG DC C'SUPPRESSED LINE(S) SAME AS ABOVE .....' 00922000 SPACE 00923000 LTORG 00924000 EJECT 00925000 PSA , @V306638 00926000 COPY CORE @V304735 00927000 COPY EQU @V306638 00928000 COPY SAVE @V306638 00929000 COPY TIMER @V306638 00930000 COPY VMBLOK @V306638 00931000 END 00932000