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