         SYSTEM SIG9P                                                           
         SYSTEM   OPTIONS                                                       
         DEF      A:OPENX                                                       
         DEF      OPEN1A,OPEN1B                                                 
         PSYS     0                                                             
OLAYFLAG EQU      'OPEN'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** OPENX - OPENDCB **'                                       
*************                                                                   
*   OPENX   *                                                                   
*************                                                                   
*                                                                               
*   ROUTINE OPENS A DCB                                                         
*                                                                               
*   AT ENTRY      R1    FPT CODE                                                
*                 R2    DCB ADDRESS                                             
*                 R3    FPT ADDRESS                                             
*                 R4    LINK                                                    
*                 R8    DCB WORD 0                                              
*                                                                               
OPENX    RES      0                                                             
A:OPENX  EQU      OPENX                                                         
         LW,R5    R8                SAVE DCB WORD 0 IN R5                       
         LW,R9    R2                                                            
         LB,R10   *R2               GET DCB LENGTH                              
         AW,R10   R9                                                            
         AI,R10   -1                DCB LAST WORD ADDRESS                       
         LI,R11   0                 REQUIRE WRITEABLE ACCESS                    
         BAL,R8   TMCKADP           CHECK DCB RANGE                             
         B        OPENE8B           ERROR, DCB NOT WRITEABLE                    
         LW,R8    R5                R8= DCB WORD 0 AT ENTRY                     
         CI,R8    K3                TEST ASN                                    
         BAZ      OPEN1B            NULL ASSIGNMENT, CALEXIT                    
*                                                                        0934000
*                                                                        0935000
*  AT 4001, DCB IS NOT OPEN                                              0936000
%4001    RES      0                                        /SIG7-2050/*C5732    
         CI,R8    K2                TEST BIT 30 OF DCB WORD 0                   
         BAZ      OPENRFIL          OFF, B TO OPEN RAD FILE              0938000
         LW,R5    R4                SAVE RETURN                          0939000
         LW,R4    1,R2              DCB WORD 1 TO R4       /SIG7-3646/*C015732  
         LI,R7    X'FF'                                                         
         AND,R7   R4                GET POSSIBLE DCT/OPLBS INDEX                
         CI,R8    X'40'                                                         
         BAZ      %4003             B IF INDEX WAS SPECIFIED                    
*        DEVICE/OPLABEL SPECIFIED BY NAME                                       
         LB,R7    R8                DCB LENGTH                                  
         CI,R4    X'8000'                                                       
         BAZ      %4002B            B IF OPLABEL NAME                           
*        DEVICE SPECIFIED BY NAME                                               
         CI,R7    7                                                             
         BL       OPERR01A          B IF DCB TOO SHORT                          
         LW,R14   5,R2                                                          
         LW,R15   6,R2              GET DEVICE NAME                             
         SLD,R14  -24                                                           
         OR,R14   Y155A5A           MAKE IT DCT16 FORMAT                        
         LH,R7    DCT7              NR OF DCT ENTRIES                           
%4002A   RES      0                 SEARCH FOR DEVICE BY NAME                   
         CD,R14   DCT16,R7                                                      
         BE       %4002D            B IF FOUND                                  
         BDR,R7   %4002A                                                        
         B        OPERR01A          ERROR IF NOT FOUND                          
*****                                                                           
%4002B   RES      0                 OPLABEL SPECIFIED BY NAME                   
         CI,R7    6                                                             
         BL       OPERR01A          B IF DCB TOO SHORT                          
         LI,R7    11                                                            
         LH,R14   *R2,R7            GET OPLABEL NAME                            
         LH,R7    OPLBS1            NR OF OPLBS ENTRIES                         
%4002C   RES      0                 SEARCH FOR OPLABEL BY NAME                  
         CH,R14   OPLBS1,R7                                                     
         BE       %4002D            B IF FOUND                                  
         BDR,R7   %4002C                                                        
         B        OPERR01A          ERROR IF NOT FOUND                          
*****                                                                           
%4002D   RES      0                 ARRANGE TO INSERT INDEX IN DCB              
         AND,R4   YFFFFFF                                                       
         OR,R4    R7                                                            
         B        %4004                                                         
*****                                                                           
%4003    RES      0                 DEV/OPLB INDEX IN R7                        
         LH,R0    DCT7              NR OF DCT ENTRIES                           
         CI,R4    X'8000'                                                       
         BANZ     %+2               B IF DCT INDEX IN R7                        
         LH,R0    OPLBS1            NR OF OPLBS ENTRIES                         
         CW,R7    R0                                                            
         BG       OPERR01A          B IF ILLEGAL INDEX                          
%4004    RES      0                 IF OPLB, GET ITS ASSIGNMENT                 
         CI,R4    X'8000'                                                       
         BANZ     %4004B            B IF R7 IS A DCT INDEX                      
         LB,R6    TCBPOINT          GET TASK ID                                 
         LB,R6    STIJID,R6         GET JOB ID                                  
         LW,R6    SJI1,R6           GET JCB ADDRESS                             
         LW,R6    JCBOPL2,R6        GET JOB OPLB2 TABLE ORIGIN                  
         LB,R7    *R6,R7            GET JOB OPLABEL ASSIGNMENT                  
%4004B   RES      0                                                             
         CI,R7    X'80'             IS IT A RAD FILE                            
         BANZ     %4006             YES, BRANCH                                 
         LB,R6    DCT4,R7           DEVICE TYPE                                 
         LB,R9    T:LDEV,R6         IS IT A TY OR LP DEVICE                     
         BEZ      %4005             NO,BRANCH                                   
         OR,R4    X4000             YES, SET L INDICATOR IN DCB                 
         B        %4006                                                         
%4005    RES      0                                                             
         CI,R4    K8000             TEST DEVF              /SIG7-3646/*C015732  
         BANZ     %4006                                    /SIG7-3646/*C015732  
         CI,R6    K9                IS IT 7 TRACK MAG TAPE                      
         BNE      %4006             NO, BRANCH                           0952000
         OR,R8    X20200                                                        
*                                                                        0954000
*                                                                        0955000
*                                                                        0956000
%4006    RES      0                                                             
         ENABLE                                                                 
         LW,R14   R4                R14= DCB WORD 1                             
         CI,R7    X'80'                                                         
         BAZ      %4007             B IF NOT FILE (VIA OPLABEL)                 
%4006B   RES      0                                                             
         LW,R15   RENT:D                                                        
         PUSH     R5                                                            
*                                   ** E00 SIDR **                              
         AND,R7   M7                R7 = RFT INDEX                              
*                                   ** E00 SIDR END **                          
         BAL,R5   OPENCKM           CHECK BB SHARABILITY                        
         B        %4020             NOT SHARABLE                                
         PULL     R5                                                            
         DISABLE                                                                
         CW,R15   RENT:D                                                        
         BNE      %4006B            B IF RFT REENTRANCE OCCURRED                
         LW,R9    FFFDFDFF                                                      
         CS,R8    0,R2                                                          
         BNE      OPENE2E           B IF DCB CHANGED                            
         B        %4008G                                                        
*                                                                               
%4007    RES      0                                                             
         DO       #SYMB                                                         
         BIFFGD   %4006A            BRANCH IF FGD                               
         LB,R15   DCTSYM1,R7        GET SYMBIONT FLAGS                          
         CI,R15   DCTSYMSM          IS THIS A SYMBIONT DEDICATED DEVICE         
         BANZ     %4008G            YES, BRANCH                                 
%4006A   RES      0                                                             
         FIN      #SYMB                                                         
         LB,R15   DCTJID,R7         JOB ID                                      
         BEZ      %4008B            B IF SHARABLE DEVICE                        
         CI,R15   X'FF'             EXCLUSIVE, IS IT IN USE                     
         BE       %4008A            NO, ENQUEUE IT                              
         LB,R6    TCBPOINT          TASK ID                                     
         LB,R6    STIJID,R6         JOB ID OF USER DOING OPEN                   
         CW,R6    R15               USER IN SAME JOB                            
         BE       %4008B            YES, OK TO OPEN                             
         ENABLE                                                                 
         LI,R9    TYC83             NO, ERROR                                   
         B        OPEN2A                                                        
*                                                                               
%4008A   RES      0                                                             
         DO       #ECB                                                          
         ENABLE                                                                 
         PUSH     9,R1                                                          
         LB,R4    TCBPOINT          TASK ID                                     
         LW,R9    YF                FLAGS FOR TMENQ SUBROUTINE                  
         LW,R10   R7                ITEM TO ENQ (DCTX)                          
         LI,R11   0                                                             
         BAL,R8   TMENQ             ENQUEUE THE DEVICE                          
         B        %4008C            ERROR RETURN                                
         PULL     9,R1                                                          
%4008D   RES      0                                                             
         ELSE     #ECB                                                          
         LB,R6    TCBPOINT          TASK ID                                     
         LB,R6    STIJID,R6         R6= JOB ID                                  
         STB,R6   DCTJID,R6         STORE JOB ID IN DCT                         
         FIN      #ECB                                                          
%4008B   RES      0                                                             
         LW,R9    FFFDFDFF                                                      
         DISABLE                                                                
         CS,R8    0,R2                                                          
         BNE      OPENE2E           B IF DCB WORD 0 CHANGED                     
         MTB,1    DCTDCB,R7         INCREMENT OPEN DCBS FOR DEVICE              
*                                                                               
%4008G   RES      0                                                             
         OR,R8    Y002              SET OPEN BIT                                
         STW,R8   0,R2              STORE DCB WORD 0                            
         STW,R14  1,R2              STORE DCB WORD 1                            
         ENABLE                                                                 
         B        OPEN2B            RETURN OK                                   
*                                                                               
         PAGE                                                                   
*                                                                               
*                                                                               
*        ERROR AND EXIT ROUTINES                                                
*                                                                               
*                                                                               
*                                                                               
         DO       #ECB                                                          
%4008C   RES      0                                                             
         PULL     9,R1                                                          
         CI,R15   TYC83             ERROR= UNABLE TO ENQ                        
         BNE      %4008E            NO, BRANCH                                  
         LB,R6    TCBPOINT          TASK ID                                     
         LB,R6    STIJID,R6         JOB ID                                      
         CB,R6    DCTJID,R7         IS OPEN IN SAME JOB                         
         BE       %4008D            YES, BRANCH                                 
*                                                                               
%4008E   RES      0                                                             
         LW,R9    R15               MOVE TYC TO R9                              
         B        OPEN2A            ERROR EXIT                                  
*                                                                               
         FIN      #ECB                                                          
*                                                                        0979000
OPENE2E  RES      0                 DCB WORD 0 CHANGED (REENTRANCE)             
         LW,R8    0,R2              R8= DCB WORD 0                              
         ENABLE                                                                 
         CW,R8    Y002              IS DCB CLOSED                               
         BAZ      %4001             YES, RESTART OPEN                           
         LI,R9    K2E               DCB OPEN NOW, RET ERROR                     
         B        OPEN2A                                                        
*                                                                               
OPENE8B  RES      0                                                             
         LI,R9    X'8B'             ERROR, BAD DCB ADDRESS                      
         B        OPEN1A                                                        
*                                                                               
*                                                                               
OPERR01A RES      0                                                             
         LI,R9    1                 TYC:  BAD DCB PARAMETERS                    
         B        OPEN2A                                                        
*                                                                               
%4020    RES      0                                                             
         PULL     R5                                                            
*                                                                               
OPEN2A   RES      0                                                             
         LW,R4    R5                R4 = LINK                                   
OPEN1A   B        0,R4      ERROR: RETURN TO LINK+0;   TYC CODE IN R9           
*                                                                               
*                                                                               
OPEN2B   RES      0                                                             
         LW,R4    R5                R4 = LINK                                   
OPEN1B   B        1,R4      NORMAL, OR NO ERROR, EXIT: RETURN TO LINK+1         
*                                                                               
         PAGE                                                            0988000
****************                                                         0989000
*   OPENRFIL   *                                                         0990000
****************                                                         0991000
*                                                                        0992000
*                                                                        0993000
*  ROUTINE OPENS A DCB ASSIGNED TO A RAD FILE                            0994000
*  AN RFT ENTRY IS BUILT FOR THE RAD FILE IF ONE DOES NOT EXIST          0995000
*  IF AN RFT ENTRY EXISTS, A CHECK IS MADE ON THE FILE MODE AND NO OF    0996000
*     USERS TO DETERMINE IF IT MAY BE SHARED.  THE FUNCTION IN THE       0997000
*     RFT AND THE CURRENT DCB MUST BE OUT ONLY                           0998000
*  IF AN RFT ENTRY IS TO BE BUILT, IT IS BUILT IN DYNAMIC STORAGE AND    0999000
*     BEFORE IT IS ENTERRED IN THE RFT, A TEST IS PERFORMED TO INSURE    1000000
*     THAT THE RFT HAS NOT CHANGED (THROUGH RE-ENTRANCE) SINCE ENTRY     1001000
*     TO THE ROUTINE                                                     1002000
*                                                                        1003000
*                                                                        1004000
*  AT ENTRY:    R3 FPT ADDRESS                                           1005000
*               R1   FPT CODE                                            1006000
*               R2   DCB ADDRESS                                         1007000
*               R4   LINK TO OPENDCB CALLER                              1008000
*                                                                        1009000
OPENRFIL RES      0         OPEN A DISC FILE                                    
         PUSH     2,R3              SAVE LINK, NEEDED REGISTERS                 
ORFIL1   RES      0                                                             
         LB,R4    *R2               DCB LENGTH                                  
         LB,R6    TCBPOINT          TASK ID                                     
         LB,R6    STIJID,R6         JOB ID                                      
         LW,R6    SJI1,R6                                                       
         LW,R10   JCBACCNT,R6       USER ACCOUNT NAME AS DEFAULT                
         LW,R11   JCBACCNT+1,R6                                                 
         LD,R12   BLANKS            DEFAULT FILE NAME                           
         LI,R6    -1                SET DEFAULT AREA = PUBLIC                   
*                                                                               
*        GET FILE NAME IN R12, R13                                              
*                                                                               
         CI,R4    5                                                             
         BLE      ORFIL2            B IF NO FILE NAME SPECIFIED                 
         LW,R12   5,R2              GET NAME WORD 0                             
         CI,R4    6                                                             
         BLE      ORFIL2            B IF ONLY ONE WORD SPECIFIED                
         LW,R13   6,R2              GET NAME WORD 1                             
*                                                                               
*        GET AREA INDEX IN R6                                                   
*                                                                               
ORFIL2   RES      0                                                             
         LW,R7    *R2                                                           
         CI,R7    X'80'                                                         
         BANZ     ORFIL3            B IF AREA SPECIFIED BY NAME                 
         LW,R6    1,R2              GET AREA INDEX FROM DCB                     
         SLS,R6   -8                                                            
         AND,R6   X3F                                                           
         LW,R10   SYSACNT           CHANGE DEFAULT ACNT TO SYSTEM               
         LW,R11   SYSACNT+1                                                     
         B        ORFIL5                                                        
*****                                                                           
*                                                                               
*        AREA SPECIFIED BY NAME                                                 
*                                                                               
ORFIL3   RES      0                                                             
         LI,R15   1                                                             
         BAL,R7   ORFGETP           GET NAME FROM OPTIONAL DCB                  
         B        ORFIL5            NOT SPECIFIED.  USE DEFAULT                 
*****                                                                           
         LI,R7    1                                                             
         LH,R7    R15,R7            GET SIGN-EXTENDED AREA NAME                 
         BEZ      ORFIL5            B IF DEFAULT (ZERO NAME)                    
         CH,R7    BLANKS                                                        
         BE       ORFIL5            B IF DEFAULT (BLANK NAME)                   
         LW,R10   SYSACNT           CHANGE DEFAULT ACNT TO SYSTEM               
         LW,R11   SYSACNT+1                                                     
         LI,R6    0                                                             
ORFIL4   RES      0                                                             
         CH,R7    MDNAME,R6                                                     
         BE       ORFIL5            B IF FOUND. INDEX IS IN R6                  
         AI,R6    1                                                             
         CW,R6    K:NUMDA                                                       
         BLE      ORFIL4            B IF MORE AREAS TO COMPARE                  
         LI,R9    TYC70             NO SUCH AREA NAME                           
         B        ORFILERA          GO TO COMMON ERROR EXIT                     
*****                                                                           
*                                                                               
*        GET ACCOUNT NAME IN R10,R11                                            
*                                                                               
ORFIL5   RES      0                                                             
         LI,R15   2                                                             
         BAL,R7   ORFGETP           GET NAME FROM OPTIONAL DCB                  
         B        ORFIL6            B IF NOT SPECIFIED                          
*****                                                                           
         LW,R9    BLANKS            DEFAULT 2ND WORD IS BLANKS                  
         LW,R8    R15               MOVE FIRST WORD                             
         BNEZ     %+2               B IF NONZERO FIRST WORD                     
         LI,R9    0                 DEFAULT 2ND WORD IS ZERO                    
         LI,R15   3                                                             
         BAL,R7   ORFGETP           GET SECOND WORD                             
         B        %+2               NOT SPECIFIED. USE DEFAULT.                 
         LW,R9    R15               MOVE SECOND WORD                            
         CD,R8    ZEROS                                                         
         BE       ORFIL6            USE DEFAULT IF ALL ZERO                     
         CD,R8    BLANKS                                                        
         BE       ORFIL6            USE DEFAULT IF ALL BLANK                    
         LD,R10   R8                USE SPECIFIED NAME OTHERWISE                
*                                                                               
*        FILE ID DETERMINED                                                     
*                                                                               
ORFIL6   RES      0         GET TSPACE TO SAVE FILE'S RFT INFO IN               
         PUSH     2,R10             SAVE REGS USED BY GETTEMP                   
         LI,R7    16                GET ENOUGH FOR ALL THE RFT INFO             
         BAL,R8   GETTEMP                                                       
         B        ORFILERT            NOT ENOUGH ROOM: GIVE ERROR               
         LB,R4    TCBPOINT          LINK THIS SPACE ONTO STISPCE CHAIN          
         LW,R5    STISPCE,R4        SO IT WILL BE RECOVERED IF THE              
         STW,R5   0,R7              CALLING TASK/JOB TERMINATES                 
         STW,R7   STISPCE,R4        ABNORMALLY                                  
         ENABLE                                                                 
         LI,R5    15                ZERO THE TSPACE BLOCK                       
         LI,R10   0                                                             
         STW,R10  *R7,R5                                                        
         BDR,R5   %-1                                                           
*                                                                               
         LW,R5    R7                R5= ADDRESS OF TSPACE                       
         PULL     2,R10             RECOVER ALTERED REGS (ACNT NAME)            
*                                                                               
         CD,R12   ZEROS             IS THE ASSIGNMENT TO ENTIRE AREA ?          
         BNE      %+2                 NO, AN ACTUAL FILE NAME                   
         LD,R12   BLANKS            ENTIRE AREA: USE BLANKS FOR NAME            
*                                                                               
         CW,R6    K:NUMDA           IS THE AREA INDEX VALID ?                   
         BG       ORFER03             NO, ERROR 03: NON-EXIST FILE              
*                                                                               
ORFIL6A  RES      0         INSURE AREA IS ALLOCATED AND DISC AVAILABLE         
         CI,R6    -1                                                            
         BE       ORFIL6B           B IF AREA NOT DETERMINED YET                
         LB,R8    MDFLAG,R6         CHECK THAT THE AREA IS ALLOCATED            
         CI,R8    ALLOC             IS ITS ALLOCATED FLAG SET ?                 
         BAZ      ORFER03             NO: NON-EXIST FILE                        
*                                                                               
        DO       #DISKPAK   CHECK IF THE DISC IS DISMOUNTED                     
         LB,R7    MDDCTI,R6         GET THE DEVICE'S DCT INDEX                  
         LB,R8    DCTRBM,R7         IS DISC BEING DISMOUNTED ?                  
         CI,R8    2                                                             
         BANZ     ORFER2F             YES, DO NOT ALLOW OPEN: ERROR 2F          
        FIN      #DISKPAK                                                       
*                                                                               
ORFIL6B  RES      0                                                             
         LCI      2                 SAVE ACCOUNT NAME AND FILENAME              
         STM,R10  TSNFACT1,R5       IN TSPACE BLOCK                             
         STM,R12  TSNFNAM1,R5                                                   
         LB,R8    STIJID,R4         GET JOB'S ID                                
        DO       #SYMB     CHECK FOR A SYMBIONT FILE...                         
         LH,R14   MDNAME,R6         CHECK FOR A FILE IN 'IS' OR 'OS'            
         AND,R14  M16                                                           
         CI,R14   KIS               FILES IN 'IS' OR 'OS' REQUIRE A             
         BE       ORFIL7            JOB ID OF ZERO, = SYSTEM                    
         CI,R14   KOS                                                           
         BNE      ORFIL8            NOT IN 'IS' OR 'OS': USE JOB'S ID           
ORFIL7   RES      0         SET JOB ID = SYSTEM                                 
         LI,R8    0                                                             
*                                                                               
ORFIL8   RES      0         JOB'S ID FOUND AND IN R8                            
        FIN      #SYMB              END SYMBIONT FILE TEST...                   
         STW,R8   TSOJOBID,R5       SAVE WHICHEVER JOBID IN TSPACE BLOCK        
         PAGE                                                                   
*                                                                               
*   THE TSPACE BLOCK WHEN BUILT WILL HAVE THE FOLLOWING FORM:                   
*                                                                               
*  WORD  LABEL     CONTENTS                                                     
*                                                                               
*   0  TSNFTSPC   TSPACE CONTROL WORD FROM GETTEMP                              
*   1  TSNFNAM1   WORD ONE OF FILENAME                                          
*   2  TSNFNAM2   WORD TWO OF FILENAME                                          
*   3  TSNFLEN    LENGTH OF ENTRY, IN RIGHTMOST BYTE                            
*   3  TSNFFLGS   FLAGS (1 & 2), AND ALSO LENGTH                                
*   4  TSNFGRSZ   RSIZE & GSIZE, EACH IN A HALFWORD                             
*   5  TSNFFSIZ   FSIZE                                                         
*   6  TSNFBOT    BOT                                                           
*   7  TSNFEOT    EOT                                                           
*   8  TSNFXTNT   EXTENT NUMBER                                                 
*   9  TSNFESIZ   EXTENT ALLOCATION SIZE                                        
*  10  TSNFACT1   ACCOUNT NAME, PART 1                                          
*  11  TSNFACT2   ACCOUNT NAME, PART 2                                          
*  12  TS----                                                                   
*  13  TS----                                                                   
*  14  TSOJOBID   JOB ID OF JOB OPENING FILE, RIGHT JUSTIFIED                   
*  15  TSO#BKGO   NUMBER OF BKG FILES OPEN                                      
         PAGE                                                                   
*                                                                               
*   AT THIS POINT THE REGISTERS HAVE:    (OR WILL HAVE:)                        
*                                                                               
*        R0       (TEMP WORK REGISTER)                                          
*        R1       FPT CODE                                                      
*        R2       DCB ADDRESS                                                   
*        R3       FPT ADDRESS                                                   
*        R4       STI INDEX; (ADDR OF FILE DIRE ENTRY IN BB; TEMP)              
*        R5       ADDRESS OF TSPACE BLOCK                                       
*        R6       AREA INDEX OR -1 FOR A PUBLIC FILE                            
*        R7       (INDEX TO RFT ENTRY TO BUILD)                                 
*        R8       (LINKS; TEMPS)                                                
*        R9       (TEMP WORK REGISTER)                                          
*        R10      1ST HALF OF ACCOUNT NAME                                      
*        R11      2ND HALF OF ACCOUNT NAME                                      
*        R12      FILE NAME, WORD 1                                             
*        R13      FILE NAME, WORD 2                                             
*        R14      (NUMBER OF SECTOR CONTAINING DIRECTORY ENTRY)                 
*        R15      (REENTRANCE COUNT FROM  RENT:D)                               
*                                                                               
*                                                                               
*        PROGRAM LOOPS TO HERE TO RETRY ON REENTRANCE CAUSED RETRIES            
*                                                                               
*                                                                               
ORFIL10  RES      0         FIND RFT ENTRY/FIND FILE                            
         LW,R15   RENT:D            GET THE REENTRANCE COUNT                    
         LCI      2                 GET FILENAME, ACCOUNT NAME, AND             
         LM,R12   TSNFNAM1,R5       JOB ID OF FILE TO BE OPENED                 
         LM,R10   TSNFACT1,R5                                                   
         LW,R9    TSOJOBID,R5                                                   
         LH,R7    RFT#              GET # OF RFT ENTRIES                        
*                                                                               
ORFIL11  RES      0         LOOK FOR DUPLICATE ENTRY ALREADY IN TABLES          
         CD,R12   RFT1,R7           DO THE FILE NAMES MATCH ?                   
         BNE      ORFIL12             NO, NOT SAME FILE                         
         CD,R10   RFTACNT,R7        YES, IN THE SAME ACCOUNT ?                  
         BNE      ORFIL12             NO, NOT SAME FILE                         
         CI,R6    -1                                                            
         BNE      ORFIL11B          B IF NOT A PUBLIC FILE SEARCH               
*                                                                               
         LB,R4    RFT8,R7           GET RFT FILE AREA INDEX                     
         LB,R4    MDFLAG,R4         GET AREA FLAGS                              
         CI,R4    X'80'                                                         
         BNE      ORFIL12           B IF NOT A PUBLIC AREA (NO MATCH)           
         B        ORFIL11C                                                      
*                                                                               
ORFIL11B RES      0                                                             
         CB,R6    RFT8,R7                                                       
         BNE      ORFIL12           B IF AREAS DONT MATCH                       
*                                                                               
ORFIL11C RES      0                                                             
*                          SAME FILE:  TEST DIFFERENT USERS                     
         CB,R9    RFT9,R7           IS IT FOR THE SAME JOB ?                    
         BE       ORFIL30             YES, MAKE SPECIAL CHECKS                  
         MTB,+0   RFT9,R7           IS EXISTING FILE A SYSTEM FILE ?            
         BEZ      ORFIL30             YES, DO SPECIAL CHECKS FOR IT TOO         
*                                                                               
ORFIL12  RES      0         ENTRY NOT SAME -- LOOK AT NEXT                      
         BDR,R7   ORFIL11           LOOKED AT ALL?  IF NOT, DO NEXT             
*                                                                               
***      WE NEED TO BUILD A NEW RFT ENTRY                                       
*                                                                               
ORFIL13  RES      0         CHK FOR OPENING NEW BT FILES                        
         CI,R6    BTINDEX           IS IT THE BT AREA ?                         
         BNE      ORFIL13A            NO, ANY FILE NAME OK                      
         CD,R12   BLANKS            YES, IS IT ENTIRE AREA ?                    
         BNE      ORFER03             NO, ERROR: NO NEW FILES IN BT             
*                                                                               
ORFIL13A RES      0         CHECK NUMBER OF BKG FILES OPEN                      
         LB,R9    RFT14             GET NUMBER OF BKG FILES NOW OPEN            
         BIFFGD   ORFIL14           SKIP CHECK IF A FOREGROUND REQUEST          
         CB,R9    RFT13             HAVE WE OPENED TOO MANY BKG FILES ?         
         BGE      ORFER55             YES, GIVE ERROR 55                        
         AI,R9    1                 NO, STEP COUNT                              
*                                                                               
ORFIL14  RES      0         LOOK FOR AN UNUSED ENTRY                            
         STW,R9   TSO#BKGO,R5       SAVE NUMBER OF BKG FILES OPEN               
         LH,R7    RFT#              GET SIZE OF RFT TABLE                       
         LD,R10   ZEROS             SET NAME OF A FREE ENTRY                    
*                                                                               
ORFIL15  RES      0         FIND ANY UNUSED ENTRY                               
         CB,R7    BT#               IS THIS A BT FILE ENTRY                     
         BLE      ORFER55             YES, ILLEGAL FOR PERM FILES               
         CD,R10   RFT1,R7           IS THIS ONE FREE ?                          
         BE       ORFIL16             YES, USE IT                               
         BDR,R7   ORFIL15           NO, TRY NEXT                                
         B        ORFER55           NONE: GIVE ERROR 55                         
         PAGE                                                                   
*                                                                               
*        AT ORFIL16 WE HAVE LOCATED A FREE ENTRY: ITS INDEX IS IN R7.           
*        WE WILL NOW ENTER INFORMATION ABOUT THE FILE INTO THE TSPACE           
*        BLOCK.  IF THE FILE IS AN ENTIRE AREA, (NAME = BLANKS), WE             
*        CREATE THE INFORMATION FROM THE MASTER DICTIONARY.                     
*        IF IT IS A FILE, WE WILL LOOK IT UP IN THE AREA'S DIRECTORY            
*        AND GET THE INFORMATION FROM THE FILE'S ENTRY.                         
*                                                                               
*                                                                               
ORFIL16  RES      0         DECIDE TYPE OF FILE:  AREA OR FILE                  
         CD,R12   BLANKS            IS IT THE ENTIRE AREA ?                     
         BE       ORFIL19             YES, GET ITS INFO                         
*                                                                               
*                           FILE - LOOK UP NAME IN DIRECTORY                    
         PUSH     R5                SAVE TSPACE POINTER                         
         PUSH     R7                SAVE RFT INDEX                              
         LI,R7    0                 SET R7 FOR 'FIND' IN FINDDIR                
         LCI      2                 RECOVER ACCOUNT NAME LOST IN SEARCH         
         LM,R10   TSNFACT1,R5       FOR AVAIL RFT ENTRY                         
         BAL,R8   FINDDIR           LOOK THE NAME UP                            
         B        ORFILER1          NOT FOUND OR REENTERED: CHECK WHICH         
         PULL     R7                RESTORE RFT INDEX                           
         PULL     R5                RESTORE TSPACE POINTER                      
*                                                                               
*                                                                               
*   REGISTERS AS DESCRIBED ABOVE WITH THE FOLLOWING CHANGES:                    
*                                                                               
*        R4       ADDRESS OF FILE'S DIRE ENTRY IN BLOCKING BUFFER               
*        R6       FILE AREA INDEX                                               
*        R9       (TYC CODE FROM FINDDIR IF FILE NOT FOUND; TEMP)               
*        R10      (BBCW FROM FINDDIR IF FILE FOUND, ELSE UNKNOWN)               
*                                                                               
*                                                                               
         LW,R0    R6                SAVE AREA INDEX AND MOVE BBCW TO R6         
         LW,R6    R10               FOR THE RELEASE SUBROUTINE                  
         LCI      5                 PICK UP FILE INFO FROM DIRECTORY            
         LM,R8    DIREFLGS,R4       AND MOVE TO TSPACE:                         
         STM,R8   TSNFFLGS,R5       FLAGS / GSIZ&RSIZ / FSIZ / BOT / EOT        
         LCI      2                 MOVE REST OF DIRE INFO                      
         LM,R8    DIREXTNT,R4       XTENT / ESIZ                                
         STM,R8   TSNFXTNT,R5                                                   
         BAL,R11  RELADBUF          RELEASE THE BLOCKING BUFFER & DIRE          
         LW,R6    R0                RECOVER AREA INDEX                          
         B        ORFIL20           AND GO BUILD THE ENTRY                      
*                                                                               
*                                                                               
*   FILENAME = BLANKS:  ==> ASSIGN TO AN ENTIRE AREA                            
*                           BUILD TSPACE BLOCK ACCORDINGLY                      
*                                                                               
ORFIL19  RES      0                                                             
         LI,R8    SEQACC+DIRACC+UNBORG   SET FLAGS AND ORGANIZATION             
         SLS,R8   24                MOVE TO BYTE 0 OF WORD                      
         LB,R4    MDDISCI,R6        POINT AT DISC INFO TABLES                   
         LH,R9    DISCNWPS,R4       GET WORDS PER SECTOR AND CONVERT            
         SLS,R9   2                 TO BYTES                                    
         STH,R9   R9                SET GSIZ/RSIZ = BYTES PER SECTOR            
         LI,R11   0                 SET BOT = 0                                 
         LW,R12   MDEOA,R6          GET AREA EOT REL TO DISK                    
         SW,R12   MDBOA,R6          R12= EOT RELATIVE TO AREA                   
         LW,R10   R12               SET FSIZE TO WHOLE AREA                     
         AI,R10   1                                                             
         LCI      5                 AND SAVE IN TPSACE                          
         STM,R8   TSNFFLGS,R5       AS FOR REAL FILES                           
         PAGE                                                                   
*                                                                               
*   ALL INFORMATION THAT GOES IN THE RFT IS NOW IN THE TSPACE BLOCK.            
*   IF WE HAVE NOT BEEN REENTERED (THE RFT HASN'T CHANGED) WE WILL              
*   FORM THE RFT ENTRY.    (THIS IS DONE DISABLED. IT IS DONE IN PIECES         
*   SO MAXIMUM DISABLE TIME IS < 100 MICROSECONDS.)                             
*                                                                               
*                                                                               
ORFIL20  RES      0         BUILD AN RFT ENTRY                                  
         DISABLE                                                                
         CW,R15   RENT:D            HAVE WE BEEN REENTERED ?                    
         BNE      ORFIL10             YES, START OVER                           
         LCI      5                 GET FILE INFO FROM TSPACE BLOCK             
         LM,R8    TSNFFLGS,R5       AND SET:                                    
         STW,R11  RFT2,R7                   BOT                                 
         STW,R12  RFT3,R7                   EOT                                 
         STH,R9   RFT5,R7                   RSIZE                               
         STW,R10  RFT6,R7                   FSIZE                               
         LB,R10   R8                GET ORG AND FLAGS FROM DIRECTORY            
         STB,R10  RFT7,R7           STORE ORG AND FLAGS IN RFT                  
         STB,R6   RFT8,R7                   AREA INDEX                          
         LW,R10   TSOJOBID,R5                                                   
         STB,R10  RFT9,R7           SET JOB ID OF OWNING JOB                    
         LH,R9    R9                                                            
         STH,R9   RFT4,R7                   GSIZE                               
         SLS,R8   -20               POSITION PRIORITY TO BITS 27-31             
         AND,R8   M4                MASK                                        
         STB,R8   RFT16,R7          STORE PRIORITY (USED ONLY IF SYMB)          
*                                                                               
ORFIL21  RES      0         CLEAR POINTER PART OF RFT BUILD                     
         ENABLE                     ALLOW INTERRUPTS                            
         LI,R10   0                 SET A ZERO                                  
         LI,R11   1                 AND A ONE                                   
         DISABLE                    THEN NOT                                    
         CW,R15   RENT:D            WERE WE REENTERED THEN ?                    
         BNE      ORFIL10             YES, START OVER                           
         STB,R10  RFT14,R7          JOB USING BLOCKING BUFFER = NONE            
         STB,R10  RFT15,R7          NUMBER OF BKG USERS = NONE                  
         STW,R10  RFT17,R7          NO BLOCKING BUFFER                          
         STH,R10  RFT10,R7          BUFFER POSITION = BEGINNING                 
         STW,R10  RFT11,R7          FILE POSITION = SECTOR 0                    
         STW,R11  RFT12,R7          CURRENT RECORD = 1                          
         STB,R11  RFT13,R7          NUMBER OF USERS = 1                         
         ENABLE                     ALLOW INTERRUPTS AGAIN                      
         DISABLE                                                                
         CW,R15   RENT:D            WERE WE REENTERED ?                         
         BNE      ORFIL10             YES, START OVER                           
         LW,R9    TSO#BKGO,R5       GET NR OF BKG DCBS OPEN                     
         LCI      2                 GET FILENAME, ACCOUNT NAME, ETC             
         LM,R10   TSNFACT1,R5                                                   
         LM,R12   TSNFNAM1,R5                                                   
         STD,R10  RFTACNT,R7        SET ACCOUNT NAME                            
         STD,R12  RFT1,R7           FILE NAME                                   
         STB,R9   RFT14             # OF BKGD RFT ENTRIES IN USE                
         LW,R8    TSNFXTNT,R5       AND FINALLY WHICH EXTENT OF THE             
         STH,R8   RFTE#,R7          FILE                                        
         LW,R8    TSNFESIZ,R5       GET EXTENT SIZE                             
         STW,R8   RFTESZ,R7         STORE IT                                    
*                                                                               
ORFIL22  RES      0         ENTRY: NEW USER OF SAME FILE; MARK DCB OPEN         
         LW,R14   0,R2                                                          
         LW,R12   1,R2              WORD 1 OF DCB TO R12                 1208000
         SLS,R12  -14                                                           
         SLS,R12  6                                                             
*        IF HERE VIA ORFIL30, R6 MAY STILL BE -1 (FOR PUBLIC FILES)             
         LB,R6    RFT8,R7           GET AREA INDEX                              
         OR,R12   R6                MERGE AREA INDEX                            
         SLS,R12  8                                                             
         OR,R12   R7                MERGE RFT INDEX                             
         OR,R14   Y002              SET OPEN                             1210000
         STW,R14  *R2               SET DCB WORD 0                       1211000
         STW,R12  1,R2              STORE WORD 1 OF DCB                  1212000
         BIFFGD   ORFIL23           ARE WE A BKG USER ?                         
         MTB,+1   RFT15,R7            YES, BUMP COUNT OF BKG USERS              
*                                                                               
ORFIL23  RES      0         FIX COUNT OF FILES OPEN FOR A LOAD MODULE           
         LB,R4    TCBPOINT          TASK ID                                     
         LB,R4    STILMID,R4        LM ID                                       
         LW,R4    LMIRFT,R4         ADDRESS OF FILE ACTIVITY TABLE              
         BEZ      %+2               B IF NONEXISTENT                            
         MTB,1    *R4,R7            INCR. COUNT FOR THIS FILE                   
         MTW,+1   RENT:D            STEP REENTRANCE COUNT                       
         ENABLE                                                                 
         LB,R4    TCBPOINT          UNLINK TSPACE BLOCK AND RELEASE IT          
         LW,R7    R5                POINT AT BLOCK TO BE RELEASED               
         LW,R5    0,R7              GET LINK TO NEXT, IF ANY                    
         DISABLE                                                                
         STW,R5   STISPCE,R4        UNLINK OUR PIECE                            
         BAL,R8   RELTEMP           THROW OURS BACK IN THE POOL                 
         ENABLE                                                                 
         PULL     2,R3              RECOVER FPT ADDRESS, LINK                   
         B        OPEN1B            EXIT SUCCESSFULLY                           
         PAGE                                                                   
*                                                                        1216000
*                                                                        1217000
*   AT ORFIL30   THE DESIRED FILE IS ALREADY IN THE RFT TABLE                   
*        REGISTERS ARE AS AT ORFIL10                                            
*        WE ARE ENABLED HERE                                                    
*                                                                               
ORFIL30  RES      0         DECIDE HOW TO PROCESS FILE ALREADY IN RFT           
          PUSH     R5               SAVE TSPACE POINTER                         
          BAL,R5   OPENCKM          CHECK MODE OF CALLER (USE WEIRD LINK)       
          B        ORFILER2           ERROR; RETURN TYC GIVEN IN R9             
          PULL     R5               RECOVER TSPACE BLOCK POINTER                
         DISABLE                                                                
         CW,R15   RENT:D            HAVE WE BEEN REENTERED ?                    
         BNE      ORFIL10             YES, START OVER                           
         LB,R14   RFT14             GET NUMBER OF BKG FILES NOW OPEN            
         STW,R14  TSO#BKGO,R5       PUT IN ITS PLACE IN TSPACE BLOCK            
         CB,R7    BT#               IS IT A TEMP (BT AREA ) FILE ?              
         BG       ORFIL31             NO                                        
*                                                                               
         MTB,+0   RFT13,R7          IS RFT ENTRY FOR OPLABLE ASSIGNMNT?         
         BEZ      ORFIL21             YES, ZERO POSITION PTRS, ETC              
*                                                                               
ORFIL31  RES      0         2ND (OR MORE) ASSIGNMENT TO SAME FILE               
         MTB,+1   RFT13,R7          STEP NUMBER OF OPEN DCBS                    
         B        ORFIL22           AND ASSIGN TO THE DCB                       
         PAGE                                                                   
*                 ERROR PROCESSING FOR 'OPENRFIL'                               
*                                                                               
ORFILER2 RES      0         ERROR FROM OPENCKM: REPORT ILLEGAL TASK TYPE        
         PULL     R5                RECOVER TSPACE POINTER                      
         B        ORFILER           CLEAN UP AND EXIT WITH ERROR                
*                                                                               
*                                                                               
ORFILER1 RES      0         ERROR FROM FINDDIR:  -  TEST WHY                    
         PULL     R7                RESTORE RFT INDEX                           
         PULL     R5                RESTORE TSPACE POINTER                      
         CI,R9    TYCREENT          ERROR FROM BEING REENTERED ?                
         BE       ORFIL10             YES, TRY IT ALL OVER AGAIN                
*                                                                               
ORFILER  RES      0         FATAL ERROR: CLEAN UP AND REPORT IT                 
         PUSH     R9                SAVE ERROR CODE OVER TSPACE UNLINK          
         DISABLE                                                                
         LB,R4    TCBPOINT          UNLINK TSPACE BLOCK AND RELEASE IT          
         LW,R7    R5                POINT AT BLOCK TO BE RELEASED               
         LW,R5    0,R7              GET LINK TO NEXT, IF ANY                    
         STW,R5   STISPCE,R4        UNLINK OUR PIECE                            
         BAL,R8   RELTEMP           AND THROW BACK IN THE POOL                  
         PULL     R9                RECOVER ERROR CODE                          
*                                                                               
ORFILERA RES      0         ERROR EXIT: RETURN TO LINK                          
         PULL     2,R3              RECOVER FPT ADDRESS, LINK                   
         B        OPEN1A            GO RETURN AT ERROR EXIT                     
*                                                                               
*                                                                               
ORFILERT RES      0         NOT ENOUGH TSPACE ERROR: MOVE ERROR CODE            
         LW,R9    R15               MOVE CODE TO OUR ERROR REGISTER             
         B        ORFILERA          AND RETURN AN ERROR                         
*                                                                               
*                                                                               
*                                                                               
ORFER03  RES      0                                                             
         LI,R9    K3                FILE DOESN'T EXIST                          
         B        ORFILER           TAKE ERROR EXIT                             
*                                                                               
ORFER55  RES      0                                                             
         LI,R9    K55               NO BLK BUFF OR NO RFT OR BB ADDR BAD        
         B        ORFILER           TAKE ERROR EXIT                             
*                                                                               
*                                                                               
        DO       #DISKPAK    IF DISC PACKS ARE IN SYSTEM...                     
ORFER2F  RES      0         TRYING TO OPEN FILE TO PACK BEING DISMOUNTED        
         LI,R9    K2F               SET ERROR TYC                               
         B        ORFILER           GOTO COMMON ERROR ROUTINE                   
        FIN      #DISKPAK                                                       
         PAGE                                                                   
***************                                                                 
*   OPENCKM   *                                                                 
***************                                                                 
*                                                                               
*   ROUTINE VERIFYS THAT THE MODE OF THE CALLER IS OK FOR                       
*   SHARING THE FILE.                                                           
*                                                                               
*        BAL,R5   OPENCKM                                                       
*                                                                               
*   RETURNS +1 IF OPEN NOT ALLOWED BECAUSE OF MODE ERROR                        
*   RETURNS +2 IF OPEN OK FOR CALLER                                            
*                                                                               
*   REGISTERS USED:   R4,R5,R10,R11                                             
*                                                                               
OPENCKM  RES      0                                                             
         LB,R4    RFT7,R7           GET FILE ORGANIZATION                       
         AND,R4   ORGMASK           ONLY. IS ORG = UNBLOCKED ?                  
         BEZ      1,R5                YES, SHARING ALWAYS OK FOR UNB            
         LW,R0    RFT17,R7          IS A BB TIED TO THE FILE                    
         BEZ      1,R5              NO, OK TO OPEN                              
         CB,R7    BT#               IS IT A BT FILE                             
         BG       OCKM5             NO                                          
         BIFBKG   1,R5              BKGD OPENING BT FILE                        
         B        OCKM40            ERROR, CALLER FGD                           
OCKM5    RES      0                                                             
         LB,R4    TCBPOINT                                                      
         LB,R4    STIJID,R4         GET CALLER'S JOB ID.                        
         CB,R4    RFT14,R7          IS CALLER IN SAME JOB                       
         BNE      OCKM40            NO, ERROR                                   
*   SEARCH LMIRFT TABLES UNTIL WE FIND A LM WITH THIS FILE OPEN.                
*   WHEN FOUND, COMPARE MODE WITH THE MODE OF THE CALLER.                       
         LB,R4    LMIMAXR           GET # OF LMI ENTRIES                        
OCKM10   RES      0                                                             
         LW,R10   LMIRFT,R4         GET 1ST/NXT ENTRY                           
         BEZ      OCKM20            UNUSED, BRANCH                              
         MTB,0    *R10,R7           DOES THIS LM HAVE THE FILE OPEN             
         BNEZ     OCKM30            YES, BRANCH                                 
OCKM20   RES      0                                                             
         BDR,R4   OCKM10            TRY NEXT                                    
         B        1,R5              NO OPEN DCBS, TAKE NORMAL EXIT              
OCKM30   RES      0                                                             
         LW,R10   LMIPCB,R4         GET FLAGS FOR CURRENT USER                  
         LW,R11   XLMIMAP           MASK FOR COMPARING MAP BITS                 
         CS,R10   PCBPOINT          COMPARE MODE WITH CALLER                    
         BE       1,R5              MODES MATCH, TAKE NORMAL EXIT               
*                                                                               
*   ERROR PROCESSING                                                            
*                                                                               
OCKM40   RES      0                                                             
         LI,R9    TYC6A             ILLEGAL TASK MODE FOR OPEN                  
         B        0,R5              MISMATCH, TAKE ERROR EXIT                   
         PAGE                                                                   
*************                                                                   
*  ORFGETP  *                                                                   
*************                                                                   
*                                                                               
*        CALL GETP AND CHECK RESULTS FOR OPENRFIL                               
*                                                                               
*        INPUT:   R2 = DCB ADDRESS                                              
*                 R4 = DCB SIZE                                                 
*                 R7 = LINK                                                     
*                 R15 = OPTIONAL WORD NR                                        
*                                                                               
*        EXIT:    +1 IF PARAM NOT PRESENT                                       
*                 +2 IF PRESENT                                                 
*                 R15 = PARAM (IF PRESENT)                                      
*                 R5 AND R14 ALTERED                                            
*                                                                               
ORFGETP  RES      0                                                             
         CI,R4    7                                                             
         BLE      0,R7              RETURN. NO OPTIONAL WORDS                   
         XW,R2    R3                                                            
         AI,R3    6                 SET UP TO USE GETP                          
         BAL,R5   GETP                                                          
         AI,R7    -1                NOT PRESENT. PREPARE NO-SKIP RTN            
         AI,R7    1                                                             
         AI,R3    -6                RESTORE REGISTERS                           
         XW,R2    R3                                                            
         SW,R14   R2                                                            
         CW,R14   R4                                                            
         BL       0,R7              RETURN IF PARAM WITHIN DCB                  
         LI,R9    K1                TYC FOR PARAM PAST END OF DCB               
         B        ORFILERA                                                      
*****                                                                           
         PAGE                                                                   
         SPACE    2                                                             
         OLAYEND                                                                
         END                                                                    
