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