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