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 <BZ> 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