TITLE 'ICATS ACCESS-A-UTS-USER''S-DISK ROUTINE' ACC00010
*********************************************************************** ACC00020
* * ACC00030
* MODULE NAME = ACCESS * ACC00040
* * ACC00050
* FUNCTION = THIS MODULE IS CALLED BY VARIOUS ICATS MODULES * ACC00060
* (LIKE READ, WRITE, CAT) TO ESTABLISH THE BASE * ACC00070
* REGISTERS FOR THE USER AND DISK CONTROL BLOCKS * ACC00080
* AND TO ACTUALLY DO THE CMS ACCESS COMMAND FOR * ACC00090
* THIS MINIDISK. IF THIS DISK IS C'*', THEN THE * ACC00100
* FIRST DISK IN THE DISKCB CHAIN IS ACCESSED. * ACC00110
* * ACC00120
* ENTRY POINTS = ACCESS * ACC00130
* * ACC00140
* LINKAGE = BALR R14,R15 FROM ANYWHERE IN ICATS PROGRAM. * ACC00150
* THE ADDRESS OF THIS ROUTINE IS KEPT IN AN ADDRESS * ACC00160
* CONSTANT IN THE ICATS COMMON DATA AREA (ICDATA). * ACC00170
* FOR EXAMPLE, * ACC00180
* L R15,AACCESS * ACC00190
* BALR R14,R15 * ACC00200
* * ACC00210
* REGISTER CONTENTS UPON ENTRY = * ACC00220
* R2 = POINTS TO THE ICATS COMMON DATA AREA AS ALWAYS. * ACC00230
* R4 = POINTS TO THE CORRECT UTS CONTROL BLOCK. * ACC00240
* R14 = RETURN ADDRESS BACK TO CALLER. * ACC00250
* R15 = ADDRESS OF THIS SUBROUTINE (USED FOR BASE REG). * ACC00260
* * ACC00270
* ALSO, THESE AREAS ARE SET UP IN THE ICATS COMMON DATA AREA * ACC00280
* THISUTS = F = ADDRESS OF THIS UTS'S CONTROL BLOCK * ACC00290
* THISUSER = CL8 = UTS USER ID * ACC00300
* THISDISK = CL1 = USER'S ACCESS MODE * ACC00310
* * ACC00320
* REGISTER CONTENTS UPON EXIT = * ACC00330
* R4 = ADDRESS OF THIS UTS CONTROL BLOCK. * ACC00340
* R5 = ADDRESS OF THIS USER CONTROL BLOCK. * ACC00350
* R6 = ADDRESS OF THIS DISK CONTROL BLOCK. * ACC00360
* R15 = 0 = EVERYTHING WENT OK. * ACC00370
* OR R15 = 8 = THIS UTS USER ID WAS NOT FOUND. * ACC00380
* OR R15 = 12 = THIS DISK WAS NOT FOUND FOR THIS UTS USER ID. * ACC00390
* OR R15 = 16 = MINIDISK IS BAD OR DOES NOT EXIST. * ACC00400
* OR R15 = 20 = OTHER KIND OF ERROR WITH THE ACCESS COMMAND * ACC00410
* (SHOULD NEVER HAPPEN). * ACC00420
* * ACC00430
* REGISTER USAGE: * ACC00440
* R0-R1 = FREE * ACC00450
* R2 = ICATS COMMON DATA AREA BASE REGISTER AS ALWAYS. * ACC00460
* R3 = FREE * ACC00470
* R4 = UTS CONTROL BLOCK BASE REGISTER. * ACC00480
* R5 = USER CONTROL BLOCK BASE REGISTER. * ACC00490
* R6 = DISK CONTROL BLOCK BASE REGISTER. * ACC00500
* R7-R13 = FREE * ACC00510
* R14 = RETURN ADDRESS FOR WHEN I CALL SUBROUTINES * ACC00520
* R15 = SUBROUTINE ADDRESS * ACC00530
* * ACC00540
* MODULE LOGIC = * ACC00550
* I) FIND THE CORRECT USER CONTROL BLOCK PER THISUSER. * ACC00560
* II) FIND THE CORRECT DISK CONTROL BLOCK PER THISDISK. * ACC00570
* III) DO THE CMS ACCESS COMMAND (I.E ACCESS 199 B). * ACC00580
* * ACC00590
* NORMAL EXIT = * ACC00600
* R15 = 0 * ACC00610
* * ACC00620
* EXTERNAL REFERENCES = NONE * ACC00630
* * ACC00640
* CONTROL BLOCKS = ICDATA (ICATS COMMON DATA AREA) * ACC00650
* * ACC00660
* NON-STANDARD MACROS (FOUND IN ICATS MACLIB) * ACC00670
* ICDATA = ICATS COMMON DATA AREA DSECT. * ACC00680
* * ACC00690
* CHANGE ACTIVITY * ACC00700
* DATE NAME REASON FOR CHANGE * ACC00710
* 04/18/83 RICK JASPER BROKEN AWAY FROM ICATS MAINLINE INTO * ACC00720
* SEPARATE SUBROUTINE * ACC00730
* 04/22/83 RICK JASPER DOESN'T LOOK FOR UTSCB ANYMORE. IT'S * ACC00740
* ALREADY FOUND BY THE DISPATCH ROUTINE. * ACC00750
* * ACC00760
*********************************************************************** ACC00770
EJECT ACC00780
PRINT GEN,NODATA ACC00790
ACCESS CSECT ACC00800
USING ICDATA,R2 ADDRESS ICATS COMMON DATA AREA ACC00810
USING CBUTS,R4 USE R4 TO ADDRESS UTS CONTROL BLOCK ACC00820
USING CBUSER,R5 USE R5 TO ADDRESS USER CONTROL BLOCK ACC00830
USING CBDISK,R6 USE R6 TO ADDRESS DISK CONTROL BLOCK ACC00840
USING ACCESS,R15 USE R15 FOR NEXT INSTRUCTION ONLY ACC00850
STM R0,R3,ACCREGSA SAVE ALL CALLERS' REGISTERS EXCEPT ACC00860
STM R7,R14,ACCREGSB R4-R6 AND R15 ACC00870
DROP R15 ACC00880
USING ACCESS,R11 USE R11 FOR THIS ROUTINE'S BASE REG ACC00890
LR R11,R15 SWITCH BASE REGISTER TO R11 ACC00900
L R4,THISUTS GET ADDRESS OF THIS UTS'S UTSCB ACC00910
L R5,CBUTSUP GET ADDRESS OF FIRST USERCB ACC00920
ACCLOOPB LTR R5,R5 END-OF-CHAIN ?? USER NOT FOUND ACC00930
BZ ACCERRB SORRY, CAN'T FIND THIS USERCB ACC00940
CLC CBUSRUID,THISUSER IS THIS THE RIGHT USERCB ?? ACC00950
BE ACCCONTB YEP, CONTINUE ON ACC00960
L R5,CBUSRFP NOPE, CHECK OUT THE NEXT ONE ACC00970
B ACCLOOPB ACC00980
ACCCONTB DS 0H ACC00990
L R6,CBUSRDP GET ADDRESS OF FIRST DISKCB ACC01000
ACCLOOPC LTR R6,R6 END-OF-CHAIN ?? DISK NOT FOUND ACC01010
BZ ACCERRC SORRY, CAN'T FIND THIS DISKCB ACC01020
CLC CBDSKMOD,THISDISK IS THIS THE RIGHT DISKCB ?? ACC01030
BE ACCCONTC YEP, CONTINUE ON ACC01040
L R6,CBDSKFP NOPE, GO CHECK OUT THE NEXT ONE ACC01050
B ACCLOOPC ACC01060
ACCCONTC DS 0H ACC01070
* WE'VE GOT R4-R6 POINTING TO THE CORRECT CONTROL BLOCKS ACC01080
* NOW ACCESS THIS DISK. ACC01090
MVC ACCDISK(3),CBDSKDAD ACC01100
MVC ACCMODE(1),CBDSKMOD ACC01110
L R1,AACCCMD ACC01120
SVC 202 GO DO THE ACCESS COMMAND ACC01130
DC AL4(*+4) ACC01140
LTR R15,R15 DID EVERYTHING GO OK ?? ACC01150
BNZ ACCERRD NOPE, GO FIGURE OUT WHAT WENT WRONG ACC01160
LA R15,0 RETURN CODE = 0 = EVERYTHING'S GREAT ACC01170
ACCESBYE DS 0H ACC01180
LM R0,R3,ACCREGSA RESTORE ALL CALLER'S REGISTERS ACC01190
LM R7,R14,ACCREGSB EXCEPT R4-R6 AND R15 ACC01200
BR R14 BYE ACC01210
* ACC01220
ACCERRB LA R15,8 RC = 8 = CAN'T FIND THIS USERCB ACC01230
B ACCESBYE ACC01240
* ACC01250
ACCERRC LA R15,12 RC = 12 = CAN'T FIND THIS DISKCB ACC01260
B ACCESBYE ACC01270
* SOMETHING WENT WRONG WITH THE ACCESS ACC01280
* COMMAND. FIGURE OUT WHAT IT IS. ACC01290
ACCERRD C R15,=F'100' WAS IT A DISK ERROR ?? ACC01300
BNE ACCCONTD ACC01310
LA R15,16 RC = 16 = DISK NOT THERE OR BAD ACC01320
B ACCESBYE ACC01330
ACCCONTD LA R15,20 RC = 20 = OTHER TYPE OF ERROR ACC01340
B ACCESBYE SHOULD NEVER HAPPEN ACC01350
* ACC01360
ACCREGSA DS 4F ACC01370
ACCREGSB DS 8F ACC01380
ACCCMD DS 0D MUST BE DOUBLEWORD ALIGNED ACC01390
DC CL8'ACCESS' ACC01400
ACCDISK DC CL8' ' ACC01410
ACCMODE DC CL8' ' ACC01420
DC 8X'FF' ACC01430
AACCCMD DC X'00',AL3(ACCCMD) ACC01440
LTORG ACC01450
ICDATA ACC01460
END ACC01470