ibm:vm370-lib:cp:dmkhvd.assemble_src
Table of Contents
DMKHVD Source
References
- Fixes Applied : 15
- This Source Date : Wednesday, December 13, 1978
- Last Fix ID : [HRC064DK]
Source Listing
- DMKHVD.ASSEMBLE.txt
- HVD TITLE 'DMKHVD (CP) VM/370 - RELEASE 6' 00001000
- ISEQ 73,80 00002000
- COPY OPTIONS 00003000
- COPY LOCAL 00004000
- *. 00005000
- * MODULE NAME - 00006000
- * 00007000
- * DMKHVD 00008000
- * 00009000
- *. 00014000
- SPACE 2 00015000
- DMKHVD START 0 @VM03170 00016000
- MODID DC CL8'DMKHVD' MODULE IDENTIFIER @VM03170 00017000
- SPACE 00018000
- EXTRN DMKCPVAA,DMKUDRFU,DMKUDRRD,DMKUDRRV 00020000
- SPACE 00021000
- EXTRN DMKDRDSY @VM03170 00022000
- EXTRN DMKDRDER @VM03170 00023000
- EXTRN DMKIOEFM @V202232 00024000
- EXTRN DMKPSASP @V202232 00025000
- EXTRN DMKUDRDS @VM03170 00026000
- EXTRN DMKSYSRM @VA11268 00027000
- EXTRN DMKSCNVU,DMKDRDMP 00032000
- EXTRN DMKCPEID @VM03170 00033000
- EXTRN DMKCVTDB @VM03170 00034000
- EXTRN DMKSCNRU,DMKRPAGT 00035000
- EXTRN DMKSCNVD,DMKSNCP @V200820 00036000
- EXTRN DMKACOQU @VM03170 00037000
- EXTRN DMKUDRMD @V407466 00038000
- EXTRN DMKCPEPP PROGRAM PRODUCT BIT MAP @VMD0161 00039000
- EXTRN DMKSCNVS,DMKRPAPT,DMKQNTBL @V60B9BA 00040000
- EJECT 00041000
- *. 00042000
- * SUBROUTINE NAME - 00043000
- * 00044000
- * DMKHVDAL 00045000
- * 00046000
- * FUNCTION - 00047000
- * 00048000
- * TO PERFORM SERVICES FOR VIRTUAL MACHINES AS REQUESTED 00049000
- * VIA THE DIAGNOSE INSTRUCTION. 00050000
- * 00051000
- * ATTRIBUTES - 00052000
- * 00053000
- * REENTRANT, PAGEABLE, CALLED VIA SVC 00054000
- * 00055000
- * ENTRY POINTS - 00056000
- * 00057000
- * DMKHVDAL - CALLED VIA SVC FROM DMKHVC 00058000
- * DMKHVDPP - CALLED VIA SVC FROM DMKCPI 00059000
- * 00060000
- * ENTRY CONDITIONS - 00061000
- * 00062000
- * FOR DMKHVDAL: 00063000
- * GPR 12 = ADDRESS OF DMKHVDAL 00064000
- * GPR 11 = ADDRESS OF VMBLOK 00065000
- * 'VMINST' FIELD CONTAINS THE DIAGNOSE INSTRUCTION IMAGE 00066000
- * 00067000
- * FOR DMKHVDPP: 00068000
- * GPR 12 = ADDRESS OF DMKHVDPP 00069000
- * 00070000
- * EXIT CONDITIONS - 00071000
- * 00072000
- * DEPENDENT ON THE SERVICE PERFORMED. CONTROL RETURNS 00073000
- * TO THE USER VIA DMKDSPCH. 00074000
- * 00075000
- * CALLS TO OTHER ROUTINES - 00076000
- * 00077000
- * DMKDRDER - TO MANIPULATE INPUT SPOOL FILES 00078000
- * DMKDRDMP - TO READ SYSTEM DUMP SPOOL FILES 00079000
- * DMKDRDSY - TO READ THE SYSTEM SYMBOL TABLE 00080000
- * DMKDSPCH - TO RE-DISPATCH THE SERVICED USER 00081000
- * DMKFREE - TO OBTAIN FREE STORAGE FOR BUFFERS 00082000
- * DMKIOEFM - TO RE-FORMAT THE CP LOGREC AREA 00083000
- * DMKCVTDB - TO CONVERT DECIMAL RELEASE NUMBERS TO BINARY 00084000
- * DMKPSASP - TO EXAMINE VIRTUAL STORAGE PROTECTION KEYS 00085000
- * DMKPTRAN - TO PROCESS PAGING REQUESTS 00086000
- * DMKRPAGT - TO PROVIDE A USER WITH ONE PAGE OF SYSTEM DATA 00087000
- * DMKSCNRU - TO LOCATE THE SYSRES RDEVBLOK 00088000
- * DMKSCNVU - TO LOCATE VIRTUAL I/O BLOCKS 00089000
- * DMKUDRDS - TO PERFORM DYNAMIC USER DIRECTORY SWAP 00090000
- * DMKUDUMN - TO UPDATE DIRECTORY IN-PLACE 00091000
- * DMKSNCP - TO PERFORM THE 'SAVE FUNCTION FOR A 370X COMM. 00092000
- * CONTROL PROGRAM IMAGE 00093000
- * DMKSCNVS - LOCATE A RDEVBLOK BY VOLUME SERIAL NUMBER 00094000
- * DMKRPAPT - TO SAVE A 3800 IMAGE LIBRARY NAMED SYSTEM 00095000
- * 00096000
- EJECT 00097000
- * EXTERNAL REFERENCES - 00098000
- * 00099000
- * DMKSYSRM - REAL MACHINE SIZE IN BYTES 00100000
- * DMKCPEID - VM/370 RELEASE AND VERSION NUMBER FOR STIDX 00102000
- * DMKCPEPP - PROGRAM PRODUCT BIT MAP FOR STIDX 00103000
- * DMKQNTBL - ANCHOR FOR 3800 IMAGE LIBRARY NAMES 00108000
- * 00109000
- * TABLES / WORK AREAS - 00110000
- * 00111000
- * VMBLOK, VDEVBLOK, RDEVBLOK 00112000
- * 00113000
- * SAVEAREA - 00113010
- * 00113020
- * USED TO SAVE REGISTERS ACROSS CALLS TO OTHER MODULES 00113030
- * 00113040
- * SAVEWRK2 = GPR1 00113050
- * SAVEWRK3 = GPR2 00113060
- * 00113070
- * REGISTER USAGE - 00114000
- * 00115000
- * GPR 12 = BASE REGISTER FOR DMKHVDAL 00116000
- * GPR 11 = VMBLOK ADDRESSABILITY 00117000
- * GPR 9 = INTERNAL LINK REGISTER 00118000
- * GPR 6 = ADDRESS OF DIAGNOSE 'R2' VALUE 00119000
- * GPR 5 = ADDRESS OF DIAGNOSE 'R1' VALUE 00120000
- * 00121000
- * NOTES - 00122000
- * 00123000
- * AN ARTIFICIAL PROGRAM INTERRUPT (PRIVILEGED OPERATION 00124000
- * EXCEPTION WHILE IN VIRTUAL SUPERVISOR STATE) IS GENER- 00125000
- * ATED BY DMKHVDAL WHENEVER A VIRTUAL MACHINE REQUESTS 00126000
- * A SERVICE WHICH IS RESTRICTED TO COMMAND CLASSES OTHER 00127000
- * THAN THOSE ALLOWED TO THE VIRTUAL MACHINE. 00128000
- * 00129000
- * OPERATION - 00130000
- * 00131000
- * THE FUNCTION CODE CONTAINED IN THE ADDRESS FIELD OF THE 00132000
- * DIAGNOSE INSTRUCTION IS EXAMINED FOR VALIDITY. 00133000
- * A SPECIFICATION EXECPTION IS REFLECTED TO THE VIRTUAL 00134000
- * MACHINE IF THE CODE IS UNRECOGNIZED OR NOT A MULTIPLE 00135000
- * OF 4. A PRIVILEGED-OPERATION INTERRUPT IS GENERATED IF A 00136000
- * RESTRICTED SERVICE IS REQUESTED BY THE VIRTUAL MACHINE. 00137000
- * 00138000
- * SERVICES AVAILABLE VIA VIRTUAL DIAGNOSE ARE AS FOLLOWS: 00139000
- * 00140000
- * CODE = X'0000' STORE EXTENDED ID - STIDX - (ANY CLASS) 00141000
- * 'R1' = ADDRESS OF A DOUBLE WORD ALIGNED BUFFER IN VIRTUAL 00142000
- * STORAGE 00143000
- * 'R2' = BYTE COUNT OF INFORMATION TO BE STORED AT THE VIRTUAL 00144000
- * STORAGE ADDRESS SPECIFIED BY 'R1' IN THE FOLLOWING FORMAT: 00145000
- * +---------------------------------------+ 00146000
- * | VM/370 | 00147000
- * +--------------+----+---------+---------+ 00148000
- * | LEVEL | VC | MCEL | IPUADDR | 00149000
- * +--------------+----+---------+---------+ 00150000
- * | USERID | 00151000
- * +---------------------------------------+ 00152000
- * | PP FLAGS | 00153000
- * +---------------------------------------+ 00154000
- * 00155000
- * THE FIELDS STORED ARE DEFINED AS FOLLOWS: 00156000
- * VM/370 - APPEARS AS SHOWN, LEFT JUSTIFIED AND PADDED 00157000
- * WITH BLANKS 00158000
- * LEVEL - THE VERSION, LEVEL AND PLC TAPE NUMBER 00159000
- * OF THE HYPERVISOR IN HEX. EACH FIELD OCCUPIES 00160000
- * ONE BYTE AND IS OBTAINED FROM THE SYSTEM ID FIELD 00161000
- * IN THE MODULE DMKCPEID 00162000
- * VC - THE VERSION CODE RETURNED BY A STIDP EXECUTED 00163000
- * BY THE HYPERVISOR (VM/370) 00164000
- * MCEL - THE MAXIMUM MCEL RETURNED BY THE STIDP 00165000
- * IPUADDR - THE PROCESSOR ADDRESS RETURNED BY A STAP 00166000
- * EXECUTED BY THE HYPERVISOR - = TO 0 IF EXECUTED ON 00167000
- * A VIRTUAL OR REAL UNIPROCESSOR 00168000
- * USERID - THE VM USERID OF THE VIRTUAL MACHINE EXECUTING 00169000
- * THE STIDX 00170000
- * PP FLAGS - BIT MAP INDICATING WHICH PROGRAM PRODUCTS 00171000
- * ARE INSTALLED; BIT MAP KEPT IN DMKCPE AND INITIALIZED 00172000
- * AT INITIALIZATION TIME 00173000
- * 00174000
- * IF THE HYPERVISOR ITSELF IS EXECUTING IN A VIRTUAL MACHINE, 00175000
- * THE EXTENDED ID RETURNED BY A STIDX EXECUTED BY THE 00176000
- * HYPERVISOR IS APPENDED TO THE INFORMATION DESCRIBED ABOVE. 00177000
- * NOTE THAT THIS DEFINITION DIFFERS FROM THAT DESCRIBED IN 00178000
- * AR3799-01 IN THE AREA OF ALIGNMENT; ALSO, AN ARBITRARY LIMIT 00179000
- * OF FIVE LEVELS OF HYPERVISION HAS BEEN IMPOSED. 00180000
- * 00181000
- * 00182000
- * CODE = X'0004' EXAMINE REAL STORAGE LOCATIONS (CLASS C OR E) 00183000
- * 'R1' = ADDRESS OF A LIST OF REQUESTED DATA WORD ADDRESSES 00184000
- * 'R2' = COUNT OF FULL-WORD ENTRIES IN THE LIST 00185000
- * 'R2'+1 = ADDRESS OF A RESULT TABLE 00186000
- * 00187000
- * SPECIAL NOTE: SINCE THIS DIAGNOSE SERVICE IS INTENDED FOR 00188000
- * SYSTEM PERFORMANCE MONITORING, THE REQUEST AND RESULT TABLES 00189000
- * MUST BE IN THE SAME PAGE OF VIRTUAL STORAGE. WORD BOUNDARY 00190000
- * ALIGNMENT OF THE REQUEST AND RESULT LISTS IS FORCED, BUT NOT 00191000
- * CHECKED. 00192000
- * 00193000
- * FOR EACH ADDRESS ENTRY IN THE REQUEST TABLE, DMKHVD WILL 00194000
- * PLACE A FULL-WORD OF DATA FROM THE SPECIFIED LOCATION 00195000
- * IN REAL STORAGE, INTO THE RESULT TABLE SLOT CORRESPON- 00196000
- * DING TO THE ADDRESS ENTRY. WHEN EITHER ALL REQUESTS ARE 00197000
- * PROCESSED, THE END OF THE VIRTUAL STORAGE PAGE IS REACHED, 00198000
- * OR AN ADDRESS OUTSIDE OF REAL STORAGE IS ENCOUNTERED, 00199000
- * PROCESSING IS TERMINATED AND THE VIRTUAL MACHINE IS 00200000
- * RE-DISPATCHED VIA DMKDSPCH. 00201000
- * IN THE AP ENVIRONMENT ALL ADDRESSES ARE HANDLED AS IF 00202000
- * THEY WERE GENERATED ON THE MAIN PROCESSOR. REQUESTS 00203000
- * FOR LOC 0 ARE FILLED FROM THE PSA OF THE MAIN PROCESSOR 00204000
- * TO GET TO THE PSA OF THE ATTACHED PROCESSOR IT IS 00205000
- * NECESSARY FOR THE REQUESTOR TO FIRST ADD THE VALUE OF 00206000
- * PREFIXB TO THE PSA DISPLACEMENT. TO GET TO ABSOLUTE 00207000
- * ADDRESSES 0-4095 IT IS NECESSARY FOR THE REQUESTOR TO 00208000
- * FIRST ADD THE VALUE OF PREFIXA TO THE PSA DISPLACEMENT. 00209000
- * 00210000
- * CODE = X'0008' VIRTUAL CONSOLE FUNCTION INTERFACE (CLASS G) 00211000
- * 'R1' = ADDRESS OF A COMMAND-LINE BUFFER 00212000
- * 'R2' = BUFFER LENGTH IN BYTES 00213000
- * 00214000
- * THE BUFFER ADDRESS AND DATA LENGTH ARE EXAMINED FOR 00215000
- * VALIDITY. IF THE LENGTH IS NEGATIVE OR GREATER THAN 132, 00216000
- * A SPECIFICATION EXCEPTION IS GENERATED. IF THE ADDRESS 00217000
- * IS INVALID, AN ADRESSING EXCEPTION IS GENERATED. 00218000
- * IF A ZERO LENGTH FIELD IS SPECIFIED, THE VIRTUAL 00219000
- * MACHINE IS PLACED IN CONSOLE FUNCTION MODE VIA A CALL TO 00220000
- * DMKCFMBK, AND EXIT IS VIA DMKDSPCH. 00221000
- * FOR A VALID, NON-ZERO BUFFER LENGTH, THE COMMAND 00222000
- * DATA IS MOVED FROM VIRTUAL STORAGE INTO REAL FREE STORAGE 00223000
- * AND THE CONSOLE FUNCTION IS EXECUTED VIA A CALL TO 00224000
- * DMKCFMEN. ANY ERROR CODE RESULTING FROM THE EXECUTION 00225000
- * IS PASSED BACK TO THE VIRTUAL MACHINE IN THE 'R2' FIELD. 00226000
- * 00227000
- * CODE = X'000C' VIRTUAL "CHRONOLOG" CLOCK (CLASS G) 00228000
- * 'R1' = ADDRESS OF A 32-BYTE BUFFER AREA, DBL-WD ALIGNED 00229000
- * 00230000
- * DMKHVDAL PLACES INTO THE SPECIFIED AREA 32 BYTES 00231000
- * OF INFORMATION, IN THE FOLLOWING FORMAT: 00232000
- * +----------+----------+----------+----------+ 00233000
- * | MM/DD/YY | HH:MM:SS | VIRTCPU | TOTALCPU | 00234000
- * +----------+----------+----------+----------+ 00235000
- * WHERE THE DATE AND TIME ARE EBCDIC DOUBLE-WORD FIELDS, 00236000
- * AND VIRTUAL AND TOTAL CPU TIME ARE DBL-WORD, UNSIGNED 00237000
- * INTEGERS IN MICRO-SECOND UNITS. RETURN IS VIA DMKDSPCH. 00238000
- * 00239000
- * CODE = X'0010' RELEASE VIRTUAL STORAGE PAGES (CLASS G) 00240000
- * 'R1' = START ADDRESS OF FIRST PAGE TO BE RELEASED 00241000
- * 'R2' = START ADDRESS OF LAST PAGE TO BE RELEASED 00242000
- * 00243000
- * BOTH ADDRESSES ARE EXAMINED FOR ALIGNMENT AND VALIDITY. 00244000
- * DMKPGSPP IS CALLED TO PERFORM THE ACTUAL PAGE RELEASE. 00245000
- * 00246000
- * CODE = X'0014' INTERFACE TO INPUT SPOOL FILES (CLASS G) 00247000
- * 'R1','R2' AS REQUIRED BY DMKDRDER 00248000
- * 00249000
- * A CALL IS MADE TO DMKDRDER FOR SUB-FUNCTION DECODING 00250000
- * AND ACTUAL PROCESSING. ON RETURN, THE ERROR CODE IS TESTED 00251000
- * AND EITHER A PROGRAM INTERRUPT IS REFLECTED OR THE 00252000
- * VIRTUAL MACHINE IS RE-DISPATCHED WITH THE CONDITION CODE 00253000
- * INDICATING THE RESULTS OF THE OPERATION. 00254000
- * 00255000
- * CODE = X'0018' "STANDARD" DASD I/O W/O INTERRUPTS (CLASS G) 00256000
- * 'R1' = VIRTUAL DEVICE ADDRESS, DASD DEVICE 00257000
- * 'R2' = ADDRESS OF A DASD CCW STRING (FIXED FORMAT) 00258000
- * 00259000
- * CODE '18' IS PROCESSED VIA GOTO DMKDGDDK 00260000
- * 00261000
- * CODE = X'001C' CLEAR ERROR RECORDING AREA (CLASS F) 00262000
- * 'R1' = CODE 1,2 INDICATING CLEAR OF ERROR RECORDS OR 00263000
- * OF BOTH ERROR AND FRAME RECORDS 00264000
- * 00265000
- * THE 'R1' CODE VALUE IS PASSED TO DMKIOEFM IN GPR 2. 00266000
- * 00267000
- * CODE = X'0020' GENERAL VIRTUAL I/O W/O INTERRUPTS (CLASS G) 00268000
- * 'R1' = VIRTUAL DEVICE ADDRESS 00269000
- * 'R2' = ADDRESS OF A CCW STRING TO BE EXECUTED 00270000
- * 00271000
- * CODE '20' IS PROCESSED VIA GOTO DMKGIOEX. 00272000
- * 00273000
- * CODE = X'0024' VIRTUAL DEVICE TYPE INFORMATION (CLASS G) 00274000
- * 'R1' = VIRTUAL DEVICE ADDRESS OR -1 IF VIRTUAL CONSOLE 00275000
- * ON RETURN: 00276000
- * 'R1' = VIRTUAL DEVICE ADDRESS 00277000
- * 'R2' = VIRTUAL DEVICE INFORMATION 00278000
- * 'R2'+1 = REAL DEVICE INFORMATION (IF ANY) 00279000
- * 00280000
- * THE VIRTUAL DEVICE INFORMATION CONSISTS OF THE FIELDS 00281000
- * VDEVTYPC, VDEVTYPE, VDEVSTAT, AND VDEVFLAG, IN THAT ORDER, 00282000
- * FROM THE VDEVBLOK OF THE SPECIFIED DEVICE. THE REAL DEVICE 00283000
- * INFORMATION CONSISTS OF THE FIELDS RDEVTYPC, RDEVTYPE, 00284000
- * RDEVMDL, AND RDEVFTR, IN THAT ORDER, FROM THE RDEVBLOK OF 00285000
- * THE ASSOCIATED REAL DEVICE (IF THERE IS ONE). IF THE DEVICE 00286000
- * IS A VIRTUAL CONSOLE, THE RDEVFTR FIELD OF 'R2+1' IS FILLED 00287000
- * WITH THE INFORMATION FROM RDEVLLEN AND IF IT IS OF THE 3270 00288000
- * DISPLAY TYPE, THE RDEVMDL FIELD OF 'R2'+1 IS SET TO THE VALUE 00289000
- * OF THE MODEL. 00290000
- * THE INFORMATION IS PLACED IN THE 'R2' REGISTER AND THE ONE 00291000
- * FOLLOWING ('R2'+1),AS INDICATED BELOW 00292000
- * +----------+----------+----------+----------+ 00293000
- * 'R2' | VDEVTYPC | VDEVTYPE | VDEVSTAT | VDEVFLAG | 00294000
- * +----------+----------+----------+----------+ 00295000
- * 'R2+1' | RDEVTYPC | RDEVTYPE | RDEVMDL | RDEVFTR | 00296000
- * +----------+----------+----------+----------+ 00297000
- * EACH FIELD IS A SINGLE-BYTE FLAG, WHOSE VALUES MAY BE 00298000
- * DETERMINED FROM THE COPY FILES 'DEVTYPES', 'VBLOKS', AND 00299000
- * 'RBLOKS' IN THE VM/370 MACRO LIBRARY. THE VIRTUAL 00300000
- * CONDITION CODE IS SET AS FOLLOWS: 00301000
- * CC = 0 => ALL DATA IS VALID 00302000
- * CC = 2 => NO REAL DEVICE DATA, VIRTUAL TYPE OK 00303000
- * CC = 3 => DEVICE DOES NOT EXIST 00304000
- * 00305000
- * CODE = X'0028' DYNAMIC CHANNEL PROGRAM MODIFICATION (CLASS G) 00306000
- * 'R1' = SPECIFIES A REGISTER GIVING THE ADDRESS OF THE 00307000
- * CCW THAT HAS BEEN MODIFIED. 00308000
- * 'R2' = SPECIFIES ANOTHER REGISTER GIVING THE DEVICE 00309000
- * ADDRESS (IN BITS 16-31). 00310000
- * 00311000
- * THE MODIFIED CCW AND DEVICE ADDRESS ARE EXAMINED FOR 00312000
- * VALIDITY. IF THE MODIFIED CCW OR DEVICE ADDRESS IS INVALID, 00313000
- * DMKHVD RETURNS CONTROL TO THE USER WITH A RETURN CODE AND 00314000
- * CONDITION CODE OF ONE IN PSW. FOR A VALID MODIFIED CCW AND 00315000
- * DEVICE ADDRESS, A CHANGE IS MADE TO THE REAL CCW THAT 00316000
- * CORRESPONDS TO THE MODIFIED VIRTUAL CCW, IN ORDER FOR 00317000
- * MODIFICATION OF THE VIRTUAL CCW LIST TO HAVE ANY REAL 00318000
- * EFFECT ON VM/370. 00319000
- * ANY ERROR CODE RESULTING FROM THE EXECUTION IS 00320000
- * PASSED BACK TO THE VIRTUAL MACHINE IN REGISTER 15 AND A 00321000
- * CONDITION CODE IS SET IN THE PSW TO INDICATE TO THE VIRTUAL 00322000
- * MACHINE WHETHER THE NECESSARY MODIFICATION TO THE REAL 00323000
- * CCW LIST WAS MADE SUCCESSFULLY. IN GENERAL, A CONDITION 00324000
- * CODE OF 0 INDICATES SUCCESS, 1 INDICATES A PROBABLE 00325000
- * PROGRAMMING ERROR IN ISSUING THE DIAGNOSE CALL, AND 00326000
- * 2 INDICATES THAT IT WAS TOO LATE TO CHANGE THE REAL CCW 00327000
- * LIST BECAUSE OF CHANNEL END OR DEVICE END HAS ALREADY 00328000
- * OCCURRED. 00329000
- * 00330000
- * CODE = X'0034' READ SYSTEM DUMP SPOOL FILE (CLASS C OR E) 00375000
- * 'R1','R2' AS REQUIRED BY DMKDRDMP 00376000
- * 00377000
- * CODE '34' IS PROCESSED VIA A CALL TO DMKDRDMP. 00378000
- * ON RETURN, THE ERROR CODE IS EXAMINED AND EITHER A PROGRAM 00379000
- * INTERRUPT IS REFLECTED OR THE VIRTUAL MACHINE IS 00380000
- * RE-DISPATCHED WITH A CONDITION CODE SET. 00381000
- * 00382000
- * CODE = X'0038' READ SYSTEM SYMBOL TABLE (CLASS C OR E) 00383000
- * 'R1','R2' AS REQUIRED BY DMKDRDSY 00384000
- * 00385000
- * CODE '38' IS PROCESSED VIA A CALL TO DMKDRDSY. 00386000
- * RETURN HANDLING IS THE SAME AS FOR CODES '14' AND '34'. 00387000
- * 00388000
- * CODE = X'003C' DYNAMIC UPDATE OF SYSTEM USER DIRECTORY 00389000
- * (CLASS A, B, OR C) 00390000
- * 'R1','R2' IMMATERIAL 00391000
- * 00392000
- * CODE '3C' IS PROCESSED VIA A CALL TO DMKUDRDS. 00393000
- * RETURN HANDLING IS THE SAME AS FOR CODES '14','34','38'. 00394000
- * 00395000
- * 00396000
- * CODE = X'0040' RESERVED FOR FUTURE USE 00397000
- * 00398000
- * CODE = X'0044' RESERVED FOR FUTURE USE 00399000
- * 00400000
- * CODE = X'0048' RESERVED FOR FUTURE USE 00401000
- * 00402000
- * CODE = X'004C' PUNCH ACCOUNTING CARDS 00403000
- * (THE ACCOUNTING OPTION MUST BE SET) 00404000
- * 00405000
- * 'R1' = CONTAINS THE ADDRESS OF THE PARAMETER LIST OR ZERO. 00406000
- * 'R2' = CONTAINS AFUNCTION HEXADECIMAL CODE INTERPRETED BY 00407000
- * DMKCPVAA. 00408000
- * 00409000
- * CODE X'004C' IS PROCESSED VIA A CALL TO DMKCPVAA. ON 00410000
- * RETURN, IF THE USER ACCOUNTING BLOCK EXIST, THE STORAGE 00411000
- * IS RELEASED. DMKHVD CHECKS THE PARAMETER LIST ADDRESS TO 00412000
- * ASSURE THAT THE ADDRESS IS VALID AND ALIGNED ON A DOUBLEWORD 00413000
- * BOUNDARY. IF THE PARAMETER LIST ADDRESS IS ZERO, DMKHVD 00414000
- * RETURN CONTROL TO THE USER WITH CONDITION CODE ZERO 00415000
- * SET IN THE PSW. IF THE PARAMETER LIST ADDRESS IS INVALIDED OR 00416000
- * NOT ALIGNED ON A DOUBLEWORD BOUNDARY, THAN AN ADDRESSING 00417000
- * OR SPECIFICATION EXECPTION IS GENERATED RESPECTIVELY. 00418000
- * FOR A PARAMETER LIST ADDRESS THAT'S NON-ZERO AND VALID, THE 00419000
- * USERID IN THE PARAMETER LIST IS CHECK AGAINST THE DIRECTORY 00420000
- * LIST AND THE FUNCTION HEXADECIMAL CODE IS CHECK TO DETERMINE 00421000
- * IF THEY ARE VALID. IF NOT, DMKHVD RETURN CONTROL TO THE USER 00422000
- * WITH CONDITION CODE ONE OR THREE SET IN THE PSW RESPECTIVELY. 00423000
- * IF THE USERID AND FUNCTION HEXADECIMAL CODE ARE VALID, THE 00424000
- * USER ACCOUNTING BLOCK IS BUILDED AND THE USERID, ACCOUNT 00425000
- * NUMBER AND DISTRIBUTION NUMBER ARE MOVE INTO THE BLOCK FROM 00426000
- * THE PARAMETER LIST OR THE USER MACHINE BLOCK AND CONTROL 00427000
- * IS RETURNED TO THE USER WITH A CONDITION CODE ZERO 00428000
- * SET IN THE PSW. 00429000
- * 00430000
- * CODE = X'0050' SAVE 370X CONTROL PROGRAM IMAGE 00431000
- * (CLASS A, B, OR C) 00432000
- * 'R1', 'R2' AS REQUIRED BY DMKSNCP 00433000
- * 00434000
- * PROCESSED VIA A CALL TO DMKSNCP. ON RETURN AN ERROR 00435000
- * CODE (OR ZERO) IS RETURNED IN THE USER'S 'R2' REGISTER. 00436000
- * 00437000
- * CODE = X'0058' DIAG CONSOLE 3270 WRITE 00438000
- * 00439000
- * CODE = X'0054' DIAG PA2 CONSOLE INTERRUPT ENABLE 00440000
- * 00441000
- * 00442000
- * CODE = X'005C' EDIT AN ERROR MESSAGE ACCORDING TO USER'S 00443000
- * EMSG SETTING (CLASS G) 00444000
- * 'R1' = ADDRESS OF MESSAGE TO BE EDITED 00445000
- * 'R2' = LENGTH OF MESSAGE (INCLUDING CODE AND TEXT) 00446000
- * ON RETURN: 00447000
- * 'R1' = ADDRESS OF MESSAGE THAT USER SHOULD SEND 00448000
- * 'R2' = LENGTH OF MESSAGE THAT USER SHOULD SEND; 00449000
- * OR 0 IF NO MSG SHOULD BE SENT 00450000
- * 00451000
- * EMSG SETTING FOR THE USER IS TESTED BY TESTING VMMLEVEL 00452000
- * FOR VMMCODE AND VMMTEXT. 00453000
- * IF EMSG IS OFF, 'R2' IS SET TO 0. 00454000
- * IF EMSG IS ON, 'R2' AND 'R1' ARE LEFT ALONE. 00455000
- * IF EMSG IS CODE, 'R2' IS SET TO 10, WHICH IS LENGTH OF 00456000
- * CODE ALONE. 00457000
- * IF EMSG IS TEXT, 'R1' IS SET TO POINT TO TEXT PART OF MESSAGE, 00458000
- * AND 'R2' IS DECREMENTED TO LENGTH OF TEXT ONLY. (IF 00459000
- * RESULTING LENGTH IS NOT POSITIVE, 0 LENGTH IS RETURND.) 00460000
- * ON RETURN FROM DIAGNOSE 5C, CALLER SHOULD CHECK 'R2'. 00461000
- * IF A ZERO LENGTH WAS PASSED BACK, THE CALLER SHOULD 00462000
- * NOT ISSUE A STARTIO AT ALL (I.E., THE MESSAGE SHOULD 00463000
- * NOT BE SENT). IF A NON-0 LENGTH WAS PASSED BACK, 00464000
- * HE SHOULD ISSUE A STARTIO USING THE 'R1' ADDRESS AND 00465000
- * THE 'R2' LENGTH THAT WERE RETURNED BY THE DIAGNOSE 5C. 00466000
- * 00467000
- * CODE = X'0060' RETURN VIRTUAL MACHINE STORAGE SIZE (CLASS G) 00468000
- * ON RETURN: 00469000
- * 'R1' = SIZE OF VIRTUAL STORAGE 00470000
- * 00471000
- * CODE = X'0064' LOAD/FIND OR PURGE A NAMED SYSTEM (CLASS G) 00472000
- * 'R1' = ADDRESS OF THE NAMED SYSTEM 00473000
- * 'R2' = CODE FUNCTION: 00474000
- * 00 = LOAD A NAMED SYSTEM IN SHARED MODE 00475000
- * 04 = LOAD A NAMED SYSTEM IN NON-SHARED MODE 00476000
- * 08 = PURGE A PREVIOUS LOADED NAMED SYSTEM 00477000
- * 0C = FIND THE NAMED SYSTEM IN THE USERS VIRTUAL STORAGE 00478000
- * 00479000
- * DMKCFGCL - IS CALLED TO PROCESS THE REQUEST 00480000
- * 00481000
- * CODES = X'0068' THRU X'0070' RESERVED FOR IBM USE 00482000
- * 00483000
- * CODE = X'0074' LOAD/SAVE A 3800 IMAGE LIBRARY NAMED SYSTEM 00484000
- * FOR USERS WITH CLASS A, B, OR C ONLY 00485000
- * 'R1','R1+1' = 8 CHARACTER NAME OF THE 3800 IMAGE LIBRARY 00486000
- * WHICH HAS BEEN LEFT-JUSTIFIED AND PADDED 00487000
- * WITH BLANKS 00488000
- * 'R2' = VIRTUAL ADDRESS AT WHICH TO START LOADING 00489000
- * OR SAVING 00490000
- * 'R2+1' = HIGH ORDER BYTE CONTAINS X'00' FOR A LOAD AND 00491000
- * X'04' FOR A SAVE OPERATION. THE 3 LOW ORDER 00492000
- * BYTES CONTAIN THE NUMBER OF BYTES TO BE 00493000
- * LOADED OR SAVED. 00494000
- * OPERATION - 00495000
- * 00496000
- * IF THE USER IS NOT CLASS A, B, OR C, THEN RETURN WITH 00497000
- * A PRIVILEGED OPERATION EXCEPTION. 00498000
- * IF EITHER 'R1' OR 'R2' ARE REGISTER 15, RETURN WITH A 00499000
- * SPECIFICATION EXCEPTION. DO THE SAME IF THE VIRTUAL 00500000
- * ADDRESS SPECIFIED DOES NOT START ON A PAGE BOUNDARY. 00501000
- * RETURN AN ADDRESSING EXCEPTION IF THE AREA TO BE 00502000
- * LOADED/SAVED EXTENDS PAST THE END OF THE USER'S 00503000
- * VIRTUAL MEMORY. 00504000
- * THE FOLLOWING STEPS ARE TAKEN: 00505000
- * 1. TRANS IN AND LOCK NPRTBL. 00506000
- * 2. FIND THE NAMED SYSTEM IN AN NPRTBL ENTRY. 00507000
- * 3. FIND THE DASD VOLUME CONTAINING THE NAMED SYSTEM. 00508000
- * 4. USING DMKRPAGT/DMKRPAPT WE THEN LOAD/SAVE 00509000
- * THE REQUESTED SYSTEM. 00510000
- * 5. RETURN IS MADE TO THE USER WITH THE FOLLOWING 00511000
- * RETURN CODES IN REGISTER 'R2': 00512000
- * X'00' = LOAD/SAVE SUCCESSFULLY PERFORMED 00513000
- * X'04' = NAMED SYSTEM NOT FOUND IN NPRTBL 00514000
- * X'08' = NAMED SYSTEM CURRENTLY ACTIVE ON 3800 00515000
- * X'0C' = VOLID FOR NAMED SYSTEM NOT CP OWNED 00516000
- * X'10' = VOLID FOR NAMED SYSTEM NOT MOUNTED 00517000
- * X'14' = NUMBER OF BYTES REQUESTED LARGER THAN 00518000
- * SIZE OF NAMED SYSTEM. IN THIS CASE 00519000
- * RESIDUAL BYTE COUNT IS IN 'R2+1' 00520000
- * X'18' = PAGING ERROR DURING LOAD/SAVE 00521000
- * 00522000
- * CODE = X'84' CP DIRECTORY UPDATE-IN-PLACE 00523000
- * RX = POINTER TO PARAMETER LIST 00524000
- * RY = LENGTH OF PARAMETER LIST (IN BYTES) 00525000
- * AND RETCODE ON EXIT. 00526000
- * 00527000
- * CODES = X'0088' THRU X'00FC' RESERVED FOR IBM USE 00528000
- * CODES = X'0100' THRU X'01FC' RESERVED FOR INSTALLATION USE 00529000
- *. 00530000
- EJECT 00531000
- *---------------------------------------------------------------------* 00532000
- * * 00533000
- * PROCESS VIRTUAL DIAGNOSE FOR VIRTUAL MACHINES * 00534000
- * * 00535000
- *---------------------------------------------------------------------* 00536000
- USING SAVEAREA,R13 @VM03170 00537000
- DMKHVDAL RELOC @VM03170 00538000
- USING PSA,0 00539000
- USING VMBLOK,R11 00540000
- SPACE 2 00541000
- TM VMINST+3,X'03' IS CODE MULTIPLE OF 4? 00542000
- BNZ SPECERR NO - SPECIFICATION 00543000
- IC R5,VMINST+1 GET REGISTERS SPECIFIED 00544000
- LR R6,R5 00545000
- SLL R6,2(0) USER'S 'R2' NUMBER 00546000
- N R6,F60 ... 00547000
- SRL R5,2(0) ... 00548000
- N R5,F60 REGISTER NO. * 4 00549000
- LA R5,VMGPRS(R5) ADDR OF 'R1' IN VMBLOK 00550000
- LA R6,VMGPRS(R6) ADDR OF 'R2' IN VMBLOK 00551000
- LH R4,VMINST+2 GET FUNCTION CODE FROM INSTRUCTIO@V200820 00552000
- CL R4,=A(HVDMAXC) WITHIN SYSTEM SUPPORTED RANGE ? @VM03170 00553000
- BH HVDUSER NO -- CHECK FOR INSTALLATION CODE@VM03170 00554000
- B HVDODER(R4) JUMP INTO IT @VM03170 00555000
- SPACE 2 00556000
- HVDODER EQU * DECODING TABLE FOR HVD'S @VM03170 00557000
- B HVDSTIDX '000' - STORE EXTENDED ID @VM03170 00558000
- B READCPC '004' - READ CP CORE 00559000
- B HVDEXIT '008' - SUPPORTED BY DMKHVC @VM03170 00560000
- B HVDEXIT '00C' - SUPPORTED BY DMKHVC @VM03170 00561000
- B HVDEXIT '010' - SUPPORTED BY DMKHVC @VM03170 00562000
- B HVDSPRD '014' - SPOOL INPUT FILE @VM03170 00563000
- * MANIPULATE 00564000
- B HVDEXIT '018' - SUPPORTED BY DMKHVC @VM03170 00565000
- B HVDLRER '01C' - CLEAR RECORDING AREA @VM03170 00566000
- B HVDEXIT '020' - SUPPORTED BY DMKHVC @VM03170 00567000
- B HVDDTYP '024' - DEVICE TYPE INQUIRY @VM03170 00568000
- B HVDEXIT '028' - SUPPORTED BY DMKHVC @VM03170 00569000
- B HVDEXIT '02C' - SUPPORTED BY DMKHVE @VA11268 00570000
- B HVDEXIT '030' - SUPPORTED BY DMKHVE @VA11268 00571000
- B HVDRSDF '034' - READ SYSTEM DUMP SPOOL @VM03170 00574000
- * FILE 00575000
- B HVDRDSYM '038' - READ SYSTEM SYMBOL TABLE @VM03170 00576000
- B HVDDIRCT '03C' - DYNAMIC DIRECTORY UPDATE @VM03170 00577000
- B HVDEXIT '040' - RESERVED FOR FUTURE USE @VM03170 00578000
- B HVDEXIT '044' - RESERVED FOR FUTURE USE @VM03170 00579000
- B HVDEXIT '048' - RESERVED FOR FUTURE USE @VM03170 00580000
- B HVDACCT '04C' - PUNCH ACCOUNTING CARDS @VM03170 00581000
- B HVD3705 '050' - SAVE 370X CONTROL PROGRAM@VM03170 00582000
- B HVDEXPA '054' DIAG PA2 CONSOLE ENABLE @VM03170 00583000
- B HVDEXIT '058' - SUPPORTED BY DMKHVC @VM03170 00584000
- B HVDEXIT '05C' - SUPPORTED BY DMKHVC @VM03170 00585000
- B HVDEXIT '060' - SUPPORTED BY DMKHVC @VM03170 00586000
- B HVDEXIT '064' - SUPPORTED BY DMKHVC @VM03170 00587000
- B HVDEXIT '068' - SUPPORTED BY DMKHVC @V60B9BA 00588000
- B HVDEXIT '06C' - SUPPORTED BY DMKHVC @V60B9BA 00589000
- B HVDEXIT '070' - SUPPORTED BY DMKHVC @V60B9BA 00590000
- B HVD3800 '074' - LOAD/SAVE 3800 IMAGELIBS @V60B9BA 00591000
- B HVDEXIT RESERVED FOR X'78' @V60C1BD 00592000
- B HVDEXIT RESERVED FOR X'7C' @V60C1BD 00593000
- B HVDEXIT RESERVED FOR X'80' @V60C1BD 00594000
- B HVCDUIP X'84' DIRECTORY UPDATE-IN-PLACE @V60C1BD 00595000
- HVDMAXC EQU *-HVDODER-4 MAXIMUM CODE NUMBER DEFINED @VM03170 00596000
- EJECT 00597000
- HVDUSER EQU * DECODING FOR @VM03170 00598000
- * INSTALLATION-DEFINED CODES 00599000
- S R4,F256 WITHIN INSTALLATION-DEFINED RANGE@V200820 00600000
- BM SPECERR NO -- SPECIFICATION EXCEPTION @V200820 00601000
- CL R4,=A(USRMAXC) VALID CODE FOR THIS TABLE ? @V200820 00602000
- BH SPECERR NO -- SPECIFICATION EXCEPTION @V200820 00603000
- B USRCODE(R4) BRANCH TO PROCESSING ROUTINE @V200820 00604000
- SPACE 2 00605000
- USRCODE EQU * DECODING TABLE FOR INSTALLATION @V200820 00606000
- * CODES 00607000
- B SPECERR (PROTOTYPE) @V200820 00608000
- USRMAXC EQU *-USRCODE-4 HIGHEST INSTALLATION CODE DEFINED@V200820 00609000
- SPACE 2 00610000
- HVDCC1 TM *+1,X'FF' SET CC=1 @VM03170 00611000
- ST R0,SAVER0 SAVE PC INTERRUPT CODE FOR DMKHVD@VM03170 00612000
- B GENEXIT RETURN TO CALLER @VM03170 00613000
- HVDEXIT CLI *+1,0 SET CC=0 @VM03170 00614000
- GENEXIT EXIT RETURN TO CALLER @VM03170 00615000
- EJECT 00616000
- *-------------------------------------------------------------------- 00617000
- * STORE EXTENDED ID 00618000
- *-------------------------------------------------------------------- 00619000
- SPACE 00620000
- HVDSTIDX EQU * PERFORM "STORE EXTENDED ID " @VM03170 00621000
- TM 3(R5),X'07' TEST FOR DOUBLEWORD ALIGNMENT @VM03170 00622000
- BNZ SPECERR IF NOT REFLECT SPECIF EXCEPTION @VM03170 00623000
- L R8,0(,R6) CHECK BUFFER LENGTH, SAVE IN R8 @VM03170 00624000
- N R8,XRIGHT24 STRIP OFF HIGH ORDER BYTE @VM03170 00625000
- BZ SPECERR ZERO LENGTH INVALID @VM03170 00626000
- LA R0,5*EXTIDL/8 GET STORAGE FOR A BUFFER, @VMD0161 00627000
- CALL DMKFREE IMPOSING A NESTING LIMIT OF 5 @VM03170 00628000
- LR R3,R1 SAVE ADDRESS OF BUFFER @VM03170 00629000
- LR R10,R1 ... @VM03170 00630000
- SPACE 00631000
- * CONSTRUCT 1ST LEVEL EXTENDED ID ... 00632000
- SPACE 00633000
- MVC 0(8,R3),=C'VM/370 ' INSERT HYPERVISOR ID @VM03170 00634000
- L R15,=A(DMKCVTDB) ADDRESS OF DECIMAL/BINARY @VM03170 00635000
- * CONVERTER 00636000
- L R4,=A(DMKCPEID) POINT TO VM LEVEL IDENTIFIER @VM03170 00637000
- LA R0,2 SET TO CONVERT TWO BYTE FIELD @VM03170 00638000
- LR R1,R4 POINT TO RELEASE NUMBER @VM03170 00639000
- BALR R14,R15 CONVERT RELEASE NUMBER @VM03170 00640000
- STC R1,8(,R3) AND SAVE IN BUFFER @VM03170 00641000
- LA R0,2 RESTORE 2 BYTE LENGTH @VM03170 00642000
- LA R1,2(,R4) POINT TO VERSION NUMBER @VM03170 00643000
- BALR R14,R15 AND CONVERT IT @VM03170 00644000
- STC R1,9(,R3) SAVE IT @VM03170 00645000
- LA R0,4 PLC TAPE NUMBER IS 4 BYTES .. @VM03170 00646000
- LA R1,4(,R4) POINT TO PLC TAPE NUMBER @VM03170 00647000
- BALR R14,R15 CONVERT IT @VM03170 00648000
- STC R1,10(,R3) AND SAVE IT @VM03170 00649000
- MVC 11(1,R3),CPUVERSN MOVE VERSION CODE OF OUR IPU @VM03170 00650000
- MVC 12(2,R3),CPUMCELL MOVE MAXIMUN MCEL LENGTH, @VM03170 00651000
- MVC 14(2,R3),IPUADDR INSTRUCTION PROCESSING UNIT @VM03170 00652000
- * ADDRESS, 00653000
- MVC 16(8,R3),VMUSER AND VM USERID @VM03170 00654000
- L R4,=A(DMKCPEPP) GET ADDRESS OF PP BIT MAP @VMD0161 00655000
- MVC 24(8,R3),0(R4) MOVE IN PROGRAM PRODUCT MAP @VMD0161 00656000
- LA R4,EXTIDL INITIALIZE AVAILABLE DATA COUNTER@VMD0161 00657000
- CLI CPUVERSN,X'FF' RUNNING ON BARE MACHINE ?? @VM03170 00658000
- BNE GETLEN YES -- EXTENDED ID IS COMPLETE @VM03170 00659000
- SPACE 00660000
- * HERE TO APPEND EXTENDED ID TO THIS LEVEL ... 00661000
- LA R1,EXTIDL(,R3) POINT TO SPACE IN BUFFER, AND @VMD0161 00662000
- LA R2,4*EXTIDL SET REQUESTED LENGTH, ALLOWING @VMD0161 00663000
- * 4 LEVELS 00664000
- ALR R4,R2 GET MAXIMUN LENGTH OF AVAILABLE @VM03170 00665000
- * DATA 00666000
- DC X'83120000' STORE EXTENDED INFORMATION @VM03170 00667000
- * BEHIND OURS 00668000
- SLR R4,R2 AND SUBTRACT RESIDUAL COUNT @VM03170 00669000
- SPACE 00670000
- GETLEN CLR R4,R8 USE LESSER OF REQUESTED LENGTH @VM03170 00671000
- * AND AVAILABLE LENGTH 00672000
- BL *+6 ... @VM03170 00673000
- LR R4,R8 IF REQUESTED LENGTH IS LOW USE @VM03170 00674000
- * IT INSTEAD 00675000
- LR R7,R4 SAVE LENGTH OF DATA TO BE MOVED @VM03170 00676000
- SLR R8,R8 AND CLEAR RESIDUAL COUNT @VM03170 00677000
- L R1,0(,R5) GET STARTING ADDRESS IN R1 @VM03170 00678000
- N R1,XRIGHT24 BITS 8-31 ONLY, PLEASE @VM03170 00679000
- LA R14,0(R1,R4) NOW CHECK FOR 2K XOVER ... @VM03170 00680000
- BCTR R14,0 POINT TO LAST BYTE @VM03170 00681000
- L R15,X2048BND SET TO GET 2K BOUND @VM03170 00682000
- NR R14,R15 GET LAST BYTE PAGE @VM03170 00683000
- NR R15,R1 GET 1ST BYTE PAGE @VM03170 00684000
- CLR R14,R15 COMPARE START TO END @VM03170 00685000
- BE ONEPAGE NO XOVER -- GO MOVE DATA @VM03170 00686000
- SPACE 00687000
- * HERE IF A 2K PAGE CROSSOVER OCCURRED 00688000
- SLR R14,R1 GET LENGTH OF 1ST SEGMENT @VM03170 00689000
- LR R8,R4 GET TOTAL LENGTH @VM03170 00690000
- SLR R8,R14 GET LENGTH OF 2ND SEGMENT @VM03170 00691000
- LR R7,R14 SAVE 1ST SEGMENT LENGTH @VM03170 00692000
- LR R9,R1 SAVE VIRTUAL ADDRESS @VM03170 00693000
- SPACE 00694000
- ONEPAGE TRANS 2,1,OPT=(BRING,DEFER),ADEX=STIDADX FETCH PAGE @VM03170 00695000
- CALL DMKPSASP AND VALIDATE STORAGE KEYS @VM03170 00696000
- BE GETSEG IF KEYS MATCH, GO MOVE DATA @VM03170 00697000
- LA R8,4 OTHERWISE, SET TO REFLECT @VM03170 00698000
- * PROTECTION 00699000
- B STIDFRET EXCEPTION, AND GO RETURN BUFFER @VM03170 00700000
- SPACE 00701000
- GETSEG BCTR R7,0 GET LENGTH OF 1ST SEGMENT-1 @VM03170 00702000
- EX R7,STIDXMV MOVE DATA TO USER .. @VM03170 00703000
- LA R1,1(R7,R9) POINT TO NEXT DATA ADDRESS @VM03170 00704000
- LA R3,1(R7,R3) POINT TO NEXT BUFFER ADDRESS @VM03170 00705000
- LTR R7,R8 GET RESIDUAL LENGTH @VM03170 00706000
- BZ STIDONE NO MORE TO MOVE ... @VM03170 00707000
- SLR R8,R8 CLEAR RESIDUAL LENGTH, @VM03170 00708000
- B ONEPAGE AND GO MOVE REMAINING DATA @VM03170 00709000
- SPACE 1 00710000
- STIDADX LA R8,5 SET INDICATOR FOR ADDRESSING @VM03170 00711000
- * EXCEPTION. 00712000
- B STIDFRET AND RELEASE THE BUFFER @VM03170 00713000
- SPACE 1 00714000
- STIDONE L R1,0(,R6) GET USER REQUESTED LENGTH @VM03170 00715000
- SLR R1,R4 LESS AMOUNT OF DATA MOVED @VM03170 00716000
- ST R1,0(,R6) AND UPDATE USER'S R2 FIELD @VM03170 00717000
- STIDFRET LR R1,R10 POINT TO START OF BUFFER @VM03170 00718000
- LA R0,5*EXTIDL/8 GET ITS LENGTH @VMD0161 00719000
- CALL DMKFRET AND RETURN IT TO FREE STORAGE @VM03170 00720000
- LTR R0,R8 ANY ERRORS DURING EXECUTION ? @VM03170 00721000
- BNZ PROGINT YES -- GO TO PROGINT WITH CODE @VM03170 00722000
- * IN GPR0 00723000
- B HVDEXIT ALL DONE @VM03170 00724000
- SPACE 00725000
- STIDXMV MVC 0(*-*,R2),0(R3) EXECUTED TO MOVE EXTENDED ID @VM03170 00726000
- EJECT 00727000
- *---------------------------------------------------------------------* 00728000
- * FETCH CP DATA - CODE '004' FOR CLASS C OR E ONLY * 00729000
- * ------------------------------- * 00730000
- * 'R1' = VIRTUAL ADDR OF LIST OF CP LOCATIONS * 00731000
- * 'R2' = COUNT OF ENTRIES IN LIST (FULL-WORD ENTRIES) * 00732000
- * 'R2'+1 = VIRTUAL ADDRESS OF RESULTS TABLE * 00733000
- * THE INSTRUCTION AND ALL TABLES MUST BE IN THE SAME PAGE * 00734000
- *---------------------------------------------------------------------* 00735000
- READCPC EQU * 00736000
- TM VMCLEVEL,VMCLASSC+VMCLASSE ALLOWED TO DO IT ? 00737000
- BZ PRIVLGD NO - PRIVILEGED OPERATION 00738000
- L R8,0(R5) 'R1' = REQUEST LIST VADDR @VA04548 00739000
- LA R3,VMGPRS+4*R15 ADDRESS OF R15 @VM03170 00740000
- LA R4,4(,R6) ADDRESS OF 'R2'+1 @VM03170 00741000
- CLR R3,R6 R2=R15? @VM03170 00742000
- BNE *+8 NO--OK @VM03170 00743000
- LA R4,VMGPRS 'R2'+1=R0 @VM03170 00744000
- L R9,0(R4) 'R2+1' = RESULT LIST VADDR @VA04548 00745000
- ICM R7,B'1111',0(R6) 'R2' = COUNT OF REQUESTS 00746000
- BC 12,SPECERR ZERO OR NEGATIVE 00747000
- CH R7,=H'1024' MAXIMUM NUMBER OF FULL-WORDS IN 00748000
- * PAGE 00749000
- BH SPECERR SORRY ABOUT THAT 00750000
- * CHECK FOR REQUEST LIST AND RESULT TABLE IN THE SAME PAGE 00751000
- L R1,XPAGNUM PAGE NUMBER MASK @VA04548 00752000
- LR R2,R1 ... @VA04548 00753000
- NR R1,R8 REQUEST LIST VIRT PAGE @VA04548 00754000
- NR R2,R9 RESULT LIST VIRT PAGE @VA04548 00755000
- CLR R1,R2 IN THE SAME VIRT PAGE? @VA04548 00756000
- BNE SPECERR NO - CALL IT AN ERROR 00757000
- TRANS 2,1,OPT=(BRING,DEFER),ADEX=SPECERR GET REAL PAGE@VA04548 00758000
- L R5,=A(X'00000FFF') DISPLACEMENT MASK @VA12292 00759010
- NR R8,R5 REQUEST LIST DISPLACEMENT @VA04548 00760000
- NR R9,R5 RESULT LIST DISPLACEMENT @VA04548 00761000
- ALR R5,R2 ADDR OF LAST ENTRY IN PAGE @VA04548 00762000
- LA R3,0(R2,R8) R3 = PAGE + DISP OF REQUEST LIST @VA04548 00763000
- ALR R2,R9 R2 = PAGE + DISP OF RESULT LIST @VA04548 00764000
- LA R4,4(0,0) FULL-WORD INDEX 00765000
- FETCHCP EQU * FULFILL REQUESTS @VA14557 00765100
- L R8,=A(DMKSYSRM) ADDR OF REAL MACHINE SIZE 00766000
- L R8,0(0,R8) GR8 = REAL MACHINE STORAGE SIZE 00767000
- L R10,0(0,R3) ONE REQUEST @VM03170 00769000
- N R10,=A(X'FFFFFF') ONLY WANT LAST THREE BYTES @VA12292 00770010
- CLR R10,R8 VALIDATE IT... @VM03170 00771000
- BNL ADDRERR .....SORRY, FELLOW 00772000
- SR R8,R10 HOW FAR FROM END OF STORAGE? @VA14557 00772100
- * THE FOLLOWING CHECKS IF ADDRESS IS WITHIN A FULLWORD @VA14557 00772200
- * FROM THE END OF REAL STORAGE. @VA14557 00772300
- CLR R8,R4 R4 CONTAINS 4 @VA14557 00772400
- BL CONTINUE LESS THAN A FULLWORD FROM END @VA14557 00772500
- * OF STORAGE. 00772600
- SR R8,R8 SET REG 8 -FLAG OF ZERO @VA14557 00772700
- CONTINUE CALL DMKPSASP CHECK RESULT TABLE PROTECTION @VA14557 00772800
- BNZ PROTERR .....SORRY, FELLOW 00774000
- TM APSTAT1,PROCIO @V4075A0 00775000
- BO GETIT O.K., WE'RE ON THE MAIN PROC @V4075A0 00776000
- L R0,XPAGNUM FIND PAGE NUMBER OF REQUEST @V4075A0 00777000
- NR R0,R10 @V4075A0 00778000
- BNZ QOURPSA IT'S NOT IN (0,4095) @V4075A0 00779000
- A R10,PREFIXB IT IS. POINT TO MAIN PROC PSA @V4075A0 00780000
- B GETIT & WE'RE ALL SET @V4075A0 00781000
- QOURPSA C R0,PREFIXA REQUEST FROM OUR PSA? @V4075A0 00782000
- BNE QABS0 NO, ONE OTHER POSSIBILITY @V4075A0 00783000
- S R10,PREFIXA LET PREFIX REGISTER DO THE WORK @V4075A0 00784000
- B GETIT @V4075A0 00785000
- QABS0 C R0,PREFIXB REQUEST FROM ABSOLUTE (0,4095) @V4075A0 00786000
- BNE GETIT NO, JUST AN ORDINARY OLD REQUEST @V4075A0 00787000
- S R10,PREFIXB RESET REVERSE PREFIXING @V4075A0 00788000
- A R10,PREFIXA FOR OUR PREFIX REGISTER VALUE @V4075A0 00789000
- GETIT EQU * @V4075A0 00790000
- LTR R8,R8 WITHIN LAST 3 BYTES OF STORAGE? @VA14557 00790100
- BZ SKIPIT N0- REGULAR REQUEST @VA14557 00790200
- CL R8,F3 3 BYTES FROM END OF STORAGE? @VA14557 00790300
- BNE NEXT NO @VA14557 00790400
- SR R8,R8 YES- GET DATA @VA14557 00790500
- ICM R8,B'1110',0(R10) 3 BYTES DATA WITH TRAILING @VA14557 00790600
- * ZEROS 00790700
- B DONE READY TO PASS BACK TO VM @VA14557 00790800
- NEXT CL R8,F2 2 BYTES FROM END OF STORAGE? @VA14557 00790900
- BNE NEXT1 NO @VA14557 00791000
- SR R8,R8 YES- GET DATA @VA14557 00791100
- ICM R8,B'1100',0(R10) 2 BYTES DATA WITH TRAILING @VA14557 00791200
- * ZEROS 00791300
- B DONE READY TO PASS BACK TO VM @VA14557 00791400
- NEXT1 SR R8,R8 1 BYTE FROM END OF STORAGE @VA14557 00791500
- ICM R8,B'1000',0(R10) 1 BYTE OF DATA WITH @VA14557 00791600
- * TRAILING ZEROS 00791700
- B DONE READY TO PASS BACK TO VM @VA14557 00791800
- SKIPIT L R8,0(0,R10) READ REAL STORAGE VALUE @VA14557 00791900
- DONE ST R8,0(0,R2) PASS BACK TO VIRTUAL MACHINE @VA14557 00792500
- BXH R3,R4,HVDEXIT EXIT IF WE RUN OUT OF THE PAGE @VM03170 00793000
- BXH R2,R4,HVDEXIT " " " " " " " " @VM03170 00794000
- BCT R7,FETCHCP LOOP THROUGH THE TABLES 00795000
- B HVDEXIT NO MORE REQUESTS @VM03170 00796000
- EJECT 00797000
- SPACE 00798000
- HVDDTC1 EQU * SET CONDITION CODE = 1 @VM03170 00799000
- LA R2,X'10' CONDITION CODE WILL BE ONE 00800000
- B HVDCSET GO SET CONDITION CODE @VM03170 00801000
- HVDDTC2 EQU * SET CONDITION CODE = 2 @VM03170 00802000
- LA R2,X'20' CONDITION CODE WILL BE TWO 00803000
- B HVDCSET GO SET CONDITION CODE @VM03170 00804000
- HVDDTC3 EQU * SET CONDITION CODE = 3 @VM03170 00805000
- LA R2,X'30' CONDITION CODE WILL BE THREE 00806000
- HVDCSET EQU * SET VIRTUAL CONDITION CODE @VM03170 00807000
- LA R1,VMPSW+4 POSITION IF IN BC MODE 00808000
- TM VMESTAT,VMEXTCM (IT'S DIFFERENT FOR ECMODE) 00809000
- BZ *+8 00810000
- LA R1,VMPSW+2 POSITION IF IN EC MODE 00811000
- NI 0(R1),B'11001111' CLEAR ANY EXITING CC @VM03170 00812000
- EX R2,HVDSETCC SET THE CONDITION CODE IN VMPSW @VM03170 00813000
- B HVDEXIT @VM03170 00814000
- SPACE 00815000
- HVDSETCC OI 0(R1),*-* EXECUTED FOR COND. CODE SETTING @VM03170 00816000
- EJECT 00817000
- *---------------------------------------------------------------------* 00818000
- * VIRTUAL DEVICE TYPE - CODE '024' FOR ANYBODY * 00819000
- * ------------------------------- * 00820000
- * RETURN VIRTUAL DEVICE TYPE CLASS, TYPE, MODEL, AND * 00821000
- * FEATURE CODES FOR VIRTUAL DEVICE ADDRESS PASSED IN 'R1' * 00822000
- * NON-ZERO CONDITION CODE = DEVICE ADDRESS INVALID OR * 00823000
- * VIRTUAL DEVICE DOES NOT EXIST. * 00824000
- *---------------------------------------------------------------------* 00825000
- HVDDTYP EQU * @VM03170 00826000
- NI VMPSW+4,X'CF' SET CONDITION CODE ZERO 00827000
- NI VMPSW+2,X'CF' SET EXTENDED COND CODE ZERO 00828000
- LR R10,R6 SAVE 'R2' FIELD ADDRESS 00829000
- L R1,0(0,R5) PICK UP VIRTUAL DEVICE ADDR. 00830000
- CL R1,FFS IS IT -1 00831000
- BNE CONDTYP NO -- NOT REQUEST FOR CONSOLE ADD@V200820 00832000
- LH R8,VMVTERM DSP TO VIRTUAL CONSOLE VDEVBLOK @V200820 00833000
- LTR R8,R8 IS THERE A CONSOLE ? @V200820 00834000
- BM HVDDTC3 NO -- SET CC = 3 @VM03170 00835000
- AL R8,VMDVSTRT GET THE VDEVBLOK ADDRESS @V200820 00836000
- CALL DMKSCNVD GET DEVICE ADDRESS IN GR1 @V200820 00837000
- ST R1,0(0,R5) RETURN ADDRESS TO CALLER IN 'R1' @V200820 00838000
- B GETRDEV GO GET REAL DEVICE INFORMATION @V200820 00839000
- CONDTYP EQU * CHECK FOR VALID DEVICE ADDRESS @V200820 00840000
- MAXDV R15 GET HIGHEST VALID ADDRESS IN GR15@V200820 00841000
- CLR R1,R15 VALID ADDRESS SPECIFIED ? @V200820 00842000
- BH HVDDTC3 NO - SET CONDITION CODE @VM03170 00843000
- CALL DMKSCNVU FIND VDEVBLOK 00844000
- BNZ HVDDTC3 NOT FOUND - ERROR @VM03170 00845000
- USING VDEVBLOK,R8 00846000
- GETRDEV EQU * 00847000
- L R7,VDEVREAL REAL DEVICE BLOCK ADDRESS 00848000
- USING RDEVBLOK,R7 00849000
- L R1,VDEVTYPC TYPC, TYPE, STAT, FLAG 00850000
- ST R1,0(0,R10) PASS BACK VIRTUAL RESULT 00851000
- TM VDEVSTAT,VDEVDED IS THIS DEVICE DEDICATED ? 00852000
- BO HVDDTYPR YES - GIVE REAL DEVICE INFO @VM03170 00853000
- TM VDEVTYPC,CLASURI+CLASURO+CLASSPEC .... 00854000
- BNZ HVDDTC2 IF ANY OF THESE, NO REAL DEVICE @VM03170 00855000
- * DATA 00856000
- TM VDEVTYPC,CLASGRAF IS THIS GRAPHIC ? @VM03170 00857000
- BO GRAFSECT YES, GET LINE SIZE @VM03170 00858000
- TM VDEVTYPC,CLASTERM TERMINAL ? 00859000
- BZ HVDDTYPR NO - OK. @VM03170 00860000
- CLI VDEVTYPE,TYP3210 VIRTUAL CONFOLE ? @VM03170 00861000
- BNE HVDDTC2 NO--SET CC=2 @VM03170 00862000
- L R7,VMTERM YES - GET TERMINAL REAL DEVICE 00864000
- * BLOCK 00865000
- GRAFSECT DS 0H @VA11489 00865500
- LTR R7,R7 MAKE SURE IT'S REALLY THERE 00866000
- BZ HVDDTC2 IF NOT (DISCONNECTED), FORGET IT.@VM03170 00867000
- TM RDEVTYPE,TYPBSC IS THIS A REMOTE GRAPHIC @VM03170 00868000
- * TERMINAL? 00869000
- BNO RDEVLEN NO...GET LINE LENGTH AS USUAL @VM03170 00870000
- DROP R8 @VM03170 00871000
- LH R8,VMTRMID GET RESOURCE ID OF USER @VM03170 00872000
- N R8,F4095 CLEAR LINE CODE PORTION @VM03170 00873000
- MH R8,=AL2(NICSIZE*8) COMPUTE NICBLOK LIST INDEX @VM03170 00874000
- AL R8,RDEVNICL INDEX TO THE ACTUAL NICBLOK @VM03170 00875000
- USING NICBLOK,R8 FOR THE REMOTE GRAPHIC TERMINAL @VM03170 00876000
- IC R1,NICTMCD GET TERMINAL CODES @VA09296 00876300
- STC R1,0(0,R5) SAVE IN HIGH ORDER BYTE OF 'R1' @VA09296 00876600
- IC R1,NICLLEN HERE'S THE LINE LENGTH WE WANT @VM03170 00877000
- ICM R1,B'0110',NICDTYPE DEVICE TYPE AND MODEL @VA09296 00878000
- ICM R1,B'1000',RDEVTYPC DEVICE CLASS - CLASTERM @VA09296 00878600
- B DTYPOK CONTINUE @VA09296 00879200
- RDEVLEN DS 0H 00880000
- IC R1,RDEVTMCD TERMINAL CODES @V60A6B6 00881000
- STC R1,0(0,R5) SAVE IN HIGH ORDER BYTE OF 'R1' @V60A6B6 00882000
- IC R1,RDEVLLEN TERMINAL LINE LENGTH @V60A6B6 00883000
- B DTYPR1 GET MODEL INFORMATION @V60A6B6 00884000
- HVDDTYPR EQU * FOR NON-CONSOLES... @VM03170 00885000
- IC R1,RDEVFTR GET FEATURE CODE @V1D2162 00886000
- DTYPR1 EQU * @VM03170 00887000
- ICM R1,B'0010',RDEVMDL GET MODEL NUMBER @V1D2162 00888000
- DTYPR2 EQU * @VA07289 00889000
- ICM R1,B'1100',RDEVTYPC GET DEVICE TYPE INFORMATION @V1D2162 00890000
- DROP R7,R8 00891000
- * IF ARGUMENT R2 EQ REG15 THEN IGNORE THE SECOND WORD 00892000
- DTYPOK DS 0H @VA09296 00892500
- LA R10,4(,R10) GET R2+4 ADDRESS @VM03170 00893000
- LA R15,VMGPRS+(4*15) GET ADDRESS OF REG 15 IN @VM03170 00894000
- * VMBLOCK 00895000
- CR R10,R15 IS R2+4 GREATER THAN REG 15 @VM03170 00896000
- BH HVDEXIT IGNORE THE SECOND WORD @VM03170 00897000
- ST R1,0(,R10) PASS THE SECOND WORD TO THE USER @VM03170 00898000
- B HVDEXIT @VM03170 00899000
- SPACE 2 00900000
- *---------------------------------------------------------------------* 00901000
- * SPOOL INPUT MANIPULATION - CODE '014' FOR ANYBODY * 00902000
- *---------------------------------------------------------------------* 00903000
- HVDSPRD EQU * @VM03170 00904000
- CALL DMKDRDER MANIPULATE SPOOL FILES 00905000
- LTR R2,R2 CHECK RETURN CODE 00906000
- BZ HVDEXIT ALL O.K. - CONDITION CODE SET @VM03170 00907000
- B PROGINT FORCE PROGRAM INTERRUPT 00908000
- SPACE 2 00909000
- *---------------------------------------------------------------------* 00910000
- * CLEAR LOGREC CYLINDERS - CODE '01C' FOR CLASS F ONLY * 00911000
- *---------------------------------------------------------------------* 00912000
- HVDLRER EQU * @VM03170 00913000
- TM VMCLEVEL,VMCLASSF ALLOWED ? 00914000
- BZ PRIVLGD NO - PRIVILEGED OPERATION 00915000
- ICM R2,B'1111',0(R5) PICK UP CODE @VM03170 00916000
- BZ SPECERR INVALID CODE @VM03170 00917000
- CL R2,F2 DOES CODE EXCEED THE MAX. CODE? @V5088AA 00918000
- BH SPECERR YES - INVALID CODE @VM03170 00919000
- CALL DMKIOEFM RE-FORMAT I/O AND M/C ERROR 00920000
- * RECORDING 00921000
- B HVDEXIT @VM03170 00922000
- SPACE 2 00923000
- EJECT 00924000
- *---------------------------------------------------------------------* 00925000
- * READ SYSTEM DUMP SPOOL FILE - CODE '034' FOR CLASS C OR E * 00926000
- *---------------------------------------------------------------------* 00927000
- HVDRSDF EQU * READ SYSTEM DUMP @VM03170 00928000
- TM VMCLEVEL,VMCLASSC+VMCLASSE SYSTEM EXAMINER ? 00929000
- BZ PRIVLGD NO - PRIVILEGED OPERATION 00930000
- CALL DMKDRDMP GO READ ONE RECORD 00931000
- LTR R2,R2 RETURN CODE O.K. ? 00932000
- BZ HVDEXIT YES - CONDITION CODE IS SET @VM03170 00933000
- B PROGINT FORCE PROGRAM INTERRUPT 00934000
- SPACE 2 00935000
- *---------------------------------------------------------------------* 00936000
- * READ SYMBOL TABLE - CODE '038' FOR CLASS C OR E ONLY * 00937000
- *---------------------------------------------------------------------* 00938000
- HVDRDSYM EQU * READ PAGEABLE SYMBOL TABLE @VM03170 00939000
- TM VMCLEVEL,VMCLASSC+VMCLASSE ALLOWED ? 00940000
- BZ PRIVLGD NOPE - ERROR 00941000
- CALL DMKDRDSY GO READ IT INTO VIRTUAL MEMORY 00942000
- LTR R2,R2 HOW DID IT GO ? 00943000
- BZ HVDEXIT ALL O.K. @VM03170 00944000
- B PROGINT INTERRUPT GOES BACK 00945000
- SPACE 2 00946000
- *---------------------------------------------------------------------* 01084000
- * DYNAMIC DIRECTORY UPDATE - CODE '03C' FOR A, B, OR C ONLY * 01085000
- *---------------------------------------------------------------------* 01086000
- HVDDIRCT EQU * @VM03170 01087000
- TM VMCLEVEL,VMCLASSA+VMCLASSB+VMCLASSC ALLOWED ? 01088000
- BZ PRIVLGD NO - STOP HIM COLD 01089000
- CALL DMKUDRDS GO DO IT 01090000
- LTR R2,R2 ALL O.K. ? 01091000
- BZ HVDEXIT YUP @VM03170 01092000
- B PROGINT NOPE 01093000
- SPACE 2 01094000
- *---------------------------------------------------------------------* 01095000
- * SAVE 370X CONTROL PROGRAM - CODE '050' FOR CLASS A,B,C ONLY * 01096000
- *---------------------------------------------------------------------* 01097000
- HVD3705 EQU * @VM03170 01098000
- TM VMCLEVEL,VMCLASSA+VMCLASSB+VMCLASSC ALLOWED @V200820 01099000
- BZ PRIVLGD NO -- STOP HIM COLD @V200820 01100000
- CALL DMKSNCP R5,R6 SETUP AS REQUIRED @V200820 01101000
- LTR R2,R2 ALL O.K. ? @V200820 01102000
- BZ HVDEXIT YUP --- @VM03170 01103000
- B PROGINT NOPE - @V200820 01104000
- EJECT 01105000
- ADDCHEK EQU * EXAMINE ADDRESS FOR VALIDITY 01106000
- LA R1,0(,R1) 24 BITS ONLY 01107000
- LCTL C1,C1,VMSEG GET CORRECT SEG TABLE @VA08882 01107500
- LRA R0,0(,R1) VALID START ADDRESS ? @VM03170 01108000
- BC 8+2,ADDCHEK1 CONTINUE IF NOT A SEG EXCEPTION @V408246 01109000
- LR R0,R2 SAVE R2 FOR CALL TO PTRAN @V408246 01110000
- CALL DMKPTRAN,PARM=DEFER OTHERWISE LET PTRAN HANDLE @V408246 01111000
- BC 2,ADDRERR ADDRESSING EXCEPTION @V408246 01112000
- LR R2,R0 RESTORE R2 @V408246 01113000
- ADDCHEK1 DS 0H @V408246 01114000
- LA R14,0(R2,R1) R2 CONTAINS FIELD LENGTH 01115000
- BCTR R14,0 BACK UP TO LAST BYTE OF FIELD 01116000
- L R15,XPAGNUM PAGE NUMBER MASK 01117000
- NR R14,R15 ENDING PAGE ADDRESS 01118000
- LRA R0,0(,R14) IS ENDING ADDRESS VALID ? @VM03170 01119000
- BC 8+2,ADDCHEK2 CONTINUE IF NOT A SEG EXCEPTION @V408246 01120000
- STM R1,R2,SAVEWRK2 SAVE R1,R2 ACROSS CALL TO PTRAN @VA10736 01121500
- LR R1,R14 GET VIRT ADDRESS FOR PTRAN @VA08590 01123000
- CALL DMKPTRAN,PARM=DEFER OTHERWISE LET PTRAN HANDLE @V408246 01124000
- BC 2,ADDRERR ADDRESSING ERROR @V408246 01125000
- LM R1,R2,SAVEWRK2 RESTORE R1,R2 AFTER CALL @VA10736 01126500
- B ADDCHEK1 GO TRY AGAIN @V408246 01128000
- ADDCHEK2 DS 0H @V408246 01129000
- NR R15,R1 STARTING PAGE ADDRESS 01130000
- CLR R14,R15 CHECK FOR PAGE BOUNDARY CROSSING 01131000
- BCR 7,R9 YUP -- TAKE THE GR9 EXIT 01132000
- BR R10 RETURN - EVERYTHING IS O.K. 01133000
- SPACE 2 01134000
- EJECT 01135000
- *---------------------------------------------------------------------* 01136000
- * PUNCH VIRTUAL ACCOUNTING CARD - CODE '04C' FOR ANYBODY * 01137000
- * (VIRTUAL MACHINE MUST HAVE 'ACCOUNT' OPTION SET) * 01138000
- * ---------------------------------- * 01139000
- * 'R1' = ADDRESS OF DBL-WD ALIGNED 24-BYTE PARM LIST * 01140000
- * 'R2' = HEX CODE INDICATING ACCOUNTING OPTION * 01141000
- * OR * 01142000
- * PUNCH SPECIAL USER ACCOUNTING CARD * 01143000
- * ---------------------------------- * 01144000
- * 'R1' = ADDRESS OF DATA TO BE PUNCHED ON CARD * 01145000
- * 'R2' = HEX CODE X'0010' INDICATING SPECIAL CARD * 01146000
- * ('R2' CANNOT BE REGISTER 15) * 01147000
- * 'R2+1' = LENGTH OF DATA AREA 0 < LENGTH <= 70 * 01148000
- *---------------------------------------------------------------------* 01149000
- HVDACCT EQU * @VM03170 01150000
- NI VMPSW+2,X'FF'-X'30' CLEAR CONDITION CODE FIELD 01151000
- * TO ZERO 01152000
- NI VMPSW+4,X'FF'-X'30' CLEAR CONDITION CODE FIELD 01153000
- * TO ZERO 01154000
- TM VMPSTAT,VMACCOUN IS THE ACCOUNTING OPTION SET ? 01155000
- BZ HVDDTC1 NO, GO SET CONDITION CODE @VM03170 01156000
- LA R15,16 LOAD CODE X'10' FOR COMPARISON @VM03170 01157000
- C R15,0(,R6) SEE IF USER SPECIFIED X'10' @VM03170 01158000
- BNE STDACNT NORMAL PROCESSING, IF NOT @VM03170 01159000
- LA R9,4(,R6) GET ADDRESS OF RY+1 (LENGTH) @VM03170 01160000
- LA R15,VMGPRS+(4*15) GET ADDRESS OF END OF REGS @VM03170 01161000
- CR R9,R15 COMPARE WITH A(RY+1) @VM03170 01162000
- LA R9,SPECERR USEFUL FOR BALR'S AND ADDCHEK @VM03170 01163000
- BCR 2,R9 CANNOT SPECIFY RY=R15 @VM03170 01164000
- ICM R3,B'1111',4(R6) PICK UP LENGTH @VM03170 01165000
- BCR 12,R9 MUST BE > 0 @VM03170 01166000
- CH R3,=H'70' CHECK FOR MAX LENGTH @VM03170 01167000
- BCR 2,R9 MUST BE <= 70 @VM03170 01168000
- L R1,0(,R5) GET USER ADDRESS FOR ADDCHEK @VM03170 01169000
- LR R2,R3 AND LENGTH FOR SAME @VM03170 01170000
- BAL R10,ADDCHEK CHECK FOR PAGE CROSSING @VM03170 01171000
- LA R0,ACNTSIZE GET SIZE OF ACNT BUFFER @VM03170 01172000
- CALL DMKFREE NOW, GET THE BUFFER @VM03170 01173000
- LR R4,R1 R4 IS PARMREG FOR ACNT QUEUING @VM03170 01174000
- USING ACNTBLOK,R4 @VM03170 01175000
- MVI ACNTDATA,C' ' SET UP TO BLANK DATA FIELDS @VM03170 01176000
- MVC ACNTDATA+1(79),ACNTDATA BLANK OUT THE CARD AREA @VM03170 01177000
- L R5,0(,R5) PICK UP USER DATA ADDRESS @VM03170 01178000
- LA R1,0(0,R5) PLACE THE ADDRESS NEATLY INTO R1 @VM03170 01179000
- TRANS 9,1,OPT=(BRING,DEFER) @VM03170 01180000
- BCTR R3,0 SUBTRACT 1 FOR EXECUTE @VM03170 01181000
- EX R3,MVACDATA MOVE DATA INTO ACNTBLOK @VM03170 01182000
- MVC ACNTUSER,VMUSER MOVE USERID INTO ACNTBLOK @VM03170 01183000
- MVC ACNTCODE,=C'C0' SET SPECIAL CARD CODE @VM03170 01184000
- CALL DMKACOQU PUT THE CARD IN THE ACCNT CHAIN @VM03170 01185000
- B HVDEXIT OK - RETURN TO CALLER @VM03170 01186000
- MVACDATA MVC ACNTNUM(*-*),0(R9) @VM03170 01187000
- DROP R4 @VM03170 01188000
- SPACE 1 01189000
- STDACNT EQU * @VM03170 01190000
- ICM R15,15,VMACOUNT ACCOUNT FOR SOMEELSE? @V408246 01191000
- BZ *+8 NO @V408246 01192000
- MVI VMPSWDCT,0 YES, ALSO RESET LINK COUNT @V408246 01193000
- CALL DMKCPVAA GO PUNCH ACCOUNTING RECORDS 01194000
- SR R3,R3 CLEAR THE REGISTER 01195000
- BAL R8,RELSTOR1 GO RELEASE THE STORAGE 01196000
- TM 3(R5),X'07' IS THE ADDRESS ALIGNMENT CORRECT 01197000
- BNZ SPECERR NO, GO GIVE SPECIFICATION CHECK 01198000
- ICM R1,15,0(R5) GET THE ADDRESS OF THE 01199000
- * PARAMETER LIST 01200000
- BZ HVDEXIT IF ZERO, GO RETURN TO USER @VM03170 01201000
- LA R2,24(0) GET THE LENGTH OF THE PARAMETER 01202000
- * LIST 01203000
- LA R9,HVDACT GET THE RETURN ADDRESS IF THE @VM03170 01204000
- * PARAMETER 01205000
- * CROSS A PAGE BOUNDARY 01206000
- BAL R10,ADDCHEK CHECK PAGE CROSS - VALIDITY 01207000
- HVDACT EQU * @VM03170 01208000
- LA R0,UDBFSIZE GET THE DIRECTORY BUFFER BLOCK 01209000
- * LENGTH 01210000
- CALL DMKFREE GET SPACE FOR BLOCK 01211000
- LR R4,R1 SAVE THE POINTER TO THE DIRECTORY 01212000
- * BUFFER 01213000
- USING UDBFBLOK,R4 SETUP ADDRESSABILITY FOR 01214000
- * DIRECTORY 01215000
- * BUFFER 01216000
- XC UDBFVADD(8),UDBFVADD CLEAR THE DOUBLEWORD FIELD 01217000
- L R5,0(0,R5) GET THE ADDRESS OF THE 01218000
- * PARAMETER LIST 01219000
- LA R1,0(0,R5) GET THE ADDRESS OF THE FIRST 01220000
- * PARAMETER 01221000
- TRANS 9,1,OPT=(BRING,DEFER) 01222000
- LR R1,R9 GET THE ADDRESS OF THE PARAMETER 01223000
- LR R2,R4 GET ADDRESS OF DIRECTORY BUFFER 01224000
- LA R0,8 GET THE LENGTH OF THE FIRST 01225000
- * PARAMETER 01226000
- CALL DMKUDRFU GO FIND THE USER ID 01227000
- BNZ CPVACCT2 NO, GO SET CONDITION CODE FOR 01228000
- * INVALID 01229000
- * USER ID. 01230000
- LA R0,ACCTLENG GET THE LENGTH OF THE 01231000
- * ACCOUNTING BLOCK 01232000
- CALL DMKFREE GET THE SPACE FOR ACCOUNTING 01233000
- * BLOCK 01234000
- USING UDIRBLOK,R4 SETUP ADDRESSABILITY FOR USER 01235000
- * DIRECTORY 01236000
- LR R3,R1 SAVE THE ADDRESS OF THE 01237000
- * ACCOUNTING BLK. 01238000
- USING ACCTBLOK,R3 SETUP ADDRESSABILITY FOR THE 01239000
- * ACCOUNTING 01240000
- * BLOCK 01241000
- MVC ACCTUSER(8),UDIRUSER GET THE USER ID FROM THE 01242000
- * DIRECTORY 01243000
- LA R1,UDIRDISP POINT TO THE DASD ADDRESS 01244000
- CALL DMKUDRMD GO GET THE USER MACHINE BLOCK @V407466 01245000
- BNZ CPVACCT3 ERROR GETTING MACHINE BLOCK 01246000
- USING UMACBLOK,R4 SETUP ADDRESSABILITY FOR USER 01247000
- * MACHINE 01248000
- * BLOCK 01249000
- MVC ACCTACNO(16),UMACACCT GET THE ACCOUNT 01250000
- * NUMBER AND DISTRIBUTION NUMBER 01251000
- L R6,0(0,R6) GET THE STATUS CODE 01252000
- LTR R6,R6 IS THE STATUS CODE ZERO ? 01253000
- BZ CPVACCT1 IF ZERO, GO RELEASE STORAGE 01254000
- LA R1,8(0,R5) GET THE ADDRESS OF THE SECOND 01255000
- * PARAMETER 01256000
- TRANS 9,1,OPT=(BRING,DEFER) 01257000
- C R6,F4 IS THE ACCOUNT NUMBER AVAILABLE ? 01258000
- BNE CPVDISTN NO, GO MOVE THE DISTRIBUTION 01259000
- * NUMBER 01260000
- MVC ACCTACNO(8),0(R9) GET THE ACCOUNT NUMBER FROM 01261000
- * THE 01262000
- * BUFFER FIELD 01263000
- B CPVACCT1 GO RELEASE STORAGE 01264000
- CPVDISTN EQU * 01265000
- C R6,F8 IS THE DISTRIBUTION NUMBER 01266000
- * AVAILABLE ? 01267000
- BNE CPVACDIS NO, GO MOVE THE ACCOUNT AND 01268000
- * DISTRIBUTION NUMBER INTO THE BLOCK 01269000
- CPVHVD1 EQU * @VM03170 01270000
- LA R1,16(0,R5) GET THE ADDRESS OF THE THIRD 01271000
- * PARAMETER 01272000
- TRANS 9,1,OPT=(BRING,DEFER) 01273000
- MVC ACCTDIST(8),0(R9) GET THE DISTRIBUTION NUMBER 01274000
- B CPVACCT1 GO RELEASE STORAGE 01275000
- CPVACDIS EQU * 01276000
- LA R8,12 GET THE FUNCTION CODE 01277000
- CR R6,R8 IS THE DISTRIBUTION AND ACCOUNT 01278000
- * NUMBER 01279000
- * AVAILABLE ? 01280000
- BNE CPVACCT3 NO, GO SET CONDITION CODE 3 01281000
- MVC ACCTACNO(8),0(R9) GET THE ACCOUNT NUMBER 01282000
- B CPVHVD1 GO GET THE DISTRIBUTION NUMBER @VM03170 01283000
- CPVACCT1 EQU * 01284000
- DROP R4,R3 DROP BASE REGISTERS FOR BLOCKS 01285000
- BAL R8,RELSTOR GO RELEASE STORAGE 01286000
- B HVDEXIT GO RETURN TO USER @VM03170 01287000
- CPVACCT2 EQU * 01288000
- BAL R8,RELSTOR GO RELEASE STORAGE 01289000
- B HVDDTC2 GO SET CONDITION CODE 2 @VM03170 01290000
- CPVACCT3 EQU * 01291000
- LR R1,R3 GET THE ADDRESS OF THE 01292000
- * ACCOUNTING BLOCK 01293000
- LA R0,ACCTLENG GET THE LENGTH OF THE 01294000
- * ACCOUNTING BLOCK 01295000
- CALL DMKFRET RELEASE THE STORAGE 01296000
- SR R3,R3 CLEAR THE POINTER TO THE 01297000
- * ACCOUNTING BLK 01298000
- BAL R8,RELSTOR GO RELEASE STORAGE 01299000
- B HVDDTC3 GO SET CONDITION CODE 3 @VM03170 01300000
- SPACE 4 01301000
- RELSTOR EQU * 01302000
- LR R2,R4 GET THE ADDRESS OF THE 01303000
- * DIRECTORY BLOCK 01304000
- CALL DMKUDRRV RELEASE THE DIRECTORY 01305000
- LR R1,R4 GET THE ADDRESS OF THE 01306000
- * DIRECTORY BLOCK 01307000
- LA R0,UDBFSIZE GET THE SIZE OF THE BLOCK 01308000
- CALL DMKFRET RELEASE THE STORAGE 01309000
- RELSTOR1 EQU * 01310000
- ICM R1,15,VMACOUNT GET THE ADDRESS OF THE 01311000
- * ACCOUNTING BLOCK 01312000
- BZ CPVADDR NO ADDRESS, GO SAVE POINTER 01313000
- LA R0,ACCTLENG GET THE LENGTH OF THE 01314000
- * ACCOUNTING BLOCK 01315000
- CALL DMKFRET RELEASE STORAGE 01316000
- CPVADDR EQU * 01317000
- ST R3,VMACOUNT SAVE THE NEW ACOUNTING BLOCK 01318000
- * POINTER 01319000
- BR R8 RETURN TO IN LINE CODE 01320000
- EJECT 01321000
- *---------------------------------------------------------------------* 01322000
- * LOAD/SAVE 3800 IMAGE LIBRARY - CLASS A, B, OR C ONLY * 01323000
- *---------------------------------------------------------------------* 01324000
- SPACE 01325000
- HVD3800 DS 0H @V60B9BA 01326000
- TM VMCLEVEL,VMCLASSA+VMCLASSB+VMCLASSC ALLOWED ? @V60B9BA 01327000
- BZ PRIVLGD GIVE HIM PRIV OP IF NOT @V60B9BA 01328000
- LA R9,VMGPRS+4*R15 TEST FOR REGISTER 15 @V60B9BA 01329000
- CR R6,R9 IS 'R2' = R15 ? @V60B9BA 01330000
- BE SPECERR XFER IF SO @V60B9BA 01331000
- CR R5,R9 IS 'R1' = R15 ? @V60B9BA 01332000
- BE SPECERR XFER IF SO @V60B9BA 01333000
- L R9,0(,R6) VIRTUAL ADDRESS @V60B9BA 01334000
- N R9,F4095 SEE IF IT'S ON PAGE BDY @V60B9BA 01335000
- BNZ SPECERR XFER IF NOT @V60B9BA 01336000
- L R9,4(,R6) NUMBER OF BYTES TO LOAD @V60B9BA 01337000
- LA R9,0(,R9) GET RID OF HI ORDER BYTE @V60B9BA 01338000
- AL R9,0(,R6) END ADDR OF THE LOAD/SAVE @V60B9BA 01339000
- C R9,VMSIZE IS IT PAST STORAGE ? @V60B9BA 01340000
- BNL ADDRERR ADDRESSING EXPT IF SO @V60B9BA 01341000
- L R1,=A(DMKQNTBL) LOAD ADDR OF NPRTBL @V60B9BA 01342000
- LTR R1,R1 ANY NAME3800 MACROS AT ALL? @V60B9BA 01343000
- BNP ERR3804 SYSTEM NOT FOUND @V60B9BA 01344000
- TRANS 2,1,OPT=(BRING,DEFER,SYSTEM) BRING NPRTBL IN @V60B9BA 01345000
- USING NPRTBL,R2 ADDRESSIBILITY @V60B9BA 01346000
- H38A CLC NPRNAME,0(R5) IS THIS THE SYSTEM ? @V60B9BA 01347000
- BE H38B XFER IF SO @V60B9BA 01348000
- AL R2,NPRPNT POINT NEXT ENTRY @V60B9BA 01349000
- CLC NPRPNT,ZEROES IS THIS THE DUMMY ENTRY ? @V60B9BA 01350000
- BNE H38A TRY AGAIN IF NOT @V60B9BA 01351000
- B ERR3804 SYSTEM NOT FOUND IF IT IS @V60B9BA 01352000
- SPACE 01353000
- H38B CLI NPRCNT,X'00' ANYTHING CURRENTLY ACTIVE ? @V60B9BA 01354000
- BNE ERR3808 XFER IF SO @V60B9BA 01355000
- LA R0,6 LENGTH OF VOLSER @V60B9BA 01356000
- LA R1,NPRVOL ADDRESS OF VOLSER @V60B9BA 01357000
- CALL DMKSCNVS LET'S TRY TO FIND THE DEVICE@V60B9BA 01358000
- BNZ ERR3810 VOLID NOT MOUNTED @V60B9BA 01359000
- LR R8,R1 RDEVBLOK TO R8 @V60B9BA 01360000
- USING RDEVBLOK,R8 ADDRESSIBILITY @V60B9BA 01361000
- TM RDEVFLAG,RDEVOWN OWNED VOLUME ? @V60B9BA 01362000
- BZ ERR380C ERROR IF NOT @V60B9BA 01363000
- L R9,4(,R6) NUMBER OF BYTES TO SAVE @V60B9BA 01364000
- LA R9,0(,R9) CLEAR HI ORDER BYTE @V60B9BA 01365000
- AL R9,F4095 ROUND UP TO A PAGE @V60B9BA 01366000
- SRL R9,12 GET NUMBER OF PAGES @V60B9BA 01367000
- C R9,NPRPAGCT MORE THAN WAS ALLOCATED ? @V60B9BA 01368000
- BH ERR3814 XFER IF SO @V60B9BA 01369000
- SPACE 01370000
- *. 01371000
- * WE NOW PROCEED TO LOAD/SAVE THE PAGES SPECIFIED BY THE 01372000
- * USER. THE FOLLOWING REGISTERS ARE USED: 01373000
- * R3 - PAGES/CYL FOR THE DEVICE 01374000
- * R4 - CCPD FOR THE PAGE TO BE MOVED 01375000
- * R7 - VIRTUAL ADDRESS FOR USER LOAD/SAVE 01376000
- * R9 - NUMBER OF PAGES LEFT TO BE MOVED 01377000
- * R15 - ADDRESS OF DMKRPAGT OR DMKRPAPT (LOAD OR SAVE) 01378000
- * IF THERE IS ANY ERROR LOADING/SAVING ANY PAGE, EXIT IS 01379000
- * MADE TO THE CALLER WITH A RETURN CODE OF X'18' IN 'R2'. 01380000
- * UPON SUCCESSFUL COMPLETION, THE SYSTEM IS LOADED/SAVED, 01381000
- * AND THE CALLER RECEIVES A RETURN CODE OF X'00' IN 'R2'. 01382000
- *. 01383000
- SPACE 01384000
- L R4,NPRSTART CCPD OF START OF SYSTEM @V60B9BA 01385000
- IC R4,RDEVCODE+1 INDEX TO OWNED VOL LIST @V60B9BA 01386000
- DROP R2 NO LONGER NEEDED @V60B9BA 01387000
- LA R3,32 PAGES/CYL ON 2314 @V60B9BA 01388000
- TM RDEVTYPE,TYP2314 IS IT A 2314 ? @V60B9BA 01389000
- BO GOTMAXPG XFER IF SO @V60B9BA 01390000
- LA R3,120 PAGES/CYL FOR A 3350 @V60B9BA 01391000
- CLI RDEVTYPE,TYP3350 IS IT A 3350 ? @V60B9BA 01392000
- BE GOTMAXPG XFER IF SO @V60B9BA 01393000
- LA R3,57 PAGES/CYL FOR A 3330 @V60B9BA 01394000
- TM RDEVTYPE,TYP3330 IS IT A 3330 ? @V60B9BA 01395000
- BO GOTMAXPG XFER IF SO @V60B9BA 01396000
- LA R3,24 MUST BE A 3340 OR 2305 @V60B9BA 01397000
- DROP R8 NO LONGER NEEDED @V60B9BA 01398000
- SPACE 01399000
- GOTMAXPG SLL R3,8 GET PAGES INTO POSITION @V60B9BA 01400000
- L R7,0(,R6) STARTING VIRTUAL ADDRESS @V60B9BA 01401000
- H38LOOP CLI 4(R6),X'00' IS IT A LOAD ? @V60B9BA 01402000
- BE H38NOTR DON'T TRANS IF SO @V60B9BA 01403000
- LR R1,R7 TRANS IN THE ADDRESS @V60B9BA 01404000
- TRANS 2,1,OPT=(DEFER) WAIT FOR IT TO ARRIVE @V60B9BA 01405000
- H38NOTR LR R1,R7 VIRTUAL ADDRESS TO SAVE/LD @V60B9BA 01406000
- LR R0,R4 CCPD OF DASD ADDRESS @V60B9BA 01407000
- L R15,=A(DMKRPAGT) ASSUME A LOAD OPERATION @V60B9BA 01408000
- CLI 4(R6),X'00' IS IT A LOAD ? @V60B9BA 01409000
- BE *+8 XFER IF SO @V60B9BA 01410000
- L R15,=A(DMKRPAPT) IT MUST BE A SAVE OPERATION @V60B9BA 01411000
- CALL (15),PARM=0 LOAD->ASSIGN PAGE TO USER @V60B9BA 01412000
- * SAVE->PUT PAGE TO DASD @V60B9BA 01413000
- BNZ ERR3818 PAGING ERROR - TELL HIM @V60B9BA 01414000
- AL R4,F256 BUMP CCPD TO NEXT PAGE @V60B9BA 01415000
- LR R1,R4 CCPD TO R1 FOR WORK @V60B9BA 01416000
- N R1,=X'0000FF00' ISOLATE PAGE NUMBER @V60B9BA 01417000
- CR R1,R3 REACHED MAXIMUM ? @V60B9BA 01418000
- BNH PAGBUMP XFER IF NOT @V60B9BA 01419000
- AL R4,=X'00010000' BUMP TO NEXT CYLINDER @V60B9BA 01420000
- ICM R4,B'0010',F1+3 START AT PAGE ONE @V60B9BA 01421000
- PAGBUMP AL R7,F4096 NEXT VIRTUAL PAGE @V60B9BA 01422000
- BCT R9,H38LOOP DO IT FOR NEXT PAGE @V60B9BA 01423000
- SPACE 01424000
- MVC 0(4,R6),ZEROES ZERO RETURN CODE IN 'R2' @V60B9BA 01425000
- B HVDEXIT RETURN TO CALLER @V60B9BA 01426000
- SPACE 01427000
- ERR3804 MVC 0(4,R6),F4 RC04 - SYS NOT FOUND @V60B9BA 01428000
- B HVDEXIT RETURN TO CALLER @V60B9BA 01429000
- SPACE 01430000
- ERR3808 MVC 0(4,R6),F8 RC08 - CURR SYS ACTIVE @V60B9BA 01431000
- B HVDEXIT RETURN TO CALLER @V60B9BA 01432000
- SPACE 01433000
- ERR380C MVC 0(4,R6),=F'12' RC0C - VOLID NOT CP-OWNED @V60B9BA 01434000
- B HVDEXIT RETURN TO CALLER @V60B9BA 01435000
- SPACE 01436000
- ERR3810 MVC 0(4,R6),F16 RC10 - VOLID NOT MOUNTED @V60B9BA 01437000
- B HVDEXIT RETURN TO CALLER @V60B9BA 01438000
- SPACE 01439000
- ERR3814 MVC 0(4,R6),F20 RC14 - TOO MANY PAGES REQSTD@V60B9BA 01440000
- USING NPRTBL,R2 USE REG 2 @VMI0005 01441000
- L R9,4(,R6) NUMBER OF BYTES TO SAVE @VMI0005 01442000
- LA R9,0(R9) ADDRESS ONLY @VMI0005 01443000
- L R10,NPRPAGCT NUMBER OF PAGES ALLOCATED @VMI0005 01444000
- SLL R10,12 CONVERT TO BYTES @VMI0005 01445000
- SR R9,R10 CALC RESIDUAL COUNT IN BYTES@VMI0005 01446000
- ST R9,4(,R6) STORE IN USER'S REG @VMI0005 01447000
- DROP R2 DROP REG 2 @VMI0005 01448000
- B HVDEXIT RETURN TO CALLER @V60B9BA 01449000
- SPACE 01450000
- ERR3818 MVC 0(4,R6),F24 RC18 - PAGING ERROR @V60B9BA 01451000
- B HVDEXIT RETURN TO CALLER @V60B9BA 01452000
- EJECT 01453000
- SPECERR EQU * @V1D0631 01454000
- LA R0,X'06' INTERRUPT CODE 01455000
- B PROGINT 01456000
- SPACE 01457000
- ADDRERR EQU * REFLECT ADDRESSING ERROR 01458000
- LA R0,X'05' INTERRUPT CODE 01459000
- B PROGINT 01460000
- SPACE 01461000
- PROTERR EQU * REFLECT PROTECTION CHECK 01462000
- LA R0,X'04' INTERRUPT CODE 01463000
- B PROGINT 01464000
- SPACE 01465000
- PRIVLGD EQU * REFLECT PRIVILEGED OPERATION 01466000
- LA R0,X'02' INTERRUPT CODE 01467000
- SPACE 01468000
- PROGINT EQU * 01469000
- B HVDCC1 REFLECT PROGRAM INTERRUPT @VM03170 01470000
- EJECT 01471000
- *-------------------------------------------------------------- 01472000
- * DIAGNOSE X'84' - UPDATE CP DIRECTORY IN PLACE 01473000
- * 01474000
- * THIS CODE IS THE INTERFACE BETWEEN THE 'DIRECT MODULE' RUNNING 01475000
- * IN THE DIRECTORY MAINTENANCE VIRTUAL MACHINE AND THE CP CODE 01476000
- * THAT UPDATES THE DIRECTORY IN-PLACE. PARAMETRIC DATA IS PASSED 01477000
- * IN A PARAMETER LIST POINTED TO BY THE 'RX' REGISTER OF DIAGNOSE 01478000
- * INSTRUCTION X'84'. THE 'RY' REGISTER CONTAINS THE LENGTH 01479000
- * OF THE PARAMETER LIST (IN BYTES). 01480000
- * 01481000
- * THE CALLER MUST HAVE PRIVILEGE CLASS B. 01482000
- * 01483000
- * EXIT CONDITIONS: 01484000
- * CC = 0 UPDATE WAS SUCCESSFUL 01485000
- * CC = 1 ERROR. RY CONTAINS NUMERIC CODE SPECIFYING ERROR 01486000
- * RY = X'65' - PARAMETER LIST SIZE GR THAN 112 BYTES 01486100
- * X'66' - PARAMETER LIST SIZE LESS/EQ ZERO 01486200
- * 01487000
- *-------------------------------------------------------------- 01488000
- EXTRN DMKUDUMN @V60C1BD 01489000
- SPACE 1 01490000
- HVCDUIP EQU * @V60C1BD 01491000
- TM VMCLEVEL,VMCLASSB VALID CLASS? @V60C1BD 01492000
- BZ PRIVLGD BR IF NOT @V60C1BD 01493000
- SPACE 1 01494000
- * SET CC IN VPSW TO ERROR CONDITION FOR SAFETY. (IT WILL BE 01495000
- * SET TO NON-ERROR CONDITION IS THE UPDATE COMPLETES OKAY. 01496000
- TM VMESTAT,VMEXTCM EC MODE PSW? @V60C1BD 01497000
- BZ BCMODE BR IF BC MODE @V60C1BD 01498000
- OI VMPSW+2,X'30' CC=3 (IN CASE OF EC MODE PSW) @V60C1BD 01499000
- B *+8 @V60C1BD 01500000
- BCMODE OI VMPSW+4,X'30' CC=3 (IN CASE OF BC MODE PSW) @V60C1BD 01501000
- SPACE 1 01502000
- *-------------------------------------------------------------- 01503000
- * CHECK PARAMETER LIST: 01504000
- *-------------------------------------------------------------- 01505000
- L R2,0(,R6) GET LENGTH OF LIST FROM 'RY' @V60C1BD 01506000
- * CHECK THAT PARAMETER LIST DOESN'T EXCEED (96 BYTES) 01507000
- C R2,=F'112' IS LIST TOO LARGE? @VMI0026 01508000
- BH SIZERR01 BR IF YES, ... SIZE ERROR @V60C1BD 01509000
- LTR R2,R2 IS LIST SIZE LESS/EQ ZERO? @VA10682 01509100
- BNP SIZERR02 YES, BR TO HANDLE SIZE ERROR @VA10682 01509200
- SPACE 1 01510000
- * NOW, CHECK FOR CROSSING A PAGE BOUNDARY. 01511000
- * 'ADDCHEK' REQUIRES: R1 = STARTING ADDRESS, R2 = LENGTH 01512000
- * R9 = CROSS RETURN ADDRESS, R10 = NO CROSS RETURN ADDRESS. 01513000
- LR R3,R2 DUP TOTAL LENGTH @V60C1BD 01514000
- SR R4,R4 CLEAR REG @V60C1BD 01515000
- L R1,0(,R5) GET ADDRESS OF LIST FROM 'RX' @V60C1BD 01516000
- LA R10,GETAREA PREPARE FOR NO CROSS RETURN @V60C1BD 01517000
- BAL R9,ADDCHEK TO ROUTINE TO CHECK PAGE CROSSING@V60C1BD 01518000
- SPACE 1 01519000
- * HERE IF PARAMETER LIST CROSSES A PAGE BOUNDARY 01520000
- * CALCULATE LENGTH OF EACH PIECE. AT THIS POINT, R14 = ADDRESS 01521000
- * OF 1ST BYTE OF 2ND PAGE, R15 = ADDR OF 1ST BYTE OF 1ST PAGE. 01522000
- * R1 = ADDR OF PARAMETER LIST (IN 1ST PAGE) 01523000
- * R2 = LENGTH OF PARAMETER LIST 01524000
- LR R4,R2 DUP LENGTH @V60C1BD 01525000
- LR R3,R14 DUP ADDR OF 2ND PAGE @V60C1BD 01526000
- SLR R3,R1 CALC. LENGTH OF 1ST PIECE @V60C1BD 01527000
- SLR R4,R3 CALC. LENGTH OF 2ND PIECE @V60C1BD 01528000
- * GET FREE STORAGE TO SAVE THE PARAMETER LIST 01529000
- * R2 CONTAINS THE SIZE OF THE LIST 01530000
- GETAREA LR R0,R2 SPECIFY SIZE TO GET @V60C1BD 01531000
- A R0,=F'7' ADD SEVEN TO INSURE CORRECT SIZE @V60C1BD 01532000
- SRL R0,3 DIVIDE BY 8 FOR NO. OF DBL. WORDS@V60C1BD 01533000
- CALL DMKFREE GET REAL STORAGE FOR PARM. LIST @V60C1BD 01534000
- LR R9,R1 SAVE ADDRESS OF FREE STORAGE @V60C1BD 01535000
- SPACE 1 01536000
- * BRING VIRTUAL PAGE INTO STORAGE 01537000
- L R1,0(,R5) GET ORIGINAL VIRTUAL ADDRESS @V60C1BD 01538000
- TRANS 2,1,OPT=(BRING+DEFER) @V60C1BD 01539000
- SPACE 1 01540000
- * MOVE PARAMETER LIST FROM VIRTUAL TO REAL STORAGE 01541000
- * R1 = ADDRESS OF FREE STORAGE 01542000
- * R2 = REAL ADDRESS OF PARAMETER LIST 01543000
- LR R1,R9 GET SAVED FREE STORAGE ADDRESS @V60C1BD 01544000
- LR R7,R3 GET LEN. OF 1ST (OR ENTIRE) PIECE@VA10682 01545500
- BCTR R7,0 DECREMENT SIZE FOR EXECUTED MVC @V60C1BD 01547000
- EX R7,XMVPARM EXECUTED MVC TO MOVE PARM. LIST @V60C1BD 01548000
- SPACE 1 01549000
- * CHECK FOR 2ND PIECE IN DIFFERENT PAGE 01550000
- LTR R4,R4 IS THERE A SECOND PIECE? @V60C1BD 01551000
- BZ CALLUDU BR IF NOT @V60C1BD 01552000
- SPACE 1 01553000
- L R1,0(,R5) GET ORIGINAL VIRTUAL ADDRESS @V60C1BD 01554000
- ALR R1,R3 ADD LENGTH OF 1ST PIECE @V60C1BD 01555000
- TRANS 2,1,OPT=(BRING+DEFER) @V60C1BD 01556000
- SPACE 1 01557000
- LR R1,R9 GET ADDRESS OF FREE STORAGE @V60C1BD 01558000
- ALR R1,R3 ADD LENGTH OF 1ST PIECE @V60C1BD 01559000
- BCTR R4,0 DECREMENT 2ND LENGTH @V60C1BD 01560000
- EX R4,XMVPARM MOVE 2ND PIECE TO FREE STORAGE @V60C1BD 01561000
- SPACE 1 01562000
- * DMKUDU DOES THE REST OF THE WORK 01563000
- LR R1,R9 GET ADDRESS OF FREE STORAGE @V60C1BD 01564000
- CALLUDU CALL DMKUDUMN CALL DIRECTORY UPDATE RTN. @V60C1BD 01565000
- SPACE 1 01566000
- *-------------------------------------------------------------- 01567000
- * ON RETURN, IF THERE WERE ERRORS, SET CC = 1 AND VIRTUAL RY 01568000
- * TO THE ERROR CODE. 01569000
- *-------------------------------------------------------------- 01570000
- LA R4,X'DF' PREPARE TO SET CC = 1 ON RETURN @V60C1BD 01571000
- BNZ *+8 BR IF ERROR FROM DMKUDU @V60C1BD 01572000
- LA R4,X'CF' PREPARE TO SET CC = 0 ON RETURN @V60C1BD 01573000
- SPACE 1 01574000
- * RETURN FREE STORAGE 01575000
- L R0,0(,R6) GET ORIGINAL LENGTH OF LIST @V60C1BD 01576000
- A R0,=F'7' INSURE CORRECT SIZE @V60C1BD 01577000
- SRL R0,3 DIVIDE BY 8 TO GET DBL WORDS @V60C1BD 01578000
- LR R1,R9 GET FREE STORAGE ADDRESS @V60C1BD 01579000
- CALL DMKFRET @V60C1BD 01580000
- SPACE 1 01581000
- UIPERX ST R2,0(,R6) SET RETURN CODE IN REG "RY" @V60C1BD 01582000
- LA R3,VMPSW+4 PREPARE FOR SETTING BC CC @V60C1BD 01583000
- TM VMESTAT,VMEXTCM EC MODE VPSW? @V60C1BD 01584000
- BZ *+8 BR IF NOT @V60C1BD 01585000
- LA R3,VMPSW+2 PREPARE FOR SETTING EC CC @V60C1BD 01586000
- EX R4,XSETCC EXECUTE AN 'NI' TO SET CC IN VPSW@V60C1BD 01587000
- B HVDEXIT RETURN ------> @V60C1BD 01588000
- SPACE 1 01589000
- XSETCC NI 0(R3),*-* EXECUTED TO SET CC IN VPSW @V60C1BD 01590000
- XMVPARM MVC 0(*-*,R1),0(R2) EXECUTED FOR MOVING PLIST @V60C1BD 01591000
- SPACE 1 01592000
- *-------------------------------------------------------------- 01593000
- * ERROR SETTING CODE: 01594000
- *-------------------------------------------------------------- 01595000
- SIZERR01 DS 0H @V60C1BD 01596000
- LA R2,101 RETURN ERROR CODE @V60C1BD 01597000
- B UIPERR @V60C1BD 01598000
- SPACE 1 01599000
- SIZERR02 DS 0H @V60C1BD 01600000
- LA R2,102 RETURN ERROR CODE @V60C1BD 01601000
- SPACE 1 01602000
- UIPERR LA R4,X'10' PREPARE TO SET CC = 1 @V60C1BD 01603000
- B UIPERX GO TO RETURN @V60C1BD 01604000
- EJECT 01605000
- *----------------------------------------------------------------- 01606000
- * ENABLE PA2 EXTERNAL INTERRUPT 01607000
- *----------------------------------------------------------------- 01608000
- HVDEXPA EQU * @VM03170 01609000
- L R1,0(,R5) GET 'R1' VALUE @VM03170 01610000
- L R8,VMTERM GET ADDRESS OF RDEVBLOK @VM03170 01611000
- LTR R8,R8 DOES IT EXIST ? @VM03170 01612000
- BNP HVDEXIT NO, GET OUT @VM03170 01613000
- USING RDEVBLOK,R8 SETUP ADDRESSABILITY FOR RDEVBLOK@VM03170 01614000
- CLI RDEVTYPC,CLASTERM IS THIS A REMOTE 3270 @VM03170 01615000
- BNE TSTGRAF NO, TEST FOR LOCAL GRAPHIC @VM03170 01616000
- CLI RDEVTYPE,TYPBSC REMOTE 3270 LINE @VM03170 01617000
- BNE HVDEXIT NO, GET OUT @VM03170 01618000
- BAL R3,GETNICB FIND NICBLOK ADDRESS @VM03170 01619000
- USING NICBLOK,R2 SET UP ADDRESSABILITY FOR NICBLOK@VM03170 01620000
- TM NICTYPE,NICGRAF IS THIS A GRAPHIC DEVICE @VM03170 01621000
- BZ HVDEXIT NO, GET OUT.. @VM03170 01622000
- LTR R1,R1 IS THE INDICATOR ACTIVE @VM03170 01623000
- BZ HVDEXTOF NO, TURN OFF PA2 FLAG @VM03170 01624000
- HVDAPLON EQU * SET PA2 FLAG @VM03170 01625000
- OI VMQSTAT,VMPA2APL REFLECT EXTERNAL INTERRUPTS @VM03170 01626000
- B HVDEXIT GET OUT NOW..... @VM03170 01627000
- TSTGRAF EQU * CHECK FOR LOCAL GRAPHIC DEVICE @VM03170 01628000
- CLI RDEVTYPC,CLASGRAF IS IT A GRAPHIC DEVICE @VM03170 01629000
- BNE HVDEXIT NO, RETURN TO CALLER @VM03170 01630000
- TM RDEVTYPE,TYP3277+TYP3278 3270 DISPLAY? @V60A6B6 01631000
- BZ HVDEXIT NO, RETURN TO CALLER @V60A6B6 01632000
- LTR R1,R1 IS THE INDICATOR ON @VM03170 01633000
- BNZ HVDAPLON YES, SET PA2 FLAG @VM03170 01634000
- HVDEXTOF EQU * TURN OFF THE PA2 FLAG @VM03170 01635000
- NI VMQSTAT,X'FF'-VMPA2APL CLEAR PA2 FLAG @VM03170 01636000
- B HVDEXIT BYE @VM03170 01637000
- GETNICB EQU * SUBROUTINE TO GET NICBLOK ADDRESS@VM03170 01638000
- LH R2,VMTRMID RESOURCE REFERENCE @VM03170 01639000
- N R2,F4095 STRIP OFF DEVICE CODE @VM03170 01640000
- MH R2,=AL2(NICSIZE*8) CONVERT TO NICLIST INDEX @VM03170 01641000
- AL R2,RDEVNICL @VM03170 01642000
- BR R3 RETURN - NICBLOK IN GR2 @VM03170 01643000
- EJECT 01644000
- *---------------------------------------------------------------------* 01645000
- * ROUTINE TO INITIALIZE PROGRAM PRODUCT BIT MAP * 01646000
- *---------------------------------------------------------------------* 01647000
- DMKHVDPP RELOC @VMD0161 01648000
- L R1,=A(DMKCPEPP) GET ADDR OF PROGRAM PRODUCT MAP @VMD0161 01649000
- * OI 0(R1),X'80' TURN ON BIT FOR 01650000
- * OI 0(R1),X'40' TURN ON BIT FOR 01651000
- * OI 0(R1),X'20' TURN ON BIT FOR 01652000
- * OI 0(R1),X'10' TURN ON BIT FOR 01653000
- * OI 0(R1),X'08' TURN ON BIT FOR 01654000
- * OI 0(R1),X'04' TURN ON BIT FOR 01655000
- * OI 0(R1),X'02' TURN ON BIT FOR 01656000
- * OI 0(R1),X'01' TURN ON BIT FOR 01657000
- * OI 1(R1),X'80' TURN ON BIT FOR 01658000
- * OI 1(R1),X'40' TURN ON BIT FOR 01659000
- * OI 1(R1),X'20' TURN ON BIT FOR 01660000
- * OI 1(R1),X'10' TURN ON BIT FOR 01661000
- * OI 1(R1),X'08' TURN ON BIT FOR 01662000
- * OI 1(R1),X'04' TURN ON BIT FOR 01663000
- * OI 1(R1),X'02' TURN ON BIT FOR 01664000
- * OI 1(R1),X'01' TURN ON BIT FOR 01665000
- * OI 2(R1),X'80' TURN ON BIT FOR 01666000
- * OI 2(R1),X'40' TURN ON BIT FOR 01667000
- * OI 2(R1),X'20' TURN ON BIT FOR 01668000
- * OI 2(R1),X'10' TURN ON BIT FOR 01669000
- * OI 2(R1),X'08' TURN ON BIT FOR 01670000
- * OI 2(R1),X'04' TURN ON BIT FOR 01671000
- * OI 2(R1),X'02' TURN ON BIT FOR 01672000
- * OI 2(R1),X'01' TURN ON BIT FOR 01673000
- * OI 3(R1),X'80' TURN ON BIT FOR 01674000
- * OI 3(R1),X'40' TURN ON BIT FOR 01675000
- * OI 3(R1),X'20' TURN ON BIT FOR 01676000
- * OI 3(R1),X'10' TURN ON BIT FOR 01677000
- * OI 3(R1),X'08' TURN ON BIT FOR 01678000
- * OI 3(R1),X'04' TURN ON BIT FOR 01679000
- * OI 3(R1),X'02' TURN ON BIT FOR 01680000
- * OI 3(R1),X'01' TURN ON BIT FOR 01681000
- * OI 4(R1),X'80' TURN ON BIT FOR 01682000
- * OI 4(R1),X'40' TURN ON BIT FOR 01683000
- * OI 4(R1),X'20' TURN ON BIT FOR 01684000
- * OI 4(R1),X'10' TURN ON BIT FOR 01685000
- * OI 4(R1),X'08' TURN ON BIT FOR 01686000
- * OI 4(R1),X'04' TURN ON BIT FOR 01687000
- * OI 4(R1),X'02' TURN ON BIT FOR 01688000
- * OI 4(R1),X'01' TURN ON BIT FOR 01689000
- * OI 5(R1),X'80' TURN ON BIT FOR 01690000
- * OI 5(R1),X'40' TURN ON BIT FOR 01691000
- * OI 5(R1),X'20' TURN ON BIT FOR 01692000
- * OI 5(R1),X'10' TURN ON BIT FOR 01693000
- * OI 5(R1),X'08' TURN ON BIT FOR 01694000
- * OI 5(R1),X'04' TURN ON BIT FOR 01695000
- * OI 5(R1),X'02' TURN ON BIT FOR 01696000
- * OI 5(R1),X'01' TURN ON BIT FOR 01697000
- * OI 6(R1),X'80' TURN ON BIT FOR 01698000
- * OI 6(R1),X'40' TURN ON BIT FOR 01699000
- * OI 6(R1),X'20' TURN ON BIT FOR 01700000
- * OI 6(R1),X'10' TURN ON BIT FOR 01701000
- * OI 6(R1),X'08' TURN ON BIT FOR 01702000
- * OI 6(R1),X'04' TURN ON BIT FOR 01703000
- * OI 6(R1),X'02' TURN ON BIT FOR 01704000
- * OI 6(R1),X'01' TURN ON BIT FOR 01705000
- * OI 7(R1),X'80' TURN ON BIT FOR 01706000
- * OI 7(R1),X'40' TURN ON BIT FOR 01707000
- * OI 7(R1),X'20' TURN ON BIT FOR 01708000
- * OI 7(R1),X'10' TURN ON BIT FOR 01709000
- * OI 7(R1),X'08' TURN ON BIT FOR 01710000
- * OI 7(R1),X'04' TURN ON BIT FOR 01711000
- * OI 7(R1),X'02' TURN ON BIT FOR 01712000
- * OI 7(R1),X'01' TURN ON BIT FOR 01713000
- B GENEXIT RETURN TO CALLER @VMD0161 01714000
- EJECT 01715000
- EXTIDL EQU 32 LENGTH OF BUFFER FOR DIAG X'00' @VMD0161 01738000
- LTORG 01746000
- EJECT 01747000
- COPY EQU 01748000
- COPY VMBLOK 01749000
- COPY IOBLOKS (R9) @V1D0631 01750000
- PSA 01751000
- COPY UDIRECT 01752000
- COPY ACCOUNT 01753000
- COPY RBLOKS 01754000
- COPY VBLOKS 01755000
- COPY DEVTYPES 01756000
- COPY SAVE @VM03170 01757000
- EJECT 01758000
- COPY NETWORK @VM03170 01759000
- COPY NPRTBL @V60B9BA 01760000
- END DMKHVDAL 01761000
ibm/vm370-lib/cp/dmkhvd.assemble_src.txt · Last modified: 2023/08/06 13:37 by Site Administrator