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