UDU TITLE 'DMKUDU (CP) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE SEQUENCING OF INPUT 00002000
*. 00003000
* MODULE NAME 00004000
* 00005000
* DMKUDU USER DIRECTORY UPDATE MODULE 00006000
* ...NEW MODULE TO SUPPORT DIRECTORY UPDATE- 00007000
* IN-PLACE FUNCTION. 00008000
* 00009000
* FUNCTION 00010000
* 00011000
* UPDATE THE CP DIRECTORY DIRECTLY IN PLACE ON THE 00012000
* OBJECT DASD PAGE AND THE VIRTUAL SYSTEM PAGE (IF USED) 00013000
* ON THE PAGING DEVICE. 00014000
* 00015000
* ATTRIBUTES 00016000
* 00017000
* REENTRANT, PAGEABLE 00018000
* 00019000
* ENTRY POINTS 00020000
* 00021000
* DMKUDUMN UPDATE DIRECTORY 00022000
* 00023000
* ENTRY CONDITIONS 00024000
* 00025000
* R1 CONTAINS THE REAL ADDRESS OF THE PARAMETER LIST 00026000
* 00027000
* EXIT CONDITIONS 00028000
* 00029000
* CC = 0 UPDATE WAS SUCCESSFUL 00030000
* CC = 2 ERROR, R2 CONTAINS ERROR CODE 00031000
* 00032000
* CALLS TO OTHER ROUTINES 00033000
* 00034000
* DMKCPVAC TO CALL 'ACNT' CMD PROCESSOR 00035000
* DMKFREE TO OBTAIN FREE STORAGE 00036000
* DMKFRET TO RETURN FREE STORAGE 00037000
* DMKLOCKQ TO LOCK THE CP DIRECTORY 00038000
* DMKLOCKD TO UNLOCK THE CP DIRECTORY 00039000
* DMKPGTVG TO OBTAIN A VIRTUAL SYSTEM PAGE 00040000
* DMKPGTVR TO RETURN A VIRTUAL SYSTEM PAGE 00041000
* DMKRPAGT TO READ A PAGE FROM DASD 00042000
* DMKRPAPT TO WRITE A PAGE TO DASD 00043000
* DMKSCNAU TO LOCATE A USER'S VMBLOK 00044000
* DMKLOKSW TO SWITCH TO ANOTHER VMBLOK 00044100
* 00045000
* EXTERNAL REFERENCES 00046000
* 00047000
* DMKSYSPL POINTER TO START OF DIRECTORY ON SYSRES 00048000
* DMKSYSUD DASD ADDRESS (0CCCPPDD) OF DIRECTORY 00049000
* 00050000
* 00051000
* TABLES / WORK AREAS 00052000
* 00053000
* UNCNTRL A CONTROL BLOCK BUILT IN FREE STORAGE 00054000
* UIPARMS A CONTROL BLOCK, CONTIGUOUS WITH UCNTRL, 00055000
* CONTAINING THE PARAMETERS OF THE OPERATION 00056000
* 00057000
* 00058000
* OPERATION (SPECIFIC DETAILS OF EACH OPERATION ARE GIVEN 00059000
* IN ROUTINE PREFACES) 00060000
* 00061000
* THE FOLLOWING IS COMMON FUNCTION TO ALL OPERATIONS: 00062000
* 00063000
* 1. OBTAIN FREE STORAGE (VIA DMKFREE) FOR CONTROL BLOCKS 00064000
* UCNTRL AND UIPARMS AND MOVE PARAMETERS INTO THIS 00065000
* STORAGE. 00066000
* 00067000
* 2. LOCK THE CP DIRECTORY 00068000
* 00069000
* 3. READ UDIRBLOKS AND LOCATE DATA FOR SPECIFIED USERID. 00070000
* 00071000
* 4. IDENTIFY THE OPERATIONS AND BRANCH TO PROCESSOR FOR 00072000
* REQUESTED FUNCTION. 00073000
* 00074000
* 5. ON RETURN, IF THERE WAS NO ERROR, TEST WHETHER 00075000
* OPERATION INVOLVES UPDATING UDIRBLOCK. IF NOT, GO TO 00076000
* STEP 7. 00077000
* 00078000
* 6. LOCATE THE SWPTABLE FOR THE VIRTUAL SYSTEM PAGE 00079000
* CONTAINING THE UDIRBLOK AND SAVE THE 'SWPCYL', 00080000
* 'SWPDPAGE', AND 'SWPCODE' FOR LATER USE. 00081000
* 00082000
* 7. WRITE THE UPDATED PAGE TO THE OBJECT DASD. 00083000
* 00084000
* 8. IF THE OPERATION DOES NOT INVOLVE A UDIRBLOK, GO TO 00085000
* STEP 10. 00086000
* 00087000
* 9. WRITE THE PAGE CONTAINING THE UPDATED UDIRBLOK TO 00088000
* PAGING DASD. 00089000
* 00090000
* 10. UNLOCK THE DIRECTORY. 00091000
* 00092000
* 11. RETURN FREE STORAGE OBTAINED FOR CONTROL BLOCKS. 00093000
* 00094000
* 12. RETURN SYSTEM VIRTUAL PAGE OBTAINED FOR HOLDING 00095000
* UMAC AND UDEV BLOCKS (IF NECESSARY). 00096000
* 00097000
* 13. RETURN TO CALLER WITH CC SET AND RETCODE IN R2 00098000
* 00099000
* 00100000
* REGISTER USAGE 00101000
* 00102000
* R0 = DASD PTR 00103000
* R1 = REAL ADDRESS OF PAGE IN STORAGE AND PARMETER 00104000
* REGISTER 00105000
* R2 = UDIRBLOK POINTER AND OPTIONS REGISTER 00106000
* R3 = UNCTRL REGISTER 00107000
* R4 = POINTER TO LIST OF DIRECTORY PAGES, 00108000
* POINTER TO UPDATED VIRTUAL PAGE 00109000
* R5 = CONTAINS ADDRESS OF END OF PAGE 00110000
* ...SAVE SWPCYL DATA 00111000
* R6 = CONTAINS REAL ADDRESS OF PAGE 00112000
* R7 = WORK REGISTER, SWAPTABLE POINTER 00113000
* R8 = WORK REGISTER 00114000
* R9 = WORK REGISTER AND INTERNAL LINKS 00115000
* R10 = POINTER TO SYSLOCS 00116000
* R11 = VMBLOK 00117000
* R12 = BASE 00118000
* R13 = SAVE 00119000
* R14 = SYSTEM USE 00120000
* R15 = SYSTEM USE 00121000
* 00122000
* 00123000
* MESSAGES 00124000
* 00125000
* NONE 00126000
* 00127000
* 00128000
* 00129000
*. 00130000
EJECT 00131000
COPY OPTIONS @VA10286 00131500
SPACE 3 00131600
DMKUDU CSECT @V60C1BD 00132000
USING PSA,R0 @V60C1BD 00133000
USING SYSLOCS,R10 @V60C1BD 00134000
USING VMBLOK,R11 @V60C1BD 00135000
USING DMKUDU,R12 @V60C1BD 00136000
USING SAVEAREA,R13 @V60C1BD 00137000
SPACE 3 00138000
EXTRN DMKPGTVG,DMKPGTVR @V60C1BD 00139000
EXTRN DMKRPAPT,DMKRPAGT @V60C1BD 00140000
EXTRN DMKSYSOW,DMKSYSOC @V60C1BD 00141000
EXTRN DMKLOCKQ,DMKLOCKD @V60C1BD 00142000
EXTRN DMKSCNAU,DMKCPVAC @V60C1BD 00143000
SPACE 2 00144000
DC CL8'DMKUDU' @V60C1BD 00145000
EJECT 00146000
DMKUDUMN RELOC @V60C1BD 00147000
SPACE 1 00148000
LR R7,R1 SAVE R1 OVER CALL @V60C1BD 00149000
L R10,ASYSLC POINT TO SYSLOCS @V60C1BD 00150000
SPACE 1 00151000
* GET FREE STORAGE FOR UCNTRL CONTROL BLOCK 00152000
LA R0,UCNTRLSZ+UIPARMSZ SPECIFY SIZE TO GET @V60C1BD 00153000
CALL DMKFREE @V60C1BD 00154000
LR R3,R1 USE R3 FOR UCNTRL ADDRESSABILITY @V60C1BD 00155000
USING UCNTRL,R3 @V60C1BD 00156000
SPACE 1 00157000
* CLEAR CONTROL BLOCK AND SET UP PARAMETERS 00158000
XC UCNTRL(UCNTRLSZ*8+UIPARMSZ*8),UCNTRL CLR UCNTRL@V60C1BD 00159000
MVC UIPARMS(UIPARMSZ*8),0(R7) MOVE PARMS TO CTL BLK@V60C1BD 00160000
SPACE 1 00161000
* ALTER USERID AND PASSWORDS IN PARAMETER LIST WITH MASK 00162000
XC UUSERID(L'UUSERID+L'UCURPASS),MASK MASK 2 FLDS @V60C1BD 00163000
MVC UDEVCODE(1),DMKSYSUD+3 SAVE DASD DEVICE CODE @V60C1BD 00164000
SPACE 1 00165000
* LOCATE THE UDIRBLOK FOR THE USERID 00166000
* LOCK THE DIRECTORY FIRST 00167000
LOCKDIR LA R1,=CL8' DIRCT' @V60C1BD 00168000
CALL DMKLOCKQ LOCK DIRECTORY @V60C1BD 00169000
SPACE 1 00170000
BAL R9,READUDIR LOCATE UDIRBLOK FOR USER @V60C1BD 00171000
BNZ PREXIT BR IF ERROR @V60C1BD 00172000
EJECT 00173000
*-------------------------------------------------------------- 00174000
* IDENTIFY OPERATION AND BRANCH TO THE ROUTINE TO PROCESS IT 00175000
*-------------------------------------------------------------- 00176000
LA R14,OPTABLE @V60C1BD 00177000
USING OPRSECT,R14 @V60C1BD 00178000
COP CLC OPERATN(L'UOP),UOP IS THIS THE OPERATION? @V60C1BD 00179000
BE OPFOUND BR IF YES @V60C1BD 00180000
CLI OPERATN,X'FF' END OF TABLE? @V60C1BD 00181000
LA R14,LOPTABLE(,R14) INCREMENT TO NEXT ENTRY @V60C1BD 00182000
BNE COP BR IF NOT END OF TABLE, CONTINUE @V60C1BD 00183000
SPACE 1 00184000
* NO OPERATION MATCH FOUND... ERROR! 00185000
LA R15,ERROP GET ERROR CODE @V60C1BD 00186000
STH R15,URETCODE STORE IN CONTROL @V60C1BD 00187000
B PREXIT @V60C1BD 00188000
SPACE 1 00189000
* THE OPERATION HAS BEEN IDENTIFIED 00190000
OPFOUND LH R14,OPADDR GET ROUTINE ADDRESS (DISPLACEMENT) @V60C1BD 00191000
LA R14,0(R12,R14) ADD IN BASE REG. VALUE @V60C1BD 00192000
DROP R14 @V60C1BD 00193000
SPACE 1 00194000
*-------------------------------------------------------------- 00195000
BR R14 GO TO ROUTINE @V60C1BD 00196000
*-------------------------------------------------------------- 00197000
EJECT 00198000
*-------------------------------------------------------------- 00199000
* COMMON ERROR EXIT | 00200000
*------------------------ 00201000
EXITCC1 STH R15,URETCODE @V60C1BD 00202000
B PREXIT GO TO ERROR EXIT DIRECTLY @V60C1BD 00203000
SPACE 5 00204000
*-------------------------------------------------------------- 00205000
* COMMON EXIT FOR UDEV FUNCTIONS, CC = 0 | 00206000
*--------------------------------------------- 00207000
DEVXCC0 L R6,URPAGDEV SET UP UDEV REAL PAGE ADDRESS @V60C1BD 00208000
L R4,UVPAGBUF SET UP UDEV VIRTUAL PAGE ADDRESS @V60C1BD 00209000
L R0,UDASDDEV SET UP OBJECT DASD ADDRESS @V60C1BD 00210000
OI UFLAGS,UDEVF INDICATE A UDEV UPDATE @V60C1BD 00211000
B EXITCC0 @V60C1BD 00212000
SPACE 2 00213000
*-------------------------------------------------------------- 00214000
* COMMON EXIT FOR UMAC FUNCTIONS, CC = 0 | 00215000
*--------------------------------------------- 00216000
MACXCC0 L R6,URPAGMAC SET UP UMAC REAL PAGE ADDRESS @V60C1BD 00217000
L R4,UVPAGBUF SET UP UMAC VIRTUAL PAGE ADDRESS @V60C1BD 00218000
L R0,UDASDMAC SET UP OBJECT DASD ADDRESS @V60C1BD 00219000
OI UFLAGS,UMACF INDICATE A UMAC UPDATE @V60C1BD 00220000
B EXITCC0 @V60C1BD 00221000
SPACE 2 00222000
*-------------------------------------------------------------- 00223000
* COMMON EXIT FOR UDIR FUNCTIONS, CC = 0 | 00224000
*--------------------------------------------- 00225000
DIRXCC0 L R6,URPAGDIR SET UP UDIR REAL PAGE ADDRESS @V60C1BD 00226000
L R4,UVPAGDIR SET UP UPDATED VIRTUAL PAGE ADDR @V60C1BD 00227000
L R0,UDASDDIR SET UP OBJECT DASD ADDRESS @V60C1BD 00228000
OI UFLAGS,UDIRF INDICATE A UDIR UPDATE @V60C1BD 00229000
SPACE 2 00230000
*-------------------------------------------------------------- 00231000
* COMMON EXIT, CC = 0 | 00232000
*------------------------ 00233000
EXITCC0 SR R15,R15 SET CC = 0 @V60C1BD 00234000
STH R15,URETCODE SET RETCODE TO 0 @V60C1BD 00235000
* FALL THROUGH TO "OPRET" 00236000
SPACE 5 00237000
*-------------------------------------------------------------- 00238000
* RETURN POINT FROM INDIVIDUAL ROUTINES 00239000
*-------------------------------------------------------------- 00240000
OPRET BNE PREXIT BR IF THERE WAS AN ERROR @V60C1BD 00241000
SPACE 1 00242000
TM UFLAGS,UNOUPF+UTESTMD UPDATE/TEST SUPPRESSION? @V60C1BD 00243000
BNZ PREXIT BR IF YES @V60C1BD 00244000
EJECT 00245000
*-------------------------------------------------------------- 00246000
* IF THE UPDATE WAS CONCERNED WITH A UMAC OR UDEV BLOCK, THE 00247000
* ONLY UPDATING NEEDED IS TO THE OBJECT DASD. IN THIS CASE, 00248000
* THE DATA IN THE SWPTABLE DOES NOT NEED TO BE OF CONCERN. 00249000
* 00250000
* IF THE UPDATE WAS TO A UDIR BLOCK, THEN THE OBJECT AND THE 00251000
* PAGING DASD NEED TO BE UPDATED. IN THIS CASE, THE SWPTABLE 00252000
* DATA DASD ADDRESS IS SAVED OVER THE UPDATE TO THE OBJECT 00253000
* DASD SO THAT THE SAME PAGE SLOT CAN BE REUSED WHEN UPDATING 00254000
* THE PAGING DASD. THE SETTING OF THE 'SWPRECMP' FLAG IS ALSO 00255000
* SAVED SO THAT IT CAN BE RESTORED FOLLOWING THE WRITING OF 00256000
* THE PAGE TO THE OBJECT DASD. (NOTE: THE 'SWPRCMP' FLAG IS 00257000
* SET TO B'1' BEFORE WRITING TO OBJECT DASD TO INDICATE THAT 00258000
* THE OBJECT DASD PAGE IS NOT TO BE RELEASED BY DMKRPAPT). 00259000
* 00260000
* SAVE THE CURRENT SWPTABLE 'SWPCYL/SWPDPAGE/SWPCODE': 00261000
* 1. REAL PAGE ADDR/256) + A(CORETBL) = CORETABLE FOR PAGE 00262000
* 2. GET SWPTABLE ADDRESS FROM CORETABLE 00263000
* 3. GET 0CCCPPDD FROM SWPTABLE 00264000
* 00265000
* NECESSARY REGISTER CONDITION: 00266000
* R6 = REAL ADDRESS OF PAGE BEING UPDATED 00267000
*-------------------------------------------------------------- 00268000
TM UFLAGS,UDIRF IS UDIR TO BE UPDATED? @V60C1BD 00269000
BNO WROBJ BR IF NOT @V60C1BD 00270000
SRL R6,8 CALC. CORTABLE INDEX (PG ADR/256)@V60C1BD 00271000
A R6,ACORETBL SET R5 = ADDR OF CORTABLE ENTRY @V60C1BD 00272000
USING CORTABLE,R6 @V60C1BD 00273000
L R7,CORSWPNT SET R7 = SWAPTABLE ENTRY ADDRESS @V60C1BD 00274000
USING SWPFLAG,R7 @V60C1BD 00275000
DROP R6 @V60C1BD 00276000
L R5,SWPCYL GET 0CCCPPDD FROM SWPTABLE @V60C1BD 00277000
ST R5,USVDASD SAVE PAGING DASD ADDRESS @V60C1BD 00278000
SR R8,R8 ZERO R8 @V60C1BD 00279000
ST R8,SWPCYL ZERO SWPTABLE DASD @V60C1BD 00280000
OI UFLAGS,URECMP ASSUME SWPRECMP IS B'1' @V60C1BD 00281000
TM SWPFLAG,SWPRECMP IS SWPRECMP FLAG B'1'? @V60C1BD 00282000
BO WROBJ BR IF YES @V60C1BD 00283000
NI UFLAGS,255-URECMP INDICATE SWPRECMP WAS B'0' @V60C1BD 00284000
OI SWPFLAG,SWPRECMP SET RECOMP BIT FOR OBJECT DASD@V60C1BD 00285000
* WRITE SO THAT DASD PAGE, IF ON DRUM, WILL 00286000
* NOT BE RELEASED...PLAN TO REUSE IT. 00287000
SPACE 1 00288000
*-------------------------------------------------------------- 00289000
* WRITE THE UPDATED PAGE BACK TO THE OBJECT DASD 00290000
* 00291000
* CURRENT NECESSARY REGISTER STATUS: 00292000
* R0 = ADDRESS OF OBJECT DASD 00293000
* R4 = VIRTUAL ADDRESS OF UPDATED PAGE 00294000
* R6 = REAL ADDRESS OF UPDATED PAGE 00295000
*-------------------------------------------------------------- 00296000
* WRITE THE PAGE TO OBJECT DASD 00297000
WROBJ CLC 0(8,R6),ZEROES CHECK TO SEE IF DASD DATA IS ZERO@V60C1BD 00298000
BE PGZ BR IF SO, THIS IS NOT GOOD... @V60C1BD 00299000
IC R0,DMKSYSUD+3 GET DEVICE CODE FROM SYSTEM @V60C1BD 00300000
LR R1,R4 SET UP VIRTUAL PAGE ADDRESS @V60C1BD 00301000
LA R2,SYSTEM SPECIFY SYSTEM OPTION @V60C1BD 00302000
CALL DMKRPAPT WRITE UPDATED PAGE TO OBJECT DASD@V60C1BD 00303000
BZ WPAGING BR IF WRITE WAS OK @V60C1BD 00304000
SPACE 1 00305000
LA R1,ERRWRIT1 SETUP RETCODE FOR WRITE ERROR @V60C1BD 00306000
STH R1,URETCODE STORE IN CONTROL BLOCK @V60C1BD 00307000
TM UFLAGS,UDIRF IS OPERATION UPDATING UDIR BLK? @V60C1BD 00308000
BNO PREXIT BR IF NOT @V60C1BD 00309000
B REFLAG FIX UP SWPTABLE FLAG BEFORE EXIT @V60C1BD 00310000
SPACE 1 00311000
*-------------------------------------------------------------- 00312000
* UPDATE THE PAGE ON PAGING DASD 00313000
* 00314000
*-------------------------------------------------------------- 00315000
WPAGING TM UFLAGS,UDIRF IS OPERATION UPDATING UDIR BLOCK?@V60C1BD 00316000
BNO PREXIT BR IF NOT, DON'T UPDTE PAG'G DASD@V60C1BD 00317000
SPACE 1 00318000
* CHECK IF THE OBJECT AND PAGING DASD ADDRESS ARE SAME, I.E., 00319000
* THE PAGE HAS NEVER BEEN WRITTEN OUT TO PAGING DASD. 00320000
C R0,USVDASD ARE DASD ADDRESSES EQUAL? @V60C1BD 00321000
BE REFLAG BR IF YES, DON'T WRITE TWICE @V60C1BD 00322000
SPACE 1 00323000
L R0,USVDASD GET DASD ADDR SAVED FROM SWPTABLE@V60C1BD 00324000
L R1,UVPAGDIR GET UDIR VIRTUAL PAGE ADDRESS @V60C1BD 00325000
LA R2,SYSTEM SPECIFY SYSTEM OPTION @V60C1BD 00326000
CALL DMKRPAPT WRITE UPDATED PAGE TO PAGING DASD@V60C1BD 00327000
BNZ WPERR BR IF WRITE ERROR @V60C1BD 00328000
SPACE 1 00329000
* SET SWPRECMP FLAG IN SWPTABLE TO ITS ORIGINAL VALUE SO THAT 00330000
* PAGE CAN BE RELEASED WHEN NECESSARY. R7 POINTS TO SWPTABLE 00331000
REFLAG NI SWPFLAG,255-SWPRECMP SET SWPRECMP TO B'0' @V60C1BD 00332000
TM UFLAGS,URECMP WAS SWPRECMP B'1'? @V60C1BD 00333000
BNO PREXIT BR IF NOT, LEAVE IT SET TO B'0' @V60C1BD 00334000
OI SWPFLAG,SWPRECMP SET BIT TO THE WAY IT WAS @V60C1BD 00335000
DROP R7 @V60C1BD 00336000
SPACE 2 00337000
*-------------------------------------------------------------- 00338000
* PREPARE TO EXIT... 00339000
* UNLOCK THE DIRECTORY (ALL CASES) AND EXIT 00340000
*-------------------------------------------------------------- 00341000
PREXIT LA R1,=CL8' DIRCT' SPECIFY DIRECTORY LOCK NAME @V60C1BD 00342000
CALL DMKLOCKD UNLOCK THE DIRECTORY @V60C1BD 00343000
EJECT 00344000
* FREE SYSTEM VIRTUAL PAGE IF PRESENT 00345000
L R1,UVPAGBUF GET ADDR. OF SYSTEM VIRTUAL PAGE @V60C1BD 00346000
LTR R1,R1 IS THERE ONE? @V60C1BD 00347000
BZ SVURET BR IF NOT @V60C1BD 00348000
CALL DMKPGTVR FREE SYSTEM PAGE @V60C1BD 00349000
SPACE 1 00350000
SVURET LH R2,URETCODE SAVE RETCODE FROM CONTROL BLOCK @V60C1BD 00351000
SPACE 1 00352000
* FREE UCNTRL BLOCK 00353000
LA R0,UCNTRLSZ+UIPARMSZ SPECIFY SIZE TO FRET @V60C1BD 00354000
LR R1,R3 POINT TO STORAGE TO FRET @V60C1BD 00355000
CALL DMKFRET FRET UCNTRL BLOCK @V60C1BD 00356000
SPACE 1 00357000
ST R2,SAVEREGS+R2*4 PASS RETCODE BACK TO CALLER @V60C1BD 00358000
LTR R2,R2 SET CC, 0 = NO ERROR, ¬0 = ERROR @V60C1BD 00359000
SPACE 1 00360000
*-------------------------------------------------------------- 00361000
* EXIT CONDITIONS: 00362000
* 00363000
* R2 CONTAINS RETURN CODE WHICH IS PASSED BACK TO THE CALLER 00364000
* 00365000
* CC = 0 INDICATES THAT OPERATION IS SUCCESSFUL (R2 = 0) 00366000
* CC = 2 INDICATES THAT AN ERROR HAS OCCURRED AND THAT R2 00367000
* CONTAINS AN ERROR CODE IDENTIFYING THE ERROR 00368000
* 00369000
*-------------------------------------------------------------- 00370000
UDUEXIT EXIT RETURN TO CALLER @V60C1BD 00371000
SPACE 3 00372000
*-------------------------------------------------------------- 00373000
* IF THE DASD DISPL. & POINTER IN A BLOCK TO BE WRITTEN TO 00374000
* THE OBJECT DASD ARE 0, THERE IS A PROBLEM... RETURN ERROR. 00375000
*-------------------------------------------------------------- 00376000
PGZ LA R1,ERRPGZ SETUP RETCODE FOR ERROR @V60C1BD 00377000
STH R1,URETCODE STORE IN CONTROL BLOCK @V60C1BD 00378000
B REFLAG @V60C1BD 00379000
SPACE 3 00380000
WPERR LA R1,ERRWRIT2 SETUP RETCODE FOR WRITE ERROR @V60C1BD 00381000
STH R1,URETCODE STORE IN CONTROL BLOCK @V60C1BD 00382000
B REFLAG @V60C1BD 00383000
EJECT 00384000
*-------------------------------------------------------------- 00385000
* LOGPASS | 00386000
*---------- 00387000
* THE UDIRBLOK FOR THE USERID HAS BEEN FOUND AND THE CURRENT 00388000
* LOGON PASSWORDS MATCH. 00389000
* 00390000
* OPERATION: 00391000
* 1. OBSCURE NEW PASSWORD 00392000
* 2. MOVE NEW PASSWORD TO UDIRBLOK 00393000
* 00394000
*-------------------------------------------------------------- 00395000
LOGPASS DS 0H @V60C1BD 00396000
L R5,UDIRAD GET REAL ADDRESS OF UDIR @V60C1BD 00397000
USING UDIRBLOK,R5 @V60C1BD 00398000
XC UNEWPASS(L'UNEWPASS),MASK OBSCURE NEW PASSWD @V60C1BD 00399000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00400000
BO TMBY1 BR IF YES @V60C1BD 00401000
MVC UDIRPASS(L'UDIRPASS),UNEWPASS EST. NEW PASSWD @V60C1BD 00402000
TMBY1 DS 0H @V60C1BD 00403000
B DIRXCC0 NORMAL EXIT @V60C1BD 00404000
SPACE 1 00405000
DROP R5 @V60C1BD 00406000
EJECT 00407000
*-------------------------------------------------------------- 00408000
* MDISK | ROUTINE TO UPDATE MDISK DATA 00409000
*---------- 00410000
* THE UDIRBLOK FOR THE USERID HAS BEEN FOUND AND THE CURRENT 00411000
* LOGON PASSWORDS MATCH 00412000
* 00413000
* OPERATION: 00414000
* 1. READ UMACBLOK FOR USERID 00415000
* 2. CONVERT DEVICE ADDRESS FROM EBCDIC TO HEX 00416000
* 3. LOCATE AND READ THE UDEVBLOK CORRESPONDING TO THE DEVICE 00417000
* 4. VALIDATE THE LINK MODE AND CALCULATE THE VALUE FOR THE 00418000
* LINK MODE 00419000
* 5. CHECK RELATION BETWEEN GIVEN LINK PASSWORDS AND SIZE 00420000
* OF UDEVBLOK. IF PASSWORDS ARE GIVEN AND UDEVBLOK IS 00421000
* SHORT, OR IF BLANK PASSWORDS GIVEN AND UDEVBLOK IS 00422000
* LONG, REJECT THE TRANSACTION 00423000
* 6. ESTABLISH NEW PASSWORDS AND/OR LINK MODE IN UDEVBLOK 00424000
* 00425000
*-------------------------------------------------------------- 00426000
MDISK DS 0H @V60C1BD 00427000
SPACE 1 00428000
* GET THE UMACBLOK (NEED IN ORDER TO REFERENCE UDEV) 00429000
BAL R9,READUMAC @V60C1BD 00430000
BNZ OPRET BR IF ERROR READING UMAC @V60C1BD 00431000
SPACE 1 00432000
* CONVERT THE ADDRESS OF THE DEVICE TO BE FOUND TO HEX SO IT 00433000
* CAN BE USED AS A SEARCH ARGUMENT 00434000
LA R1,UMDISKAD POINT TO MDISK ADDRESS (3 BYTES) @V60C1BD 00435000
LA R2,L'UMDISKAD SET UP LENGTH OF FIELD @V60C1BD 00436000
BAL R9,BCDTOHEX CONVERT ADDRESS TO HEX @V60C1BD 00437000
BNZ MDSKERR1 BR IF CONVERSION ERROR @V60C1BD 00438000
STH R2,ULOCDVAD SAVE ADDRESS IN UCNTRL @V60C1BD 00439000
SPACE 1 00440000
* GET THE UDEVBLOK 00441000
BAL R9,READUDEV @V60C1BD 00442000
BNZ OPRET BR IF ERROR READING UDEV @V60C1BD 00443000
SPACE 1 00444000
L R5,UDEVAD GET REAL ADDRESS OF UDEV @V60C1BD 00445000
USING UDEVBLOK,R5 @V60C1BD 00446000
SPACE 1 00447000
* VALIDATE THE LINK MODE AND CALC. VALUE FOR UDEVMODE 00448000
LA R9,MAXLNKMD SET UP LIMIT OF SEARCH @V60C1BD 00449000
LA R7,LINKMDTB POINT TO START OF LINK MODE TABLE@V60C1BD 00450000
USING LNKMSECT,R7 @V60C1BD 00451000
LNKLOOP CLC UMDISKMD(L'UMDISKMD),LNKMD DO LINK MODES MATCH?@V60C1BD 00452000
BE MDMATCH BR IF YES @V60C1BD 00453000
LA R7,LNKMDLN(,R7) STEP TO NEXT TABLE ENTRY @V60C1BD 00454000
BCT R9,LNKLOOP KEEP LOOKING @V60C1BD 00455000
B MDSKERR2 ERROR, INVALID LINK MODE @V60C1BD 00456000
SPACE 1 00457000
MDMATCH SR R8,R8 CLEAR REG. @VMI0024 00458000
IC R8,LNKMVALU GET MODE VALUE FOR UDEVMODE @VMI0024 00459000
MVC UWORK(L'UDEVSTAT),UDEVSTAT ISOLATE UDEVSTAT @V60C1BD 00460000
XC UWORK(L'UDEVSTAT),MASK UNMASK UDEVSTAT @V60C1BD 00461000
C R7,=A(VRRSEP) IS MATCH A VRR MODE? @VMI0024 00462000
BL MSKSTAT BR IF NOT VRR MODE @VMI0024 00463000
OI UWORK,UDEVVRR INDICATE VIRT. RES/REL @VMI0024 00464000
MSKSTAT CLC UMDISKRP(L'UMDISKRP),BLANKS PASSWORD GIVEN? @VMI0044 00465000
BE BLPW BR IF NOT @V60C1BD 00466000
TM UWORK,UDEVLONG LONG UDEVBLOK? @V60C1BD 00467000
BNO MDSKERR3 BR IF NOT, ERROR @V60C1BD 00468000
CLI UMDISKRP,C' ' IS THERE A READ PASSWORD? @V60C1BD 00469000
BE MDB1 BR IF NOT @V60C1BD 00470000
O R8,=A(UDEVLR) SIGNAL THAT READ LINKS ALLOWED @V60C1BD 00471000
MDB1 CLI UMDISKWP,C' ' IS THERE A WRITE PASSWORD? @V60C1BD 00472000
BE MDB2 BR IF NOT @V60C1BD 00473000
O R8,=A(UDEVLW) SIGNAL THAT WRITE LINKS ALLOWED @V60C1BD 00474000
MDB2 CLI UMDISKMP,C' ' IS THERE A MULTIPLE PASSWORD? @V60C1BD 00475000
BE MDB3 BR IF NOT @V60C1BD 00476000
O R8,=A(UDEVLM) SIGNAL THAT MULT. LINKS ALLOWED @V60C1BD 00477000
MDB3 X R8,MASK OBSCURE NEW LINK MODE @V60C1BD 00478000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00479000
BO TMBY2 BR IF YES @V60C1BD 00480000
STC R8,UDEVMODE ESTABLISH NEW LINK MODE @V60C1BD 00481000
MVC UDEVPASR(L'UDEVPASR*3),UMDISKRP EST. NEW PASSWD@V60C1BD 00482000
XC UDEVPASR(L'UDEVPASR*3),MASK OBSCURE NEW PASSWD@V60C1BD 00483000
MVC UDEVSTAT(L'UDEVSTAT),UWORK SET NEW UDEVSTAT @VMI0024 00484000
XC UDEVSTAT(L'UDEVSTAT),MASK MASK UDEVSTAT @VMI0044 00485000
TMBY2 DS 0H @V60C1BD 00486000
B DEVXCC0 NORMAL RETURN @V60C1BD 00487000
SPACE 1 00488000
BLPW DS 0H @V60C1BD 00489000
TM UWORK,UDEVLONG LONG UDEVBLOK? @V60C1BD 00490000
BO MDSKERR4 BR IF YES, ERROR @V60C1BD 00491000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00492000
BO TMBY2 BR IF YES @V60C1BD 00493000
X R8,MASK OBSCURE NEW LINK MODE @V60C1BD 00494000
STC R8,UDEVMODE ESTABLISH NEW LINK MODE @V60C1BD 00495000
MVC UDEVSTAT(L'UDEVSTAT),UWORK SET NEW UDEVSTAT @VMI0024 00496000
XC UDEVSTAT(L'UDEVSTAT),MASK MASK UDEVSTAT @VMI0044 00497000
B DEVXCC0 NORMAL RETURN @V60C1BD 00498000
SPACE 1 00499000
MDSKERR1 LA R15,ERRMDSK1 INVALID MDISK IN PLIST @V60C1BD 00500000
B EXITCC1 ERROR RETURN @V60C1BD 00501000
SPACE 1 00502000
MDSKERR2 LA R15,ERRMDSK2 INVALID LINK MODE @V60C1BD 00503000
B EXITCC1 ERROR RETURN @V60C1BD 00504000
SPACE 1 00505000
MDSKERR3 LA R15,ERRMDSK3 INVALID PASSWORDS...SHORT UDEV. @V60C1BD 00506000
B EXITCC1 ERROR RETURN @V60C1BD 00507000
SPACE 1 00508000
MDSKERR4 LA R15,ERRMDSK4 BLANK PASSWORDS WITH LONG UDEV. @V60C1BD 00509000
B EXITCC1 ERROR RETURN @V60C1BD 00510000
SPACE 1 00511000
DROP R5,R7 @V60C1BD 00512000
EJECT 00513000
*-------------------------------------------------------------- 00514000
* STORAGE | 00515000
*---------- 00516000
* THE UDIRBLOK FOR THE USERID HAS BEEN FOUND AND THE CURRENT 00517000
* LOGON PASSWORDS MATCH. 00518000
* 00519000
* OPERATION: 00520000
* 1. READ THE UMACBLOK FOR THE USERID 00521000
* 2. FIND THE LENGTH OF THE STORAGE ARGUMENT 00522000
* 3. CHECK THAT LAST BYTE IS A K AND CONVERT "K" TO BYTES 00523000
* 4. IF OPERATION IS "STORAGE", THEN CHECK THAT NEW SIZE DOES 00524000
* NOT EXCEED THE USER'S MAXIMUM STORAGE 00525000
* 5. IF OPERATION IS "MAXSTOR", THEN CHECK THAT NEW SIZE DOES 00526000
* NOT EXCEED 16M 00527000
* 6. ESTABLISH NEW STORAGE SIZE IN UMACBLOK 00528000
* 00529000
*-------------------------------------------------------------- 00530000
STORAGE DS 0H @V60C1BD 00531000
SPACE 1 00532000
* GET THE UMACBLOK 00533000
BAL R9,READUMAC @V60C1BD 00534000
BNZ OPRET BR IF ERROR READING UMAC @V60C1BD 00535000
SPACE 1 00536000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00537000
USING UMACBLOK,R5 @V60C1BD 00538000
* CONVERT STORAGE FROM EBCDIC TO BINARY VALUE 00539000
LA R1,USTORAGE SET FIELD ADDRESS IN REG @V60C1BD 00540000
LA R2,L'USTORAGE SET MAX. FIELD LENGTH @V60C1BD 00541000
BAL R9,FINDLA TO ROUTINE TO FIND FIELD LENGTH @V60C1BD 00542000
BNZ STORERR4 BR IF ERROR IN DATA @V60C1BD 00543000
LTR R2,R2 IS LENGTH VALID? @V60C1BD 00544000
BNP STORERR4 BR IF NOT @V60C1BD 00545000
BCTR R2,0 DECREMENT FIELD LENGTH @V60C1BD 00546000
LA R8,0(R2,R1) POINT TO LAST BYTE OF FIELD @V60C1BD 00547000
CLI 0(R8),C'K' IS LAST BYTE A 'K'? @V60C1BD 00548000
BNE STORERR4 BR IF NOT @V60C1BD 00549000
SPACE 1 00550000
* CHECK FIELD FOR NUMERICS, R2 = LENGTH OF NUMERIC PORTION 00551000
BAL R9,FINDLN CHECK NUMERIC PORTION @V60C1BD 00552000
BNE STORERR4 BR IF ERROR IN DATA @V60C1BD 00553000
BCTR R2,0 DECREMENT LENGTH FOR EXECUTE @V60C1BD 00554000
LA R8,USTORAGE SET FIELD ADDRESS IN REG @V60C1BD 00555000
EX R2,PACKINST EXECUTE A PACK INSTRUCTION @V60C1BD 00556000
TM UWORK+7,X'0C' CHECK FOR A HEX C-F IN SIGN POS. @V60C1BD 00557000
BNO STORERR3 BR IF NOT PROPER SIGN @V60C1BD 00558000
CVB R8,UWORK CONVERT TO BINARY @V60C1BD 00559000
SPACE 1 00560000
* STORAGE VALUE IS NOW IN 'K'. CALCULATE BYTES. 00561000
SLL R8,10 CALCULATE BYTES FROM 'K' @V60C1BD 00562000
CLC UOP(L'UOP),KSTORAGE FOR NORMAL STORAGE? @V60C1BD 00563000
BE NORMSTOR BR IF YES @V60C1BD 00564000
C R8,=F'16777216' OVER MAX.? @V60C1BD 00565000
BH STORERR2 BR IF YES @V60C1BD 00566000
X R8,MASK OBSCURE STORAGE SIZE @V60C1BD 00567000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00568000
BO TMBY3 BR IF YES @V60C1BD 00569000
ST R8,UMACMCOR SET NEW MAX. STORAGE SIZE @V60C1BD 00570000
TMBY3 DS 0H @V60C1BD 00571000
B MACXCC0 TO NORMAL EXIT @V60C1BD 00572000
SPACE 1 00573000
NORMSTOR L R7,UMACMCOR GET MAXIMUM STORAGE SIZE @V60C1BD 00574000
X R7,MASK UNMASK MAXIMUM STORAGE SIZE @V60C1BD 00575000
CR R8,R7 DOES NEW STORAGE EXCEED MAX.? @V60C1BD 00576000
BH STORERR1 BR IF YES, ERROR @V60C1BD 00577000
X R8,MASK OBSCURE NEW STORAGE SIZE @V60C1BD 00578000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00579000
BO TMBY4 BR IF YES @V60C1BD 00580000
ST R8,UMACCORE ESTABLISH NEW STORAGE SIZE @V60C1BD 00581000
TMBY4 DS 0H @V60C1BD 00582000
B MACXCC0 BR TO NORMAL EXIT @V60C1BD 00583000
SPACE 1 00584000
STORERR1 LA R15,ERRSTOR1 @V60C1BD 00585000
B EXITCC1 ERROR RETURN @V60C1BD 00586000
SPACE 1 00587000
STORERR2 LA R15,ERRSTOR2 @V60C1BD 00588000
B EXITCC1 ERROR RETURN @V60C1BD 00589000
SPACE 1 00590000
STORERR3 LA R15,ERRSTOR3 @V60C1BD 00591000
B EXITCC1 ERROR RETURN @V60C1BD 00592000
SPACE 1 00593000
STORERR4 LA R15,ERRSTOR4 @V60C1BD 00594000
B EXITCC1 ERROR RETURN @V60C1BD 00595000
DROP R5 @V60C1BD 00596000
EJECT 00597000
*-------------------------------------------------------------- 00598000
* PRIVLEGE | 00599000
*----------- 00600000
* THE UDIRBLOK HAS BEEN READ AND THE LOGON PASSWORDS MATCH 00601000
* 00602000
* OPERATION: 00603000
* 1. READ THE UMACBLOK FOR THE USERID 00604000
* 2. CHECK FOR BLANK PRIVILEGE ARGUMENT 00605000
* 3. USE "TRT" INSTRUCTION TO DEVELOP A CODED VALUE 00606000
* REPRESENTING THE PRIVILEGE CLASSES 00607000
* 4. WHEN ALL ARGUMENT BYTES HAVE BEEN EXAMINED, CHECK THAT 00608000
* DEVELOPED CODED VALUE IS VALID 00609000
* 5. ESTABLISH NEW PRIVILEGE VALUE 00610000
* 00611000
*-------------------------------------------------------------- 00612000
PRIVLEGE DS 0H @V60C1BD 00613000
SPACE 1 00614000
* GET THE UMACBLOK 00615000
BAL R9,READUMAC @V60C1BD 00616000
BNZ OPRET BR IF ERROR READING UAMC @V60C1BD 00617000
SPACE 1 00618000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00619000
USING UMACBLOK,R5 NORMALLY R2, (CAN'T DUE TO TRT) @V60C1BD 00620000
SPACE 1 00621000
* SOME INITIAL CHECKING OF PRIVILEGE FIELD 00622000
CLC UPRIV(L'UPRIV),BLANKS IS FIELD ALL BLANKS? @V60C1BD 00623000
BE PRIVERR1 BR IF YES @V60C1BD 00624000
LA R8,X'FF' SETUP TO TEST FOR BLANKS FROM TRT@V60C1BD 00625000
LA R4,X'BD' SETUP TO INDICATE ERROR FROM TRT @V60C1BD 00626000
SR R2,R2 ZERO FUNCTION REGISTER @V60C1BD 00627000
SR R9,R9 ZERO ACCUMULATION REGISTER @V60C1BD 00628000
LA R1,UPRIV POINT TO START OF PRIV. CLASSES @V60C1BD 00629000
SPACE 1 00630000
PRIVLP LA R7,UPRIV+8 SET UP A(END OF OPERAND +1) @V60C1BD 00631000
SR R7,R1 CALC. LENGTH OF TRT @V60C1BD 00632000
BNP PRIVEND BR IF END OF OPERAND REACHED @V60C1BD 00633000
BCTR R7,0 DECREMENT LENGTH FOR EXECUTED TRT@V60C1BD 00634000
EX R7,TRTINST EXECUTE TRT @V60C1BD 00635000
BZ PRIVERR2 BR IF NO VALID ARGUMENTS @V60C1BD 00636000
CR R2,R8 A BLANK (END OF FIELD)? @V60C1BD 00637000
BE PRIVEND BR IF YES @V60C1BD 00638000
CR R2,R4 IS FUNCTION VALID? @V60C1BD 00639000
BE PRIVERR4 BR IF NOT @V60C1BD 00640000
SPACE 1 00641000
* A VALID OPERAND BYTE HAS BEEN FOUND AND IS IN R2. ADD THIS 00642000
* INTO CUMULATIVE PRIVILEGE CLASS FIELD IN R9. 00643000
* R1 POINTS TO LIST BYTE CORRESPONDING TO FUNCTION 00644000
OR R9,R2 ACCUMULATE PRIVILEGE CLASS VALUE @V60C1BD 00645000
LA R1,1(,R1) STEP TO NEXT OPERAND BYTE @V60C1BD 00646000
B PRIVLP CYCLE @V60C1BD 00647000
SPACE 1 00648000
PRIVEND LTR R9,R9 ANYTHING ACCUMULATED? @V60C1BD 00649000
BNP PRIVERR3 BR IF NOT @V60C1BD 00650000
CR R9,R8 IS ACCUM. CLASS OVER X'FF' ? @V60C1BD 00651000
BH PRIVERR3 BR IF YES @V60C1BD 00652000
X R9,MASK OBSCURE PRIVILEGE CLASS @V60C1BD 00653000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00654000
BO TMBY5 BR IF YES @V60C1BD 00655000
STC R9,UMACCLEV ESTABLISH NEW PRIVILEGE CLASS @V60C1BD 00656000
TMBY5 DS 0H @V60C1BD 00657000
B MACXCC0 NORMAL EXIT @V60C1BD 00658000
SPACE 1 00659000
PRIVERR1 LA R15,ERRPRIV1 @V60C1BD 00660000
B EXITCC1 ERROR RETURN @V60C1BD 00661000
SPACE 1 00662000
PRIVERR2 LA R15,ERRPRIV2 @V60C1BD 00663000
B EXITCC1 ERROR RETURN @V60C1BD 00664000
SPACE 1 00665000
PRIVERR3 LA R15,ERRPRIV3 @V60C1BD 00666000
B EXITCC1 ERROR RETURN @V60C1BD 00667000
SPACE 1 00668000
PRIVERR4 LA R15,ERRPRIV4 @V60C1BD 00669000
B EXITCC1 ERROR RETURN @V60C1BD 00670000
SPACE 2 00671000
* EXECUTED TRT INSTRUCTION 00672000
TRTINST TRT 0(*-*,R1),TRPRVTBL TRANSLATE VALID BYTE @V60C1BD 00673000
SPACE 1 00674000
DROP R5 DROP UMACBLOK REFERENCE @V60C1BD 00675000
EJECT 00676000
*-------------------------------------------------------------- 00677000
* PRIORTY | 00678000
*----------- 00679000
* THE UDIRBLOK HAS BEEN READ AND THE LOGON PASSWORDS MATCH 00680000
* 00681000
* OPERATION: 00682000
* 1. READ THE UMACBLOK FOR THE USERID 00683000
* 2. CHECK PRIORITY ARGUMENT PRIOR TO CONVERSION TO BINARY 00684000
* 3. CHECK THAT CONVERTED VALUE FALLS BETWEEN 0 AND 99 00685000
* 4. ESTABLISH NEW PRIORITY 00686000
* 00687000
*-------------------------------------------------------------- 00688000
PRIORTY DS 0H @V60C1BD 00689000
SPACE 1 00690000
* GET THE UMACBLOK 00691000
BAL R9,READUMAC @V60C1BD 00692000
BNE OPRET BR IF ERROR READING UMAC @V60C1BD 00693000
SPACE 1 00694000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00695000
USING UMACBLOK,R5 @V60C1BD 00696000
SPACE 1 00697000
* FIND LENGTH OF PRIORITY FIELD 00698000
LA R1,UPRIOR SET UP ADDRESS OF PRIORITY FIELD @V60C1BD 00699000
LA R2,L'UPRIOR SET UP LENGTH OF UPRIOR FIELD @VMI0025 00700000
BAL R9,FINDLN FIND LENGTH (NUMERIC ONLY) @V60C1BD 00701000
BNZ PRIERR1 BR IF ERROR @V60C1BD 00702000
LTR R2,R2 IS LENGTH VALID? @V60C1BD 00703000
BNP PRIERR2 BR IF NOT @V60C1BD 00704000
C R2,F2 IS LENGTH OVER 2 BYTES? @V60C1BD 00705000
BH PRIERR4 BR IF YES @V60C1BD 00706000
LA R8,UPRIOR SET UP ADDRESS OF PRIORITY FIELD @V60C1BD 00707000
BCTR R2,0 DECREMENT LEN. FOR EXECUTED PACK @V60C1BD 00708000
EX R2,PACKINST EXECUTE A PACK INSTRUCTION @V60C1BD 00709000
TM UWORK+7,X'0C' CHECK FOR HEX C-F IN SIGN @V60C1BD 00710000
BNO PRIERR3 BR IF NOT PROPER SIGN @V60C1BD 00711000
CVB R8,UWORK CONVERT TO BINARY @V60C1BD 00712000
C R8,=F'99' CHECK FOR VALID RANGE @V60C1BD 00713000
BH PRIERR4 BR IF > 99 @V60C1BD 00714000
X R8,MASK OBSCURE PRIORITY @V60C1BD 00715000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00716000
BO TMBY6 BR IF YES @V60C1BD 00717000
STC R8,UMACPRIR ESTABLISH NEW PRIORITY @V60C1BD 00718000
TMBY6 DS 0H @V60C1BD 00719000
B MACXCC0 @V60C1BD 00720000
SPACE 1 00721000
PRIERR1 LA R15,ERRPRI1 @V60C1BD 00722000
B EXITCC1 ERROR RETURN @V60C1BD 00723000
SPACE 1 00724000
PRIERR2 LA R15,ERRPRI2 @V60C1BD 00725000
B EXITCC1 ERROR RETURN @V60C1BD 00726000
SPACE 1 00727000
PRIERR3 LA R15,ERRPRI3 @V60C1BD 00728000
B EXITCC1 ERROR RETURN @V60C1BD 00729000
SPACE 1 00730000
PRIERR4 LA R15,ERRPRI4 @V60C1BD 00731000
B EXITCC1 ERROR RETURN @V60C1BD 00732000
SPACE 1 00733000
DROP R5 @V60C1BD 00734000
EJECT 00735000
*-------------------------------------------------------------- 00736000
* EDITCHAR | 00737000
*----------- 00738000
* THE UDIRBLOK HAS BEEN READ AND THE LOGON PASSWORDS MATCH 00739000
* 00740000
* 1. READ THE UMACBLOK FOR THE USERID 00741000
* 2. ESTABLISH THE NEW EDIT CHARACTERS 00742000
* 00743000
*-------------------------------------------------------------- 00744000
EDITCHAR DS 0H @V60C1BD 00745000
SPACE 1 00746000
* GET THE UMACBLOK 00747000
BAL R9,READUMAC @V60C1BD 00748000
BNE OPRET BR IF ERROR READING UMAC @V60C1BD 00749000
SPACE 1 00750000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00751000
USING UMACBLOK,R5 @V60C1BD 00752000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00753000
BO TMBY7 BR IF YES @V60C1BD 00754000
MVC UMACLEND(L'UEDITCH),UEDITCH EST. NEW EDIT CHAR.@V60C1BD 00755000
XC UMACLEND(L'UEDITCH),MASK OBSCURE EDIT CHAR. @V60C1BD 00756000
TMBY7 DS 0H @V60C1BD 00757000
B MACXCC0 NORMAL RETURN @V60C1BD 00758000
SPACE 1 00759000
DROP R5 @V60C1BD 00760000
EJECT 00761000
*-------------------------------------------------------------- 00762000
* OPTIONS | 00763000
*---------- 00764000
* THE UDIRBLOK HAS BEEN READ AND THE LOGON PASSWORDS MATCH 00765000
* 00766000
* OPERATION: 00767000
* 1. READ THE UMACBLOK FOR THE USERID 00768000
* 2. SCAN FOR ARGUMENTS. VALIDATE EACH ARGUMENT AND DEVELOP 00769000
* A CODED VALUE. 00770000
* 3. FOR OPTIONS "CPUID" AND "AFFINITY", SCAN FOR OPTION 00771000
* ARGUMENT FOLLOWING OPTION. CONVERT OPTION ARGUEMENTS TO 00772000
* PROPER FORMAT FOR DIRECTORY. 00773000
* 4. ESTABLISH NEW CODED OPTION VALUE AND CPUID/AFFINITY 00774000
* VALUES IF PRESENT. 00775000
* 00776000
*-------------------------------------------------------------- 00777000
OPTIONS DS 0H @V60C1BD 00778000
SPACE 1 00779000
* GET THE UMACBLOK 00780000
BAL R9,READUMAC @V60C1BD 00781000
BNE OPRET BR IF ERROR READING UMAC @V60C1BD 00782000
SPACE 1 00783000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00784000
USING UMACBLOK,R5 @V60C1BD 00785000
SR R0,R0 ZERO REG. USED FOR OPTION VALUE @V60C1BD 00786000
LA R4,MAXOPTNS SET UP MAX. NO. OF OPTIONS @V60C1BD 00787000
LA R1,UOPTIONS POINT TO FIRST ARGUMENT @V60C1BD 00788000
** 00789000
MVC UWORK(L'UMACPUID),UMACPUID SAVE CURRENT CPUID @V60C1BD 00790000
MVC UWORK+3(L'UMACAFF),UMACAFF SAVE CURRENT AFFIN. @V60C1BD 00791000
** 00792000
SPACE 1 00793000
* FIND OPTION LENGTH 00794000
OPTNLP1 LA R2,L'OPTNAME SET MAX LENGTH OF OPTION NAME @V60C1BD 00795000
BAL R9,FINDLA FIND LENGTH OF OPTION @V60C1BD 00796000
BNZ OPTNERR1 BR IF ERROR IN LENGTH @V60C1BD 00797000
LTR R2,R2 IS SIZE ZERO? @V60C1BD 00798000
BZ OPTNSET BR IF YES, ASSUME END OF ARGS @V60C1BD 00799000
BCTR R2,0 DECREMENT LENGTH FOR EXECUTE @V60C1BD 00800000
LA R7,OPTIONTB POINT TO START OF OPTION TABLE @V60C1BD 00801000
USING OPTNSECT,R7 @V60C1BD 00802000
OPTNLP2 EX R2,CLCOPTN IS THERE A MATCH? @V60C1BD 00803000
BE OPMATCH BR IF YES @V60C1BD 00804000
LA R7,OPTNLN(,R7) STEP TO NEXT OPTION IN TABLE @V60C1BD 00805000
CLI OPTNAME,X'FF' AT END OF OPTION TABLE? @V60C1BD 00806000
BNE OPTNLP2 BR IF NOT, CYCLE @V60C1BD 00807000
B OPTNERR1 ERROR, INVALID OPTION @V60C1BD 00808000
SPACE 1 00809000
OPMATCH SR R9,R9 CLEAR REGISTER @V60C1BD 00810000
ICM R9,B'0011',OPTNVALU GET OPTION VALUE @V60C1BD 00811000
OR R0,R9 ACCUMULATE OPTION VALUE @V60C1BD 00812000
LA R1,1(R1,R2) ADD OPTION LENGTH TO START ADDR. @V60C1BD 00813000
* AND COMPENSATE FOR BCTR 00814000
CLI 0(R1),X'FF' AT END OF ARG. LIST? @V60C1BD 00815000
BE OPTNSET BR IF YES @V60C1BD 00816000
CLI 0(R1),C' ' A BLANK? (SHOULD BE) @V60C1BD 00817000
BNE OPTNERR1 BR IF NOT A BLANK @V60C1BD 00818000
LA R1,1(,R1) POINT TO START OF NEXT OPTION @V60C1BD 00819000
CLI OPTNFLG,X'FF' DO ARGUMENTS FOLLOW OPTION? @V60C1BD 00820000
BE OPTNARG BR IF YES @V60C1BD 00821000
OPTNBCT BCT R4,OPTNLP1 BR IF WITHIN MAX. NO. OF OPTIONS @V60C1BD 00822000
B OPTNERR2 @V60C1BD 00823000
SPACE 1 00824000
OPTNSET C R0,=A(OPTNMAXV) IS OPTION VALUE WITHIN BOUNDS? @V60C1BD 00825000
BH OPTNERR3 BR IF NOT @V60C1BD 00826000
X R0,MASK OBSCURE OPTION BYTE @V60C1BD 00827000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00828000
BO TMBY8 BR IF YES @V60C1BD 00829000
STH R0,UMACOPT ESTABLISH NEW OPTION BYTE @V60C1BD 00830000
** 00831000
MVC UMACPUID(L'UMACPUID),UWORK ESTABLISH CPUID @V60C1BD 00832000
MVC UMACAFF(L'UMACAFF),UWORK+3 ESTABLISH AFFINITY@V60C1BD 00833000
** 00834000
TMBY8 DS 0H @V60C1BD 00835000
B MACXCC0 NORMAL RETURN @V60C1BD 00836000
SPACE 1 00837000
* CHECK OPTION ARGUMENTS 00838000
OPTNARG C R9,=A(VCPUID) CPUID OPTION? @V60C1BD 00839000
BNE OPTNAFF BR IF NOT @V60C1BD 00840000
LA R2,LVCPUID SET UP MAX LENGTH OF CPUID ARG. @V60C1BD 00841000
BAL R9,FINDLA FIND LENGTH OF CPUID ARGUMENT @V60C1BD 00842000
BNZ OPTNERR1 BR IF ERROR @V60C1BD 00843000
BAL R9,BCDTOHEX CONVERT TO HEX @V60C1BD 00844000
BNZ OPTNERR1 BR IF ERROR @V60C1BD 00845000
** 00846000
STCM R2,B'0111',UWORK SAVE NEW CPUID @V60C1BD 00847000
XC UWORK(L'UMACPUID),MASK OBSCURE CPUID @V60C1BD 00848000
** 00849000
B OPTNBCT @V60C1BD 00850000
SPACE 1 00851000
OPTNAFF C R9,=A(VAFFIN) AFFINITY OPTION? @V60C1BD 00852000
BNE OPTNERR1 BR IF NOT, ERROR @V60C1BD 00853000
LA R2,LVAFFIN SET UP MAX LENGTH OF AFFIN. ARG. @V60C1BD 00854000
BAL R9,FINDLN FIND LENGTH OF AFFINITY ARGUMENT @V60C1BD 00855000
BNZ OPTNERR1 BR IF ERROR @V60C1BD 00856000
BAL R9,BCDTOBIN CONVERT TO BINARY @V60C1BD 00857000
BNZ OPTNERR1 BR IF ERROR @V60C1BD 00858000
** 00859000
STC R2,UWORK+3 SAVE AFFINITY @V60C1BD 00860000
OI UWORK+3,UMACFFON SPECIFY AFFINITY @V60C1BD 00861000
XC UWORK+3(L'UMACFFON),MASK OBSCURE AFFINITY @V60C1BD 00862000
** 00863000
B OPTNBCT @V60C1BD 00864000
SPACE 1 00865000
OPTNERR1 LA R15,ERROPTN1 INVALID OPTION @V60C1BD 00866000
B EXITCC1 ERROR RETURN @V60C1BD 00867000
SPACE 1 00868000
OPTNERR2 LA R15,ERROPTN2 NO FENCE AT END OF PLIST @V60C1BD 00869000
B EXITCC1 ERROR RETURN @V60C1BD 00870000
SPACE 1 00871000
OPTNERR3 LA R15,ERROPTN3 INVALID ACCUM. OPTION VALUE @V60C1BD 00872000
B EXITCC1 ERROR RETURN @V60C1BD 00873000
SPACE 1 00874000
* EXECUTED INSTRUCTION 00875000
CLCOPTN CLC 0(*-*,R1),OPTNAME LOOK FOR OPTION MATCH @V60C1BD 00876000
SPACE 1 00877000
DROP R5,R7 @V60C1BD 00878000
EJECT 00879000
*-------------------------------------------------------------- 00880000
* IPL | 00881000
*---------- 00882000
* THE UDIRBLOK HAS BEEN READ AND THE LOGON PASSWORDS MATCH 00883000
* 00884000
* OPERATION: 00885000
* 1. READ THE UMACBLOK FOR THE USERID 00886000
* 2. ESTABLISH THE NEW IPL DATA 00887000
* 00888000
*-------------------------------------------------------------- 00889000
IPL DS 0H @V60C1BD 00890000
SPACE 1 00891000
* GET THE UMACBLOK 00892000
BAL R9,READUMAC @V60C1BD 00893000
BNE OPRET BR IF ERROR READING UMAC @V60C1BD 00894000
SPACE 1 00895000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00896000
USING UMACBLOK,R5 @V60C1BD 00897000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00898000
BO TMBY9 BR IF YES @V60C1BD 00899000
MVC UMACIPL(L'UMACIPL),UIPL ESTABLISH NEW IPL NAME @V60C1BD 00900000
XC UMACIPL(L'UMACIPL),MASK OBSCURE IPL NAME @V60C1BD 00901000
TMBY9 DS 0H @V60C1BD 00902000
B MACXCC0 @V60C1BD 00903000
SPACE 1 00904000
DROP R5 @V60C1BD 00905000
EJECT 00906000
*-------------------------------------------------------------- 00907000
* DISTRIB | 00908000
*---------- 00909000
* THE UDIRBLOK HAS BEEN READ AND THE LOGON PASSWORDS MATCH 00910000
* 00911000
* OPERATION: 00912000
* 1. READ THE UMACBLOK 00913000
* 2. ESTABLISH THE NEW DISTRIBUTION DATA 00914000
* 00915000
*-------------------------------------------------------------- 00916000
DISTRIB DS 0H @V60C1BD 00917000
SPACE 1 00918000
* GET THE UMACBLOK 00919000
BAL R9,READUMAC @V60C1BD 00920000
BNE OPRET BR IF ERROR READING UMAC @V60C1BD 00921000
SPACE 1 00922000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00923000
USING UMACBLOK,R5 @V60C1BD 00924000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 00925000
BO TMBY10 BR IF YES @V60C1BD 00926000
MVC UMACDIST(L'UMACDIST),UDISTRIB EST. NEW DIST. @V60C1BD 00927000
XC UMACDIST(L'UMACDIST),MASK OBSCURE DISTRIBUTION @V60C1BD 00928000
TMBY10 DS 0H @V60C1BD 00929000
B MACXCC0 @V60C1BD 00930000
SPACE 1 00931000
DROP R5 @V60C1BD 00932000
EJECT 00933000
*-------------------------------------------------------------- 00934000
* ACCOUNT | 00935000
*---------- 00936000
* THE UDIRBLOK HAS BEEN READ AND THE LOGON PASSWORDS MATCH 00937000
* 00938000
* OPERATION: 00939000
* 1. IF THE OPERATION IS TEMPORARY, BYPASS READING THE UMACBLOK 00940000
* AND SET A FLAG TO SUPPRESS UPDATING THE OBJECT DIRECTORY 00941000
* AND GO TO STEP 4. 00942000
* 2. ELSE, READ THE UMACBLOK 00943000
* 3. IF THE OPERATION IS NORMAL, GO TO STEP 10 TO ESTABLISH NEW 00944000
* ACCOUNT DATA. 00945000
* 4. ELSE, CHECK IF OBJECT USER IS ACTIVE. IF NOT, GO TO STEP 10 00946000
* TO ESTABLISH NEW ACCOUNT DATA. 00947000
* 5. GET FREE STORAGE FOR A COMMAND BUFFER. 00948000
* 6. CALL DMKCPVAC (ACNT COMMAND) TO CREATE AN ACCOUNTING RECORD 00949000
* BASED ON THE CURRENT ACCOUNT DATA. 00950000
* 7. RETURN COMMAND BUFFER FREE STORAGE. 00951000
* 8. UPDATE ACCOUNTING FIELD IN OBJECT USERID'S VMBLOK. 00952000
* 9. IF OPERATION IS TEMPORARY, RETURN TO MAIN LINE. 00953000
* 10. ESTABLISH NEW ACCOUNT DATA IN OBJECT DIRECTORY AND RETURN. 00954000
* 00955000
*-------------------------------------------------------------- 00956000
ACCOUNT DS 0H @V60C1BD 00957000
SPACE 1 00958000
* CHECK WHETHER OPERATION IS TEMPORARY. IF SO, DO NOT GET 00959000
* THE UMACBLOK, AND SET NO-UPDATE FLAG. 00960000
CLC UOP(L'UOP),KTACCT IS OPERATION TEMPORARY? @V60C1BD 00961000
BNE ACCRDMAC BR IF NOT @V60C1BD 00962000
SPACE 1 00963000
OI UFLAGS,UNOUPF SET NO-UPDATE FLAG @V60C1BD 00964000
B ACHKACT GO CHECK FOR ACTIVE OBJECT USER @V60C1BD 00965000
SPACE 1 00966000
* GET THE UMACBLOK 00967000
ACCRDMAC BAL R9,READUMAC @V60C1BD 00968000
BNE OPRET BR IF ERROR READING UMAC @V60C1BD 00969000
SPACE 1 00970000
L R5,UMACAD GET REAL ADDRESS OF UMAC @V60C1BD 00971000
USING UMACBLOK,R5 @V60C1BD 00972000
SPACE 1 00973000
* IF OPERATION IS NORMAL ACCOUNT, JUST UPDATE THE OBJECT 00974000
* DIRECTORY. IF OPERATION IS IMMEDIATE, UPDATE THE 00975000
* VMBLOK AS WELL, BUT BEFOREHAND, CAUSE AN ACCOUNTING RECORD 00976000
* TO BE CREATED. 00977000
CLC UOP(L'UOP),KACCOUNT NORMAL ACCOUNT? @V60C1BD 00978000
BE NACCT BR IF YES @V60C1BD 00979000
SPACE 1 00980000
* CHECK WHETHER USER IS ACTIVE 00981000
ACHKACT BAL R9,FINDVMBK @V60C1BD 00982000
BNZ TMBY12 BR IF VMBLOK NOT FOUND @VA11229 00983010
ST R1,UOBJVMBK SAVE OBJECT VMBLOK @V60C1BD 00984000
SPACE 1 00985000
* CREATE ACCOUNTING RECORD VIA ACNT COMMAND 00986000
ST R11,UVMBLOK SAVE CALLER'S VMBLOK ADDRESS @V60C1BD 00987000
L R1,ASYSOP GET SYSTME OP'S ADDRESS @VA10286 00988010
SWTCHVM @VA10286 00988020
LA R0,BUFSIZE GET CONSOLE BUFFER SIZE @V60C1BD 00989000
CALL DMKFREE GET COMMAND BUFFER @V60C1BD 00990000
LR R9,R1 ACNT NEEDS BUFFER ADDRESS IN R9 @V60C1BD 00991000
USING BUFFER,R9 @V60C1BD 00992000
MVC 0(8,R1),BLANKS BLANK BUFFER @V60C1BD 00993000
MVC 8((BUFSIZE-1)*8,R1),0(R1) @V60C1BD 00994000
MVC 0(5,R1),=CL5'ACNT ' SET COMMAND NAME @V60C1BD 00995000
MVC 5(L'UWORK,R1),UWORK SET READABLE USERID IN CMD @V60C1BD 00996000
LA R0,13 SET MAX. LENGTH OF 'ACNT'+USERID @V60C1BD 00997000
ST R0,BUFCNT SET UP START OF CMD AT END OF BUF@V60C1BD 00998000
LA R1,5(,R1) POINT TO USERID @V60C1BD 00999000
ST R1,BUFNXT PUT INTO BUFFER CNTRL FIELD @V60C1BD 01000000
DROP R9 @V60C1BD 01001000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 01002000
BO TMBY11 BR IF YES @V60C1BD 01003000
CALL DMKCPVAC CALL ACNT PROCESSOR @V60C1BD 01004000
TMBY11 DS 0H @V60C1BD 01005000
SPACE 1 01006000
* FREE BUFFER 01007000
LA R0,BUFSIZE GET BUFFER SIZE @V60C1BD 01008000
LR R1,R9 POINT TO BUFFER @V60C1BD 01009000
CALL DMKFRET FREE BUFFER @V60C1BD 01010000
L R1,UVMBLOK RESTORE CALLER'S VMBLOK @VA10286 01011010
SWTCHVM @VA10286 01011020
SPACE 1 01012000
* UPDATE ACCOUNT FIELD IN OBJECT VMBLOK 01013000
L R1,UOBJVMBK GET OBJECT VMBLOK @V60C1BD 01014000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 01015000
BO TMBY12 BR IF YES @V60C1BD 01016000
MVC VMACNT-VMBLOK(L'UACCOUNT,R1),UACCOUNT @V60C1BD 01017000
TMBY12 DS 0H @V60C1BD 01018000
SPACE 1 01019000
* CHECK FOR TEMPORARY UPDATE AGAIN 01020000
CLC UOP(L'UOP),KTACCT TEMPORARY? @V60C1BD 01021000
BE MACXCC0 BR IF YES @V60C1BD 01022000
SPACE 1 01023000
NACCT DS 0H @V60C1BD 01024000
TM UFLAGS,UTESTMD TEST MODE? @V60C1BD 01025000
BO TMBY13 BR IF YES @V60C1BD 01026000
MVC UMACACCT(L'UMACACCT),UACCOUNT EST. NEW ACCT. @V60C1BD 01027000
XC UMACACCT(L'UMACACCT),MASK OBSCURE ACCOUNT DATA @V60C1BD 01028000
TMBY13 DS 0H @V60C1BD 01029000
B MACXCC0 @V60C1BD 01030000
SPACE 1 01031000
DROP R5 @V60C1BD 01032000
EJECT 01033000
*-------------------------------------------------------------- 01034000
* SUBROUTINE TO READ UDIRBLOK PAGES AND LOCATE A SPECIFIED 01035000
* USERID'S UDIRBLOK. 01036000
*-------------------------------------------------------------- 01037000
* 01038000
* ENTRY CONDITIONS: 01039000
* R3: ADDRESS OF UCNTRL 01040000
* R9: RETURN ADDRESS 01041000
* 01042000
* EXIT CONDITIONS: 01043000
* R3: ADDRESS OF UCNTRL (WITH DATA FILLED IN UCNTRL) 01044000
* CC0: OPERATION WAS SUCCESSFUL 01045000
* CC1: ERROR, 'URETCODE' IN UCNTRL CONTAINS DETAILS 01046000
* 01047000
* OPERATION: 01048000
* THE OBJECTIVE IS TO READ UDIRBLOK PAGES AND LOCATE THE UDIRBLOK 01049000
* OF THE USERID. THE UCNTRL BLOCK IS UPDATED WITH PERTINENT 01050000
* DATA ABOUT AND FROM THE UDIRBLOK NEEDED IN PROCESSING THE 01051000
* REQUEST. THE DATA FIELDS NEEDED ARE: 1) THE OBJECT DASD ADDRESS 01052000
* OF THE UDIRBLOK, 2) THE VIRTUAL SYSTEM PAGE ADDRESS OF THE 01053000
* UDIRBLOK, 3) THE REAL PAGE ADDRESS OF THE UDIRBLOK, 4) THE 01054000
* READ ADDRESS OF THE USER'S ENTRY IN THE UDIRBLOK, 5) THE 01055000
* ADDRESS OF THE USER'S UMACBLOK, AND 6) THE DISPLACEMENT OF THE 01056000
* THE USER'S UMACBLOK ENTRY. 01057000
* THE 'TRANS' MACRO IS USED TO READ UDIRBLOK PAGES USING THE 01058000
* VIRTUAL PAGE ADDRESSES FROM THE DMKSYSPL LIST. CONCURRENTLY, 01059000
* THE OBJECT DASD ADDRESS OF EACH PAGE CORRESPONDING TO A PAGE IN 01060000
* THE LIST IS EXTRACTED, INITIALLY FROM DMKSYSUD AND THEN FROM 01061000
* EACH UDIRBLOK, AND SAVED. 01062000
* 01063000
* 1. GET THE DASD ADDRESS OF THE FIRST UDIRBLOK PAGE ON OBJECT 01064000
* DASD AND POINTER TO LIST OF SYSTEM VIRTUAL PAGES OF 01065000
* UDIRBLOKS. 01066000
* 2. PAGE IN A UDIRBLOK PAGE USING THE 'TRANS' MACRO. 01067000
* 3. SAVE THE REAL ADDRESS OF THE UDIRBLOK PAGE AND SEARCH FOR THE 01068000
* USER'S UDIRBLOK ENTRY. IF NOT FOUND IN A PAGE, SAVE THE 01069000
* OBJECT DASD ADDRESS OF THE NEXT PAGE AND TRANS IN THE NEXT 01070000
* PAGE USING THE VIRTUAL ADDRESS IN THE LIST. CONTINUE THIS 01071000
* PROCESS UNTIL THE USER IS FOUND OR THE END OF THE LIST IS 01072000
* REACHED (SIGNALLED BY THE LAST ENTRY BEING NEGATIVE). THERE 01073000
* IS A CHECK TO MAKE SURE THAT FOR EACH VIRTUAL PAGE IN 01074000
* THE LIST THERE IS A CORRESPONDING OBJECT DASD ADDRESS. 01075000
* 4. IF THE USER'S ENTRY IS FOUND, THE PLIST CURRENT PASSWORD IS 01076000
* COMPARE WITH THE DIRECTORY CURRENT PASSWORD. A MISMATCH IS 01077000
* AN ERROR UNLESS THE PLIST PASSWORD IS BLANK IN WHICH CASE 01078000
* THE TEST MODE IS INDICATED. (NO UPDATING IS DONE IN THE 01079000
* TEST MODE). 01080000
* 5. IF THE USER'S ENTRY IS FOUND, THE DATA DESCRIBED ABOVE IS 01081000
* SAVED AND CONTROL IS RETURNED TO THE CALLER WITH CC=0 AND 01082000
* 'URETCODE' IN THE UCNTRL SET TO 0. 01083000
* 6. IF ANY ERRORS ARE ENCOUNTERED, AN ERROR CODE IS PLACED IN 01084000
* 'URETCODE' AND THE CC IS SET TO 1 BEFORE RETURNING TO THE 01085000
* CALLER. 01086000
* 01087000
* NOTES: 01088000
* 1) THE FIRST UDIRBLOK IN A PAGE IS USED FOR CONTROL, IT DOES 01089000
* NOT CONTAIN DATA FOR A USERID. THE 'UDIRDISP' FIELD CONTAINS 01090000
* THE DISPLACEMENT TO THE LAST UDIRBLOK IN THE PAGE, AND THE 01091000
* 'UDIRDASD' FIELD CONTAINS THE ADDRESS OF THE NEXT UDIR PAGE. 01092000
* 01093000
*-------------------------------------------------------------- 01094000
* INITIALIZATION... 01095000
READUDIR DS 0H @V60C1BD 01096000
L R0,DMKSYSUD GET POINTER TO FIRST DASD PAGE @V60C1BD 01097000
L R4,DMKSYSPL GET ADDRESS OF LIST OF POINTERS @V60C1BD 01098000
L R1,0(,R4) GET ADDRESS FROM LIST @V60C1BD 01099000
B CALLRU @V60C1BD 01100000
SPACE 1 01101000
* ...WHEN NEW PAGE IS NEEDED: 01102000
USING UDIRBLOK,R2 @V60C1BD 01103000
NEWPAGE L R2,URPAGDIR GET ADDRESS OF FIRST UDIR IN PAGE@V60C1BD 01104000
L R0,UDIRDASD GET NEXT DASD PTR @V60C1BD 01105000
LA R4,4(,R4) INCREMENT LIST PTR. TO NEXT ENTRY@V60C1BD 01106000
L R1,0(,R4) GET NEXT VIRTUAL PAGE ADDRESS @V60C1BD 01107000
LTR R1,R1 END OF LIST? @V60C1BD 01108000
BM LISTEND BR IF YES @V60C1BD 01109000
SPACE 1 01110000
* CHECK IF THERE IS A VALID DASD PTR. THERE SHOULD BE, AND IF NOT, 01111000
* THERE IS AN ERROR. 01112000
CALLRU LTR R0,R0 IS THERE A VALID DASD PTR? @V60C1BD 01113000
BM SYNCHERR BR IF NOT @V60C1BD 01114000
IC R0,DMKSYSUD+3 GET DEVICE CODE FROM SYSTEM @V60C1BD 01115000
BNZ RUREAD BR IF YES @V60C1BD 01116000
SPACE 1 01117000
* START FROM BEGINNING, USING PTR IN DMKSYSUD 01118000
L R0,DMKSYSUD GET POINTER TO START OF UDIRBLOKS@V60C1BD 01119000
RUREAD TRANS R2,R1,OPT=(BRING+SYSTEM+DEFER),IOER=RDERROR @V60C1BD 01120000
SPACE 1 01121000
*-------------------------------------------------------------- 01122000
* UDIRBLOK PAGE NOW IN REAL STORAGE AND REGISTERS ARE: 01123000
* R0 = DASD POINTER (0CCCPPDD) 01124000
* R1 = VIRTUAL PAGE STORAGE ADDRESS 01125000
* R2 = REAL PAGE STORAGE ADDRESS 01126000
* R3 = UCNTRL ADDRESS 01127000
* 01128000
* SEARCH FOR USERID PASSED IN PLIST (IN UIPARMS CONTROL BLK) 01129000
* (UDIRBLOKS ARE PACKED SEQUENTIALLY IN THE PAGE) 01130000
*-------------------------------------------------------------- 01131000
LH R5,UDIRDISP GET DISPL TO END OF UDIRBLOK PAGE@V60C1BD 01132000
AR R5,R2 SET R5 TO REAL ADDR. OF PAGE END @V60C1BD 01133000
ST R2,URPAGDIR PUT REAL PAGE ADDR. IN CTL. BLOCK@V60C1BD 01134000
FINDUSER LA R2,UDIRSIZE*8(,R2) POINT TO 1ST (NEXT) UDIRBLOK@V60C1BD 01135000
CLR R2,R5 HAS END OF PAGE BEEN REACHED? @V60C1BD 01136000
BH NEWPAGE BR IF YES... GET NEW PAGE @V60C1BD 01137000
CLC UUSERID(L'UUSERID),UDIRUSER USERID MATCH? @V60C1BD 01138000
BNE FINDUSER BR IF NOT @V60C1BD 01139000
SPACE 1 01140000
* FOR SAFETY, CHECK THAT THE LOGON PASSWORDS MATCH 01141000
CLC UCURPASS(L'UCURPASS),UDIRPASS LOG PASSWD MATCH?@V60C1BD 01142000
BE UF BR IF YES @V60C1BD 01143000
* IF THE CURRENT PASSWORD PASSED IN THE PLIST IS BLANK, THIS 01144000
* INDICATES THAT THE TEST MODE IS REQUESTED. NO UPDATING IS 01145000
* PERFORMED. 01146000
CLC UCURPASS(L'UCURPASS),MBLANKS BLANK PASSWORD? @VMI0009 01147000
BNE MATCHERR BR IF NOT @V60C1BD 01148000
OI UFLAGS,UTESTMD SET TEST MODE FLAG @V60C1BD 01149000
UF DS 0H @V60C1BD 01150000
SPACE 1 01151000
* THE USERID HAS BEEN LOCATED. RETURN DATA TO CALLER 01152000
ST R0,UDASDDIR PUT DASD ADDR. INTO CONTROL BLOCK@V60C1BD 01153000
ST R1,UVPAGDIR VIRT. PAGE ADDR. TO CTL. BLOCK @V60C1BD 01154000
ST R2,UDIRAD REAL UDIRBLOK ADDR. TO CTL BLK @V60C1BD 01155000
MVC UDISPMAC(L'UDISPMAC+L'UDASDMAC),UDIRDISP SAVE @V60C1BD 01156000
* DISPLACEMENT OF UMAC IN UCNTRL. 01157000
SPACE 1 01158000
RDRETCC0 SR R15,R15 ZERO R15 FOR RETCODE AND CC @V60C1BD 01159000
STH R15,URETCODE SET RETURN CODE AND CC TO 0 @V60C1BD 01160000
BR R9 RETURN TO CALLER @V60C1BD 01161000
SPACE 1 01162000
MATCHERR LA R15,ERRMATCH INDICATE A PASSWORD MISMATCH @V60C1BD 01163000
B RDRETCC1 @V60C1BD 01164000
SPACE 1 01165000
LISTEND LTR R0,R0 IS THERE A DASD PTR? @V60C1BD 01166000
LA R15,ERRUID SET UP FOR NO USERID ERROR @V60C1BD 01167000
BZ RDRETCC1 BR IF NOT, THERE SHOULDN'T BE @V60C1BD 01168000
SPACE 1 01169000
* THERE IS A SYNCHRONISM ERROR. THE END OF THE VIRTUAL PAGE 01170000
* LIST DOESN'T CORRESPOND TO THE END OF THE DASD PTRS. 01171000
SYNCHERR LA R15,ERRSYNC INDICATE A SYNCH ERROR @V60C1BD 01172000
B RDRETCC1 RETURN CC = 1 @V60C1BD 01173000
SPACE 1 01174000
RDERROR LA R15,ERREAD SET RETURN CODE FOR READ ERROR @V60C1BD 01175000
SPACE 1 01176000
RDRETCC1 STH R15,URETCODE STORE IN CONTROL BLOCK @V60C1BD 01177000
TM *+1,X'F0' SET CC = 1 @V60C1BD 01178000
BR R9 RETURN TO CALLER @V60C1BD 01179000
SPACE 1 01180000
DROP R2 @V60C1BD 01181000
EJECT 01182000
*-------------------------------------------------------------- 01183000
* SUBROUTINE TO LOCATE AND READ UMACBLOKS | 01184000
*---------------------------------------------- 01185000
* 01186000
* ON ENTRY: 01187000
* R3 = ADDRESS OF UCNTRL BLOCK 01188000
* R9 = RETURN ADDRESS 01189000
* 01190000
* ON EXIT: 01191000
* R3 = ADDRESS OF UCNTRL BLOCK (FILLED IN) 01192000
* CC0: OPERATION WAS SUCCESSFUL 01193000
* CC1: ERROR, 'URETCODE' CONTAINS DETAILS 01194000
* 01195000
* OPERATION: 01196000
* 1. DETERMINE IF A VIRTUAL PAGE BUFFER FOR UMAC AND UDEV BLOCKS 01197000
* IS AVAILABLE. IF NOT, GET ONE VIA 'DMKPGTVG' AND PUT ITS 01198000
* ADDRESS IN UCNTRL. 01199000
* 2. GET DASD ADDRESS OF 'UMACBLOK' FROM UCNTRL BLOCK 01200000
* 3. READ THE 'UMACBLOK' VIA 'DMKRPAGT' 01201000
* 4. SAVE THE DASD ADDRESS IF THE FIRST 'UDEVBLOK' IN UCNTRL 01202000
* 5. RETURN TO THE CALLER WITH UCNTRL FILLED IN AND THE CC SET. 01203000
* 01204000
*---------------------------------------------------------------------- 01205000
READUMAC DS 0H @V60C1BD 01206000
L R1,UVPAGBUF GET BUFFER ADDRESS @V60C1BD 01207000
LTR R1,R1 IS THERE A BUFFER? @V60C1BD 01208000
BNZ GMACAD BR IF YES @V60C1BD 01209000
SPACE 1 01210000
* GET A BUFFER FOR UMAC AND UDEV PAGES 01211000
CALL DMKPGTVG GET A VIRTUAL PAGE BUFFER @V60C1BD 01212000
ST R1,UVPAGBUF SAVE ADDRESS IN UCNTRL @V60C1BD 01213000
GMACAD L R0,UDASDMAC GET DASD ADDR OF UMAC FROM UCNTRL@V60C1BD 01214000
LTR R0,R0 IS THERE A UMAC DASD ADDRESS? @V60C1BD 01215000
BZ MACERR1 BR IF NONE, ERROR @V60C1BD 01216000
SPACE 1 01217000
* READ UMAC DASD PAGE INTO VIRTUAL STORAGE 01218000
IC R0,DMKSYSUD+3 POINT TO DEVICE IN OWNED LIST @V60C1BD 01219000
LA R2,SYSTEM SPECIFY SYSTEM OPTION @V60C1BD 01220000
CALL DMKRPAGT @V60C1BD 01221000
TRANS R2,R1,OPT=(BRING,DEFER,SYSTEM),IOER=MACERR2 @V60C1BD 01222000
ST R2,URPAGMAC SAVE REAL UMAC PG. ADDR IN UCNTRL@V60C1BD 01223000
AH R2,UDISPMAC ADD DISPL. TO UMAC PAGE ADDRESS @V60C1BD 01224000
USING UMACBLOK,R2 @V60C1BD 01225000
ST R2,UMACAD SAVE 'UMACBLOK' ADDRESS IN UCNTRL@V60C1BD 01226000
MVC UDISPDEV(L'UDISPDEV+L'UDASDDEV),UMACDISP SAVE @V60C1BD 01227000
* UDEV DISP/DASD FROM UMAC 01228000
SPACE 1 01229000
* RETURN TO CALLER 01230000
SR R15,R15 ...FOR CC = 0 @V60C1BD 01231000
STH R15,URETCODE NO ERROR @V60C1BD 01232000
BR R9 RETURN @V60C1BD 01233000
SPACE 1 01234000
MACERR1 DS 0H @V60C1BD 01235000
LA R15,ERRMAC1 @V60C1BD 01236000
B RDMRTCC1 ERROR RETURN @V60C1BD 01237000
MACERR2 DS 0H @V60C1BD 01238000
LA R15,ERRMAC2 @V60C1BD 01239000
B RDMRTCC1 ERROR RETURN @V60C1BD 01240000
SPACE 1 01241000
RDMRTCC1 STH R15,URETCODE SAVE IN UCNTRL @V60C1BD 01242000
TM *+1,X'F0' SET CC = 1 @V60C1BD 01243000
BR R9 RETURN @V60C1BD 01244000
SPACE 1 01245000
DROP R2 @V60C1BD 01246000
EJECT 01247000
*-------------------------------------------------------------- 01248000
* SUBROUTINE TO LOCATE AND READ UDEVBLOKS | 01249000
*-------------------------------------------- 01250000
* 01251000
* ON ENTRY: 01252000
* R3 = ADDRESS OF UCNTRL 01253000
* R9 = RETURN ADDRESS 01254000
* 01255000
* ON EXIT: 01256000
* R3 = ADDRESS OF UCNTRL 01257000
* CC0: OPERATION WAS SUCCESSFUL 01258000
* CC1: ERROR, 'URETCODE' CONTAINS DETAILS 01259000
* 01260000
* OPERATION: 01261000
* 1. DETERMINE IF A VIRTUAL PAGE BUFFER FOR UMAC AND UDEV BLOCKS 01262000
* IS AVAILABLE. IF NOT, GET ONE VIA 'DMKPGTVG' AND PUT ITS 01263000
* ADDRESS IN UCNTRL. 01264000
* 2. GET DASD ADDRESS OF FIRST 'UDEVBLOK' FROM UCNTRL BLOCK 01265000
* 3. READ THE FIRST 'UDEVBLOK' VIA 'DMKRPAGT' 01266000
* 4. KEEP READING UDEVBLOK'S UNTIL THE SPECIFIED DEVICE IS FOUND. 01267000
* 5. SAVE THE DATA RELATED TO THE UDEVBLOK. 01268000
* 6. RETURN TO THE CALLER WITH UCNTRL FILLED IN AND THE CC SET. 01269000
* 01270000
*-------------------------------------------------------------- 01271000
READUDEV DS 0H @V60C1BD 01272000
L R1,UVPAGBUF GET BUFFER ADDRESS @V60C1BD 01273000
LTR R1,R1 IS THERE A BUFFER? @V60C1BD 01274000
BNZ GDEVAD BR IF YES @V60C1BD 01275000
SPACE 1 01276000
* GET A UMAC/UDEV BUFFER 01277000
CALL DMKPGTVG GET A VIRTUAL PAGE BUFFER @V60C1BD 01278000
ST R1,UVPAGBUF SAVE ADDRESS IN UCNTRL @V60C1BD 01279000
GDEVAD L R0,UDASDDEV GET DASD ADDR OF UDEV FROM UCNTRL@V60C1BD 01280000
LTR R0,R0 IS THERE A UDEV DASD ADDRESS? @V60C1BD 01281000
BZ DEVERR1 BR IF NONE, ERROR @V60C1BD 01282000
SPACE 1 01283000
* READ UDEV DASD PAGE INTO VIRTUAL STORAGE 01284000
GNEXTDVP IC R0,DMKSYSUD+3 POINT TO DEVICE IN OWNED LIST @V60C1BD 01285000
LA R2,SYSTEM SPECIFY SYSTEM OPTION @V60C1BD 01286000
CALL DMKRPAGT @V60C1BD 01287000
TRANS R2,R1,OPT=(BRING,DEFER,SYSTEM),IOER=DEVERR2 @V60C1BD 01288000
ST R2,URPAGDEV SAVE REAL UDEV PG. ADDR IN UCNTRL@V60C1BD 01289000
AH R2,UDISPDEV ADD DISPL. TO UDEV PAGE ADDRESS @V60C1BD 01290000
USING UDEVBLOK,R2 @V60C1BD 01291000
SVDEVAD ST R2,UDEVAD SAVE 'UDEVBLOK' ADDRESS IN UCNTRL@V60C1BD 01292000
SPACE 1 01293000
* FIND THE UDEVBLOK 01294000
CLC UDEVADD(L'UDEVADD),ULOCDVAD THE DEVICE? @V60C1BD 01295000
BE DEVRET BR IF YES @V60C1BD 01296000
SPACE 1 01297000
* DEVICE NOT THIS ONE, CONTINUE TO LOOK 01298000
L R0,UDEVDASD GET DASD ADDRESS OF NEXT UDEV @V60C1BD 01299000
LTR R0,R0 ANY MORE? @V60C1BD 01300000
BZ DEVERR3 BR IF NOT, DEVICE NOT FOUND @V60C1BD 01301000
LH R2,UDEVDISP GET DISPLACEMENT OF NEXT UDEV @V60C1BD 01302000
STH R2,UDISPDEV SAVE DISPLACEMENT IN UCNTRL @V60C1BD 01303000
C R0,UDASDDEV SAME AS CURRENT DASD ADDRESS? @V60C1BD 01304000
ST R0,UDASDDEV SAVE NEXT DASD ADDRESS IN UCNTRL @V60C1BD 01305000
BNE GNEXTDVP BR IF NOT, GET NEXT PAGE @V60C1BD 01306000
A R2,URPAGDEV CALC. REAL ADDRESS OF NEXT UDEV @V60C1BD 01307000
B SVDEVAD @V60C1BD 01308000
SPACE 1 01309000
* RETURN TO CALLER 01310000
DEVRET SR R15,R15 ...FOR CC = 0 @V60C1BD 01311000
STH R15,URETCODE NO ERROR @V60C1BD 01312000
BR R9 RETURN @V60C1BD 01313000
SPACE 1 01314000
DEVERR1 DS 0H @V60C1BD 01315000
LA R15,ERRDEV1 @V60C1BD 01316000
B RDVRTCC1 ERROR RETURN @V60C1BD 01317000
SPACE 1 01318000
DEVERR2 DS 0H @V60C1BD 01319000
LA R15,ERRDEV2 @V60C1BD 01320000
B RDVRTCC1 ERROR RETURN @V60C1BD 01321000
SPACE 1 01322000
DEVERR3 DS 0H DEVICE NOT FOUND ERROR @V60C1BD 01323000
LA R15,ERRDEV3 @V60C1BD 01324000
B RDVRTCC1 ERROR RETURN @V60C1BD 01325000
SPACE 1 01326000
RDVRTCC1 STH R15,URETCODE SAVE IN UCNTRL @V60C1BD 01327000
TM *+1,X'F0' SET CC = 1 @V60C1BD 01328000
BR R9 RETURN @V60C1BD 01329000
SPACE 1 01330000
DROP R2 @V60C1BD 01331000
EJECT 01332000
*-------------------------------------------------------------- 01333000
* SUBROUTINE TO FIND THE VMBLOK OF THE USER BEING UPDATED | 01334000
*------------------------------------------------------------- 01335000
* 01336000
* ON ENTRY: 01337000
* R9 = RETURN REGISTER 01338000
* 01339000
* ON EXIT: 01340000
* CC = 0 THEN, 01341000
* R1 = ADDRESS OF VMBLOK 01342000
* 01343000
* CC ¬= 0 THEN VMBLOK NOT FOUND 01344000
* 01345000
* REGISTER USAGE: R0-R2,R14,R15 ( AND R6-R8 IN FINDLA ) 01346000
* REGISTER TRANSPARENCY: R3-R5,R9-R13 01347000
* 01348000
*-------------------------------------------------------------- 01349000
FINDVMBK DS 0H @V60C1BD 01350000
LR R0,R9 SAVE RETURN REGISTER @V60C1BD 01351000
MVC UWORK(L'UUSERID),UUSERID MOVE USERID TO WORK @V60C1BD 01352000
XC UWORK(L'UWORK),MASK CONVERT TO READABLE USERID@V60C1BD 01353000
LA R1,UWORK POINT TO USERID IN WORK AREA @V60C1BD 01354000
LA R2,8 SET MAX. LENGTH OF USERID @V60C1BD 01355000
BAL R9,FINDLA GET LENGTH OF USERID @V60C1BD 01356000
LR R9,R0 RESTORE RETURN REGISTER @V60C1BD 01357000
SPACE 1 01358000
* R1 = ADDRESS OF USERID FIELD, R2 = LENGTH OF USERID 01359000
LR R0,R2 DMKSCNAU NEEDS LENGTH IN R0 @V60C1BD 01360000
CALL DMKSCNAU LOCATE VMBLOK @V60C1BD 01361000
BR R9 RETURN WITH CC SET @V60C1BD 01362000
EJECT 01363000
*-------------------------------------------------------------- 01364000
* SUBROUTINE TO LOCATE THE LENGTH OF A DATA FIELD | 01365000
*----------------------------------------------------- 01366000
* 01367000
* ENTRY POINTS: 01368000
* FINDLA: ALLOW ALPHA BYTES 01369000
* FINDLN: DO NOT ALLOW ALPHA BYTES 01370000
* 01371000
* ON ENTRY: 01372000
* R1 = ADDRESS OF BEGINNING OF FIELD 01373000
* R2 = MAXIMUM LENGTH OF FIELD 01374000
* R9 = RETURN REGISTER 01375000
* 01376000
* ON EXIT: 01377000
* CC = 0, THEN 01378000
* R1 = ADDRESS OF BEGINNING OF FIELD 01379000
* R2 = LENGTH OF FIELD IN BYTES (OR ZERO IF ERROR) 01380000
* 01381000
* CC ¬= 0, THEN 01382000
* R1 = ADDRESS OF BEGINNING OF FIELD 01383000
* R2 = LENGTH OF FIELD UP TO AND INCLUDING OFFENDING BYTES 01384000
* 01385000
* OPERATION: 01386000
* 1. SET REGISTER TO INDICATE WHETHER ALPHA BYTES ARE ALLOWED 01387000
* 2. SCAN DATA UNTIL EITHER A BLANK IS FOUND OR UNTIL THE END OF 01388000
* THE DATA IS REACHED. RETURN CC = 0 IF NO ERRORS FOUND 01389000
* 3. TEST EACH BYTE FOR NUMERIC. IF ALPHA, CHECK IF ALPHA ALLOWED. 01390000
* IF NOT, RETURN CC ¬= 0 01391000
* 01392000
* REGISTER USAGE: R2,R6-R8 01393000
* REGISTER TRANSPARENCY: R0,R1,R3-R5,R9-R15 01394000
* 01395000
*-------------------------------------------------------------- 01396000
FINDLA DS 0H FIND LENGTH, ALLOW ALPHA @V60C1BD 01397000
SR R6,R6 INDICATE ALPHA ALLOWED @V60C1BD 01398000
B FINDCM TO COMMON CODE @V60C1BD 01399000
SPACE 1 01400000
FINDLN DS 0H FIND LENGTH, ALLOW ONLY NUMERIC @V60C1BD 01401000
LA R6,1 INDICATE ALPHA NOT ALLOWED @V60C1BD 01402000
SPACE 1 01403000
FINDCM LR R7,R2 SAVE MAX. LENGTH @V60C1BD 01404000
SR R2,R2 CLEAR REG. AND USE FOR COUNT @V60C1BD 01405000
LR R8,R1 SAVE START ADDRESS @V60C1BD 01406000
SPACE 1 01407000
BLOOP CLI 0(R8),C' ' IS CHARACTER A BLANK? @V60C1BD 01408000
BER R9 BR IF YES, EXIT (RETURN CC = 0) @V60C1BD 01409000
LA R2,1(,R2) INCREMENT COUNT @V60C1BD 01410000
CLI 0(R8),C'0' IS CHARACTER < THAN 0? @V60C1BD 01411000
BL ALPHA BR IF YES @V60C1BD 01412000
CLI 0(R8),C'9' IS CHARACTER > 9? @V60C1BD 01413000
BHR R9 BR IF YES, ERROR (RETURN CC = 2) @V60C1BD 01414000
ALPHARET CR R7,R2 HAS MAX. BEEN REACHED? @V60C1BD 01415000
BER R9 BR IF YES, EXIT (RETURN CC = 0) @V60C1BD 01416000
LA R8,1(,R8) INCREMENT ADDRESS @V60C1BD 01417000
B BLOOP @V60C1BD 01418000
SPACE 1 01419000
ALPHA LTR R6,R6 ARE ALPHA BYTES ALLOWED? @V60C1BD 01420000
BNZR R9 RETURN IF NOT (CC = 2) @V60C1BD 01421000
B ALPHARET @V60C1BD 01422000
EJECT 01423000
*-------------------------------------------------------------- 01424000
* SUBROUTINE TO CONVERT EBCDIC VALUE IN THE RANGE 0-9 AND 01425000
* A-O TO HEX VALUE. 01426000
*-------------------------------------------------------------- 01427000
* 01428000
* ON ENTRY: 01429000
* R1 = ADDRESS OF FIRST BYTE OF FIELD TO BE CONVERTED 01430000
* R2 = LENGTH OF FIELD 01431000
* R9 = RETURN ADDRESS 01432000
* 01433000
* ON RETURN: 01434000
* CC = 0, 01435000
* R2 = THE CONVERTED VALUE, RIGHT JUSTIFIED 01436000
* 01437000
* CC ¬= 0, ERROR 01438000
* R2 = 0 01439000
* 01440000
* REGISTER USAGE: R1,R2,R6-R8 01441000
* REGISTER TRANSPARENCY: R1,R3-R5,R9-R15 01442000
* 01443000
*-------------------------------------------------------------- 01444000
BCDTOHEX DS 0H @V60C1BD 01445000
LR R7,R2 SAVE FIELD LENGTH @V60C1BD 01446000
SR R6,R6 CLEAR REG @V60C1BD 01447000
LR R8,R6 ... @V60C1BD 01448000
L1 IC R6,0(,R1) GET DIGIT @V60C1BD 01449000
CLI 0(R1),C'0' GREATER THAN ZERO? @V60C1BD 01450000
BL L3 NO TRY A-F @V60C1BD 01451000
CLI 0(R1),C'9' GREATER THAN NINE? @V60C1BD 01452000
BH BCDERR1 YES ERROR @V60C1BD 01453000
S R6,F240 MAKE DIGIT A HEX NO.(X'00'-X'09')@V60C1BD 01454000
B L2 CONTINUE @V60C1BD 01455000
L3 CLI 0(R1),C'A' LESS THAN "A"? @V60C1BD 01456000
BL BCDERR1 YES ERROR @V60C1BD 01457000
CLI 0(R1),C'F' GREATER THAN "F"? @V60C1BD 01458000
BH BCDERR1 YES ERROR @V60C1BD 01459000
SH R6,=AL2(C'A'-10) MAKE CHAR HEX NO.(X'0A'-X'0F')@V60C1BD 01460000
L2 SLL R8,4 ASSEMBLE NEXT DIGIT @V60C1BD 01461000
AR R8,R6 ... @V60C1BD 01462000
LA R1,1(,R1) BUMP PTR @V60C1BD 01463000
BCT R7,L1 LOOP THROUGH ENTIRE FIELD @V60C1BD 01464000
LR R2,R8 RETURN RESULT IN R1 @V60C1BD 01465000
SR R8,R8 SET CC=0 @V60C1BD 01466000
BR R9 RETURN @V60C1BD 01467000
SPACE 1 01468000
BCDERR1 DS 0H @V60C1BD 01469000
LA R2,0 RETURN ZERO WITHOUT DISTURBING CC@V60C1BD 01470000
BR R9 @V60C1BD 01471000
EJECT 01472000
*-------------------------------------------------------------- 01473000
* SUBROUTINE TO CONVERT EBCDIC NUMERIC VALUE TO BINARY | 01474000
*----------------------------------------------------------- 01475000
* 01476000
* ON ENTRY: 01477000
* R1 = ADDRESS OF FIRST BYTE OF FIELD TO BE CONVERTED 01478000
* R2 = LENGTH OF FIELD 01479000
* R9 = RETURN ADDRESS 01480000
* 01481000
* ON EXIT: 01482000
* CC = 0, 01483000
* R1 = UNCHANGED 01484000
* R2 = THE CONVERTED VALUE 01485000
* 01486000
* CC ¬= 0, ERROR 01487000
* R1 = UNCHANGED 01488000
* 01489000
* REGISTER USAGE: R1,R2,R7,R8,R9 01490000
* REGISTER TRANSPARENCY: R1,R3-R6,R9-R15 01491000
* 01492000
*-------------------------------------------------------------- 01493000
BCDTOBIN LR R8,R1 SAVE STARTING ADDRESS @V60C1BD 01494000
LR R7,R2 SAVE LENGTH @V60C1BD 01495000
BCDBINLP TM 0(R1),X'F0' IS BYTE NUMERIC? @V60C1BD 01496000
BNO BCDBINER BR IF NOT, ERROR @V60C1BD 01497000
LA R1,1(,R1) POINT TO THE NEXT BYTE @V60C1BD 01498000
BCT R2,BCDBINLP DO IT TO ALL INPUT @V60C1BD 01499000
LR R1,R8 RESTORE STARTING ADDRESS @V60C1BD 01500000
LR R2,R7 RESTORE ORIGINAL LENGTH @V60C1BD 01501000
BCTR R2,0 DECREMENT LENGTH @V60C1BD 01502000
EX R2,BCDPACK PACK DATA INTO WORK AREA @V60C1BD 01503000
CVB R2,UWORK SET UP DATA IN R2 @V60C1BD 01504000
CR R9,R9 SET CC = 0 @V60C1BD 01505000
BR R9 RETURN WITH CC = 0 @V60C1BD 01506000
SPACE 1 01507000
BCDBINER CR R9,R1 FORCE NON ZERO CC @V60C1BD 01508000
BR R9 RETURN WITH CC ¬= 0 @V60C1BD 01509000
SPACE 1 01510000
* EXECUTED INSTRUCTION 01511000
BCDPACK PACK UWORK,0(*-*,R1) @V60C1BD 01512000
EJECT 01513000
*-------------------------------------------------------------- 01514000
* TABLE OF UPDATE-IN-PLACE OPERATIONS 01515000
*-------------------------------------------------------------- 01516000
OPTABLE DS 0F @V60C1BD 01517000
DC CL8'LOGPASS',AL2(LOGPASS-DMKUDU) @V60C1BD 01518000
DC CL8'MDISK',AL2(MDISK-DMKUDU) @V60C1BD 01519000
KSTORAGE DC CL8'STORAGE',AL2(STORAGE-DMKUDU) @V60C1BD 01520000
DC CL8'EDITCHAR',AL2(EDITCHAR-DMKUDU) @V60C1BD 01521000
DC CL8'OPTIONS',AL2(OPTIONS-DMKUDU) @V60C1BD 01522000
DC CL8'IPL',AL2(IPL-DMKUDU) @V60C1BD 01523000
DC CL8'DISTRIB',AL2(DISTRIB-DMKUDU) @V60C1BD 01524000
DC CL8'MAXSTOR',AL2(STORAGE-DMKUDU) @V60C1BD 01525000
DC CL8'PRIVLEGE',AL2(PRIVLEGE-DMKUDU) @V60C1BD 01526000
DC CL8'PRIORITY',AL2(PRIORTY-DMKUDU) @V60C1BD 01527000
KACCOUNT DC CL8'ACCOUNT',AL2(ACCOUNT-DMKUDU) NORMAL ACCT @V60C1BD 01528000
KIACCT DC CL8'IACCOUNT',AL2(ACCOUNT-DMKUDU) IMMED ACCT @V60C1BD 01529000
KTACCT DC CL8'TACCOUNT',AL2(ACCOUNT-DMKUDU) TEMP ACCT @V60C1BD 01530000
DC 8X'FF' FENCE AT END OF TABLE @V60C1BD 01531000
SPACE 2 01532000
*-------------------------------------------------------------- 01533000
* TABLE OF VALID OPTIONS FOR OPTION OPERATION 01534000
* 01535000
* THE NAME OF THE OPTION IS FOLLOWED BY ON BYTE INDICATING 01536000
* IF THE OPTION IS FOLLOWED BY A VALUE (X'00'=NO VALUE, 01537000
* X'FF'=VALUE) AND A SECOND 2-BYTE VALUE AS DEFINED IN 01538000
* 'UMACOPT' AND 'UMACOPT2'. 01539000
* 01540000
*-------------------------------------------------------------- 01541000
OPTIONTB DS 0F @V60C1BD 01542000
DC CL9'ISAM',X'00',AL2(VISAM) ISAM @V60C1BD 01543000
OPTIONEL EQU (*-OPTIONTB) ELEMENT LENGTH @V60C1BD 01544000
DC CL9'ECMODE',X'00',AL2(VECMODE) ECMODE @V60C1BD 01545000
DC CL9'REALTIMER',X'00',AL2(VREALTM) REALTIMER @V60C1BD 01546000
DC CL9'VIRT=REAL',X'00',AL2(VIRTREAL) VIRT=REAL @V60C1BD 01547000
DC CL9'ACCT',X'00',AL2(VACCT) ACCT @V60C1BD 01548000
DC CL9'SVCOFF',X'00',AL2(VSVCOFF) SVCOFF @V60C1BD 01549000
DC CL9'BMX',X'00',AL2(VBMX) BMX @V60C1BD 01550000
DC CL9'CPUID',X'FF',AL2(VCPUID) CPUID @V60C1BD 01551000
DC CL9'AFFINITY',X'FF',AL2(VAFFIN) AFFINITY @V60C1BD 01552000
MAXOPTNS EQU (*-OPTIONTB)/OPTIONEL MAX. NO. OF OPTIONS @V60C1BD 01553000
DC 9X'FF',X'FF',X'FFFF' FENCE AT END OF TABLE @V60C1BD 01554000
SPACE 1 01555000
* THE FOLLOWING VALUES ARE THOSE DEFINED IN UMACBLOK FOR 01556000
* 'UMACOPT' AND 'UMACOPT2', TWO CONTIGUOUS BYTES, THAT 01557000
* CONTAIN CODED DATA DEFINING THE VIRTUAL MACHINE OPTIONS. 01558000
VISAM EQU X'8000' ISAM VALUE @V60C1BD 01559000
VECMODE EQU X'4000' ECMODE VALUE @V60C1BD 01560000
VREALTM EQU X'2000' REALTIMER @V60C1BD 01561000
VIRTREAL EQU X'1000' VIRT= REAL VALUE @V60C1BD 01562000
VACCT EQU X'0800' ACCT VALUE @V60C1BD 01563000
VSVCOFF EQU X'0200' SVCOFF VALUE @V60C1BD 01564000
VBMX EQU X'0100' BMX VALUE @V60C1BD 01565000
VCPUID EQU X'0080' CPUID VALUE @V60C1BD 01566000
VAFFIN EQU X'0000' AFFINITY VALUE (NONE) @V60C1BD 01567000
SPACE 1 01568000
LVCPUID EQU 6 MAX. LENGTH OF CPUID VALUE @V60C1BD 01569000
LVAFFIN EQU 2 MAX. LENGTH OF AFFINITY VALUE @V60C1BD 01570000
SPACE 1 01571000
OPTNMAXV EQU VISAM+VECMODE+VREALTM+VIRTREAL+VACCT+VSVCOFF+VBMX+VCPUIDX01572000
+VAFFIN @V60C1BD 01573000
SPACE 2 01574000
*-------------------------------------------------------------- 01575000
* TABLE OF VALID LINK MODES FOR MDISK OPERATIONS 01576000
*-------------------------------------------------------------- 01577000
LINKMDTB DS 0F @V60C1BD 01578000
DC CL3'R ',AL1(UDEVR) @VMI0024 01579000
LINKMDEL EQU (*-LINKMDTB) ELEMENT LENGTH @VMI0024 01580000
DC CL3'RR ',AL1(UDEVRR) @VMI0024 01581000
DC CL3'W ',AL1(UDEVW) @VMI0024 01582000
DC CL3'WR ',AL1(UDEVWR) @VMI0024 01583000
DC CL3'M ',AL1(UDEVM) @VMI0024 01584000
DC CL3'MR ',AL1(UDEVMR) @VMI0024 01585000
DC CL3'MW ',AL1(UDEVMW) @VMI0024 01586000
VRRSEP EQU * VIRTUAL RESERVE/RELEASE SEPARATE @VMI0024 01587000
DC CL3'RV ',AL1(UDEVR) @VMI0024 01588000
DC CL3'RRV',AL1(UDEVRR) @VMI0024 01589000
DC CL3'WV ',AL1(UDEVW) @VMI0024 01590000
DC CL3'WRV',AL1(UDEVWR) @VMI0024 01591000
DC CL3'MV ',AL1(UDEVM) @VMI0024 01592000
DC CL3'MRV',AL1(UDEVMR) @VMI0024 01593000
DC CL3'MWV',AL1(UDEVMW) @VMI0024 01594000
MAXLNKMD EQU (*-LINKMDTB)/LINKMDEL NO. OF VALID LINK MODES @V60C1BD 01595000
EJECT 01596000
*-------------------------------------------------------------- 01597000
* EXECUTED INSTRUCTIONS 01598000
*-------------------------------------------------------------- 01599000
SPACE 1 01600000
PACKINST PACK UWORK+3(5),0(0,R8) @V60C1BD 01601000
SPACE 5 01602000
* ------------------------------------------------------------- 01603000
* CONSTANTS AND MISCELLANY... 01604000
* ------------------------------------------------------------- 01605000
DS 0F @V60C1BD 01606000
MASK DC 24X'AA' @V60C1BD 01607000
MBLANKS DC 8X'EA' MASKED BLANKS FOR TEST MODE CHECK@VMI0009 01608000
SPACE 2 01609000
*-------------------------------------------------------------- 01610000
* TRANSLATE AND TEST TABLE FOR PRIVILEGE OPERATION 01611000
* VALID PRIVILEGE CLASSES ARE A THROUGH H 01612000
* 01613000
* USE X'FF' AS FUNCTION FOR BLANK TO SIGNAL END OF FIELD 01614000
* AND X'BD' TO SIGNAL AN ERROR INPUT VALUE 01615000
*-------------------------------------------------------------- 01616000
TRPRVTBL DS 0D @V60C1BD 01617000
SPACE 1 01618000
DC (X'40'-X'00')X'BD' INVALID VALUES @V60C1BD 01619000
SPACE 1 01620000
DC X'FF' VALUE FOR X'40' (TO SIGNAL END OF FIELD) @V60C1BD 01621000
SPACE 1 01622000
DC (X'C1'-X'41')X'BD' INVALID VALUES @V60C1BD 01623000
SPACE 1 01624000
* CLASS= A B C D E F G H 01625000
DC X'80',X'40',X'20',X'10',X'08',X'04',X'02',X'01' @V60C1BD 01626000
SPACE 1 01627000
DC (X'100'-X'C9')X'BD' INVALID VALUES @V60C1BD 01628000
EJECT 01629000
*-------------------------------------------------------------- 01630000
* ERROR CODE EQUATES 01631000
*-------------------------------------------------------------- 01632000
ERRWRIT1 EQU 10 ERROR IN DMKRPAPT WRITING OBJECT DASD @V60C1BD 01633000
ERRWRIT2 EQU 11 ERROR IN DMKRPAPT WRITING PAGING DASD @V60C1BD 01634000
SPACE 1 01635000
ERREAD EQU 20 ERROR DURING 'TRANS' OF UDIR PAGE @V60C1BD 01636000
ERRMAC1 EQU 21 NO UMAC ADDRESS IN UCNTRL @V60C1BD 01637000
ERRMAC2 EQU 22 ERROR DURING 'TRANS' OF UMAC PAGE @V60C1BD 01638000
ERRDEV1 EQU 24 NO UDEV ADDRESS IN UCNTRL @V60C1BD 01639000
ERRDEV2 EQU 25 ERROR DURING 'TRANS' OF UDEV PAGE @V60C1BD 01640000
ERRDEV3 EQU 26 UDEV BLOCK NOT FOUND @V60C1BD 01641000
ERRSYNC EQU 27 OBJ. DASD NOT IN SYNCH. WITH DMKSYSPL @V60C1BD 01642000
ERROP EQU 28 OPERATION INVALID @V60C1BD 01643000
SPACE 1 01644000
ERRUID EQU 30 USERID NOT FOUND @V60C1BD 01645000
ERRMATCH EQU 31 LOGON PASSWORD MISMATCH @V60C1BD 01646000
SPACE 1 01647000
ERRSTOR1 EQU 40 STORAGE EXCEEDS MAXIMUM @V60C1BD 01648000
ERRSTOR2 EQU 41 MAX. STORAGE > 16M @V60C1BD 01649000
ERRSTOR3 EQU 42 NO SIGN AFTER PACKING NEW SIZE @V60C1BD 01650000
ERRSTOR4 EQU 43 BAD BYTES IN STORAGE DATA @V60C1BD 01651000
SPACE 1 01652000
ERRPRIV1 EQU 50 PRIVILEGE OPERAND ALL BLANKS @V60C1BD 01653000
ERRPRIV2 EQU 51 NO VALID PRIVILEGE CLASSES IN OPERAND @V60C1BD 01654000
ERRPRIV3 EQU 52 ERROR IN ACCUMULATED PRIVILEGE VALUE @V60C1BD 01655000
ERRPRIV4 EQU 53 INVAILD DATA IN PRIVILEGE FIELD @V60C1BD 01656000
SPACE 1 01657000
ERRPRI1 EQU 60 BAD BYTE IN PRIORITY FIELD @V60C1BD 01658000
ERRPRI2 EQU 61 PRIORITY FIELD ALL BLANKS @V60C1BD 01659000
ERRPRI3 EQU 62 NO SIGN AFTER PACKING NEW PRIORITY @V60C1BD 01660000
ERRPRI4 EQU 63 PRIORITY > 99 @V60C1BD 01661000
SPACE 1 01662000
ERROPTN1 EQU 70 INVALID OPTION @V60C1BD 01663000
ERROPTN2 EQU 71 NO FENCE AT END OF PLIST @V60C1BD 01664000
ERROPTN3 EQU 72 INVALID ACCUM. OPTION VALUE @V60C1BD 01665000
SPACE 1 01666000
ERRMDSK1 EQU 80 INVALID MDISK ADDRESS IN PLIST @V60C1BD 01667000
ERRMDSK2 EQU 81 INVALID LINK MODE @V60C1BD 01668000
ERRMDSK3 EQU 82 LINK PASSWORDS GIVEN AND SHORT UDEV. @V60C1BD 01669000
ERRMDSK4 EQU 83 BLANK LINK PASSWORDS WITH LONG UDEV. @V60C1BD 01670000
SPACE 1 01671000
ERRPGZ EQU 90 FIRST 8 BYTES OF UPDATED PAGE ARE 0 @V60C1BD 01672000
EJECT 01673000
*-------------------------------------------------------------- 01674000
* DSECTS 01675000
*-------------------------------------------------------------- 01676000
SPACE 1 01677000
* THE DSECT 'OPRSECT' IS USED TO REFERENCE THE TABLE (OPTABLE) 01678000
* OF VALID UPDATE-IN-PLACE OPERATIONS 01679000
OPRSECT DSECT @V60C1BD 01680000
DS 0F @V60C1BD 01681000
OPERATN DS CL8 @V60C1BD 01682000
OPADDR DS AL2 @V60C1BD 01683000
LOPTABLE EQU *-OPERATN @V60C1BD 01684000
SPACE 3 01685000
*-------------------------------------------------------------- 01686000
* THE DSECT 'OPTNSECT' IS USED TO REFERENCE THE TABLE 01687000
* (OPTIONTB) OF VALID OPTIONS FOR THE OPTION OPERATION 01688000
OPTNSECT DSECT @V60C1BD 01689000
DS 0F @V60C1BD 01690000
OPTNAME DS CL9 OPTION NAME @V60C1BD 01691000
OPTNFLG DS X FLAG INDICATING OPTION ARGS. PRESENT @V60C1BD 01692000
OPTNVALU DS 2X VALUE FOR 'UMACOPT' AND 'UMACOPT2' @V60C1BD 01693000
OPTNLN EQU *-OPTNAME LENGTH OF OPTION TABLE ENTRY @V60C1BD 01694000
SPACE 3 @V60C1BD 01695000
*-------------------------------------------------------------- 01696000
* THE DSECT 'LINKMSECT' IS USED TO REFERENCE THE TABLE 01697000
* (LINKMDTB) OF VALID LINK MODES FOR THE MDISK OPERATION 01698000
LNKMSECT DSECT @V60C1BD 01699000
DS 0F @V60C1BD 01700000
LNKMD DS CL3 LINK MODE (E.G., RR) @VMI0024 01701000
LNKMVALU DS C LINK MODE VALUE IN 'UDEVMODE' @VMI0024 01702000
LNKMDLN EQU *-LNKMD LENGTH OF LINK TABLE ENTRY @V60C1BD 01703000
SPACE 3 @V60C1BD 01704000
DMKUDU CSECT @V60C1BD 01705000
EJECT 01706000
*-------------------------------------------------------------- 01707000
* THE FOLLOWING TWO COPY STATEMENTS MUST BE LOGICALLY AND 01708000
* PHYSICALLY CONTIGUOUS 01709000
*-------------------------------------------------------------- 01710000
SPACE 1 01711000
COPY UCNTRL @V60C1BD 01712000
SPACE 1 01713000
COPY UIPARMS @V60C1BD 01714000
SPACE 1 01715000
*-------------------------------------------------------------- 01716000
* KEEP THE ABOVE TWO COPY STATEMENTS LOGICALLY AND 01717000
* PHYSICALLY CONTIGUOUS 01718000
*-------------------------------------------------------------- 01719000
EJECT 01720000
COPY CORE @V60C1BD 01721000
COPY EQU @V60C1BD 01722000
COPY SAVE @V60C1BD 01723000
COPY VMBLOK @V60C1BD 01724000
COPY UDIRECT @V60C1BD 01725000
SYSLOCS @V60C1BD 01726000
PSA @V60C1BD 01727000
COPY ALLOC @V60C1BD 01728000
COPY IOBLOKS @V60C1BD 01729000
COPY CONBUF @V60C1BD 01730000
EJECT 01731000
DMKUDU CSECT @V60C1BD 01732000
SPACE 5 01733000
END DMKUDU @V60C1BD 01734000