         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
*  ENTRY POINTS                                                                 
         DEF      RWFILE                                                        
         DEF      FMCKWP,FMMASTX,RWFIL9                                         
*   EXIT POINTS                                                                 
         DEF      RWUFX1,RWUFX2                                                 
         DEF      RWRFX1,RWRFX2                                                 
         DEF      RWX14,RWX17,RWX19,RWX20,RWX21                                 
         DEF      RWX22,RWX30,RWX31,RWX32                                       
         REF      MDLOCK,SJI4                                                   
         PSYS     0                                                             
OLAYFLAG EQU      'RWFI'                                                        
         SYSTEM   CPRMON                                                        
*                                                                               
*   EXITS                                                                       
*                                                                               
RWX17    B        RWBFIL            EXIT TO RWBFIL OVERLAY                      
RWX19    B        ERROR60           ILLEGAL SHARING OF RAD FILE                 
RWX20    B        POST06            EOD                                         
RWX21    B        1,R5                                                          
RWX22    B        0,R5                                                          
RWX30    B        POST                                                          
RWX31    B        ERROR59           DCB CHANGED SINCE OPEN                      
RWX32    B        ERROR4A           ILLEGAL ADDR OR SIZE FOR BUFFER             
RWRFX1   B        POST05            EOT                                         
RWRFX2   B        TRAPX             BAD CAL                                     
RWUFX1   B        GETNRT            DO THE I/O                                  
RWUFX2   B        POSTEOD           HOUSEKEEP FILE, POST EOT                    
         TITLE    '** RWFILE - READ/WRITE DISK FILE **'                         
**************                                                           1254000
*   RWFILE   *                                                           1255000
**************                                                           1256000
*                                                                        1257000
*   ROUTINE PERFORMS ALL READ/WRITE FUNCTIONS ON RAD FILES               1258000
*                                                                        1259000
*   AT ENTRY:   R1   FPT CODE X'10' FOR READ, X'11' FOR WRITE            1260000
*               R2   DCB ADDRESS                                         1261000
*               R3   FPT ADDRESS                                         1262000
*               R7   RFT INDEX IN BYTE 3 WITH BIT 24 ON                  1263000
*               R8   WORD 0 OF THE DCB                                   1264000
*               R10  BYTE ADDRESS OF BEGINNING OF USER BUFFER            1265000
*               R11  BYTE COUNT                                          1266000
*               R13  PRIORITY                                            1267000
*                                                                               
RWFILE   RES      0                                                             
         AND,R7   M7                R7= RFT INDEX                               
         BEZ      RWX31             ERROR, RFTX CANNOT BE ZERO                  
         LB,R6    RFT8,R7           AREA INDEX TO R6                     1272000
         CI,R8    2                                                             
         BANZ     RWFIL3            B IF THRU OP LABEL                          
         CH,R7    RFT4              IS THE RFT INDEX VALID ?                    
         BG       RWX31             NO, TOO BIG                                 
         LD,R8    RFT1,R7           DOES THE ENTRY POINT AT A FILE ?            
         BEZ      RWX31             ERROR, UNUSED ENTRY                         
*                                                                               
RWFIL3   RES      0                                                             
         CI,R1    K10               READ REQUEST?                        1274000
         BE       RWFIL6                                                        
*                                                                        1280000
*   HERE WE HAVE A WRITE REQUEST.  CHECK FOR WRITE                              
*    PROTECTION VIOLATION.                                                      
*                                                                               
         BAL,R5   FMCKWP            BAL TO CHECK WP                             
RWX14    B        POST10            ERROR, WRITE PROT VIOLATION                 
*                                                                        1298000
*  AT RWFIL6 WE HAVE A LEGIT REQUEST IN TERMS OF USER BUFFER,                   
*    READING OF SHARED FILES, & WRITE PROTECTION                         1300000
*                                                                               
RWFIL6   LW,R12   1,R3              WORD 1 OF FPT TO R12                        
         CW,R12   Y01               TEST P8 (BIT )                       1302000
         BANZ     RWRFILE           B IF RANDOM ACCESS REQUEST                  
*                                                                        1304000
*  HERE WE HAVE SOME SORT OF SEQUENTIAL ACCESS REQUEST                   1305000
*                                                                               
RWFIL9   RES      0                                                             
         LB,R6    RFT8,R7           GET AREA INDEX IN R6                        
         LW,R9    RFT12,R7          GET CURRENT POSITION IN FILE                
         CI,R1    K11               TEST IF WRITE                               
         BNE      RWFIL18           NO, BRANCH                                  
         STW,R9   RFT6,R7           SET NEW FILE SIZE                           
         LB,R12   RFT16,R7                                                      
         AND,R12  X3F               RESET 'WRITTEN' BITS                        
         AI,R12   SEQWRT            SET STATUS= WRITTEN SEQUENTIALLY            
         STB,R12  RFT16,R7                                                      
         LB,R12   RFT7,R7                                                       
         AND,R12  X3F               RESET ACCESS TYPE                           
         AI,R12   SEQACC            SET FLAG= SEQUENTIAL ACCESS FILE            
         STB,R12  RFT7,R7                                                       
*                                                                        1310000
*  HERE WE HAVE A SEQUENTIAL ACCESS REQUEST                                     
*                                                                               
RWFIL12  RES      0                                                             
         LH,R5    RFT5,R7           R5= RECORD SIZE                             
         AND,R5   M16               MASK                                        
         CW,R11   R5                COMPARE BYTES TO REC SIZE                   
         BLE      RWFIL15           B IF OK                                     
         LW,R11   R5                SUBSTITUTE RECORD SIZE                      
         BNEZ     RWFIL15           B IF BYTE COUNT OK                          
         CI,R1    K10               ERROR, TEST FPT CODE                        
         BE       RWX32             TAKE EROR EXIT                              
         MTW,-1   RFT6,R7           ADJUST FILE SIZE FOR WRITE                  
         B        RWX32             TAKE ERROR EXIT                             
*                                                                        1317000
*   NOW WE DETERMINE THE FILE ORGANIZATION AND BRANCH                           
*   TO THE APPROPRIATE PROCESSING ROUTINE                                       
*                                                                               
RWFIL15  RES      0                                                             
         LB,R12   RFT7,R7           ORGANIZATION CODE TO R12                    
         AND,R12  ORGMASK           IS THE ORG UNBLOCKED ?                      
         BGZ      RWX17               NO, BLOCKED OR COMPRESSED                 
         B        RWUFILE           B TO READWRIT U FILE                        
*                                                                               
*   HERE WE ARE READING SEQUENTIALLY                                            
*   R1=  FPT CODE                                                               
*   R2=  DCB ADDRESS                                                            
*   R3=  FPT ADDRESS                                                            
*   R7=  RFT INDEX                                                              
*   R9=  CURRENT RECORD NUMBER IN THE FILE                                      
*   R10= BYTE ADDRESS OF BUFFER                                                 
*   R11= BYTE COUNT                                                             
*   R13= PRIORITY                                                               
*                                                                               
RWFIL18  LB,R12   RFT13,R7          NO OF USERS                                 
         CI,R12   2                                        /SIG7-2097/*C5732    
         BL       RWFIL21                                  /SIG7-2097/*C5732    
*                                                                               
*   TWO OR MORE DCB'S ARE OPEN TO THE SAME FILE.  THIS WILL                     
*   BE ALLOWED ONLY IF THE RAD FILE IS ALSO THE C DEVICE.                       
*                                                                               
         BAL,R4   FMOPL2AD          GET ADDRESS OF OPLBS2 TABLE (R5)            
         LI,R4    1                 'C' OP LABEL INDEX                          
         LB,R4    *R5,R4            GET C OP LABEL ASSIGNMENT                   
         CI,R4    X'80'             IS IT AN RFT INDEX                          
         BAZ      RWX19             NO, ERROR 60                                
         AND,R4   M7                                       /SIG7-2097/*C5732    
         CW,R4    R7              IS C ASSIGNED TO THE FILE/SIG7-2097/*C5732    
         BNE      RWX19             NO, ERROR 60                                
RWFIL21  RES      0                                                             
         CW,R9    RFT6,R7           IS RECORD WITHIN THE FILE                   
         BLE      RWFIL12           YES, BRANCH                                 
         LD,R4    BLANKS                                                        
         CD,R4    RFT1,R7           ARE WE READING THE AREA                     
         BE       RWFIL12           YES, THEN THIS IS NOT AN EOD                
*   HERE WE HAVE HIT EOD ON A SEQUENTIAL ACCESS READ                            
*   OF A FILE.  IF THE FILE WAS ALLOTTED AS EXTENSIBLE                          
*   THE NEXT EXTENT WILL BE LOCATED, THE APPROPRIATE                            
*   RFT ENTRIES UPDATED AND THE READ WILL BE                                    
*   ATTEMPTED AGAIN.                                                            
         MTW,0    RFTESZ,R7         IS THE FILE EXTENSIBLE                      
         BEZ      RWX20             NO, PROCESS EOD EXIT                        
         BAL,R8   RWEXTSEQ          YES, GET NEXT EXTENT                        
         B        RWFIL24           +1..ERROR, R9=TYC                           
         B        RWX20             +2..EOD, NEXT EXT. NONEXISTENT              
         B        RWFIL9            +3..GOT NEXT EXTENT, CONTINUE               
*                                                                               
*   PROCESS ERROR IN GETTING NEXT FILE EXTENT.                                  
*                                                                               
RWFIL24  RES      0                 R9 HAS ERROR (TYC)                          
         CI,R9    TYCREENT          WERE WE REENTERED                           
         BE       RWFIL9            YES, TRY AGAIN                              
         LW,R12   R9                R12= TYC                                    
         B        RWX30             POST THE ERROR                              
         TITLE    '** RWFILE - READ WRITE UNBLOKCED FILE **'                    
***************                                                                 
*   RWUFILE   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   ROUTINE PROCESSES SEQUENTIAL ACCESS READ/WRITE                              
*   CALLS FOR UNBLOCKED FORMAT FILES.                                           
*                                                                               
*   REGISTERS:                                                                  
*        R1       FPT CODE                                                      
*        R2       DCB ADDRESS                                                   
*        R3       FPT ADDRESS                                                   
*        R6       AREA INDEX                                                    
*        R7       RFT INDEX                                                     
*        R9       RECORD NUMBER TO READ OR WRITE                                
*        R10      BYTE ADDRESS OF BUFFER                                        
*        R11      BYTE COUNT                                                    
*                                                                               
RWUFILE  RES      0                                                             
         LH,R15   RFT5,R7           GET FILE RECORD SIZE                        
         AND,R15  M16                                                           
         BAL,R8   SECTPERN          SET R15 = SECTORS PER RECORD                
*                                                                        1321000
*  WE NOW KNOW THE NO OF RAD SECTORS REQUIRED TO CONTAIN THE RECORD      1322000
*   WE SHALL NOW TEST FOR EOT.                                                  
         LW,R14   RFT11,R7          CURRENT SECTOR REL TO FILE                  
         AW,R14   RFT2,R7           SECTOR NUMBER REL TO AREA                   
         AW,R14   R15               ADD SIZE OF RECORD TO GET END+1             
         AI,R14   -1                LAST SECTOR OF IO REL TO AREA               
         CW,R14   RFT3,R7           IS LAST SECTOR WITHIN FILE ?                
         BG       RWUFIL9           PROCESS EOT                                 
*                                                                               
         AI,R14   1                 SET BACK TO POSITON OF NEXT RECORD          
         AI,R9    1                 STEP RECORD NUMBER                          
         SW,R14   RFT2,R7           R14=FILE RELATIVE SECTOR POSITION           
         DISABLE                                                                
         XW,R14   RFT11,R7          AND SET POSITION IN FILE, (SECTOR           
         STW,R9   RFT12,R7          & RECORD); GET START SECTOR IN R14          
*                                                                               
*                                                                               
*   WE ARE NOW READY TO SET UP THE PARAMETERS TO 'QUEUE'.                       
*                                                                               
*   REGISTERS ARE AS AT ENTRY, PLUS                                             
*        R14      FILE RELATIVE START SECTOR                                    
*                                                                               
*   WE SET HERE THE FOLLOWING PARAMETERS:                                       
*        R4       I/O FUNCTION CODE                                             
*        R7       DCT INDEX         )                                           
*        R12      SEEK ADDRESS      ) ==> VIA CVTFILE                           
*                                                                               
*        THE REMAINING REGISTERS FOR FMQUEUE ARE SET IN GETNRT                  
*                                                                               
RWUFIL3  RES      0         SET FUNCTION CODE AS PER REQUEST                    
         BAL,R5   CVTFILE           CONVERT FILE REL SECTOR TO SEEKADDR         
         B        RWUFIL18          ERROR, R15=TYC                              
*                                                                               
         CI,R1    K10               READ REQUEST?                        1358000
         BNE      RWUFIL6           NO                                          
*                                   YES                                         
         LI,R4    FCRRAD            SET FUNCTION CODE TO READ            1357000
         LW,R15   1,R3              FPT WORD 1                                  
         CI,R15   8                 CHECK WRITE REQUESTED                       
         BAZ      RWUFX1            NO, GO TO GETNRT                            
*                                   YES                                         
         LI,R4    FCRCWRAD          READ/CHECK-WRITE FUNCTION                   
         B        RWUFX1            B TO GETNRT                                 
*                                                                               
*                                                                               
* WRITE REQUEST                                                                 
*                                                                               
RWUFIL6  RES      0         TEST TYPE OF WRITE                                  
         LI,R4    FCWRAD            SET FUNCTION = NORMAL WRITE                 
         LW,R15   1,R3              FPT WORD 1                                  
         CI,R15   8                                                             
         BAZ      RWUFX1            B IF NOT CHECK-WRITE                        
         LI,R4    FCWCWRAD                                                      
         B        RWUFX1            NOW GO TO GETNRT                            
*                                                                               
*   PROCESS EOT ON A SEQUENTIAL ACCESS READ/WRITE                               
*   REQUEST TO AN UNBLOCKED FILE.                                               
*                                                                               
RWUFIL9  RES      0                                                             
         CI,R1    K10               IS THIS A READ                              
         BE       RWUFX2            YES, POST EOT                               
         MTW,0    RFTESZ,R7         IS THE FILE EXTENSIBLE                      
         BEZ      RWUFX2            NO, POST EOT                                
         MTW,-1   RFT6,R7           DECREMENT FILE SIZE                         
         BAL,R8   RWEXTSEQ          ALLOCATE NEXT EXTENT                        
         B        RWUFIL15          +1..ERROR, R9=TYC                           
         B        RWRFX1            +2..POST EOT                                
         B        RWFIL9            +3..EXTENT ALLOTTED, CONTINUE               
*                                                                               
*   PROCESS ERRORS IN READ/WRITE UNBLOCKED FILES.                               
*                                                                               
RWUFIL15 RES      0                                                             
         CI,R9    TYCREENT          WERE WE REENTERED                           
         BE       RWFIL9            YES, START AGAIN                            
         LW,R12   R9                TYC TO R12                                  
         B        RWX30             POST                                        
*                                                                               
RWUFIL18 RES      0                                                             
         LW,R12   R15               MOVE TYC TO R12 FOR POST                    
         CI,R1    K10               IS THIS A READ REQUEST                      
         BE       RWX30             YES, EXIT TO POST TYC                       
         MTW,-1   RFT6,R7           ADJUST FILE SIZE                            
         B        RWX30             POST                                        
         TITLE    '** RWFILE - READ/WRITE RANDOM FILE **'                       
***************                                                                 
*   RWRFILE   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*                                                                               
*   ROUTINE PROCESSES DIRECT ACCESS (RANDOM ACCESS)                             
*   READ/WRITE REQUESTS TO RAD FILES.                                           
*                                                                               
*                                                                               
*   REGISTERS:                                                                  
*        R1       FPT CODE                                                      
*        R2       DCB ADDRESS                                                   
*        R3       FPT ADDRESS                                                   
*        R7       RFT INDEX                                                     
*        R10      BYTE ADDRESS OF BUFFER                                        
*        R11      BYTE COUNT                                                    
*                                                                               
*                                                                        1367000
RWRFILE  RES      0                                                             
         LB,R6    RFT8,R7           GET AREA INDEX IN R6                        
*  GET EXTENT 0 INTO THE RFT IF THE FILE IS EXTENSIBLE                          
         MTW,0    RFTESZ,R7         GET EXTENT SIZE                             
         BEZ      RWRFIL3           B IF FILE NOT EXTENSIBLE                    
         LH,R4    RFTE#,R7          GET CURRENT EXTENT NUMBER                   
         BEZ      RWRFIL3           B IF ALREADY IN EXTENT 0                    
         LW,R5    RFT12,R7          GET CURRENT RECORD NUMBER                   
         LW,R15   RENT:D            REENT COUNT FOR FINDDIR                     
         LI,R9    0                 R9= EXTENT NUMBER TO FIND                   
         PUSH     6,R6              SAVE R6-R11                                 
         BAL,R8   FMGETEXT          GO GET THE EXTENT INTO THE RFT              
         B        RWRFIL24          ERROR, R9=TYC                               
         PULL     6,R6                                                          
RWRFIL3  RES      0                                                             
*   COMPUTE NUMBER OF SECTORS PER GRANULE                                       
         LH,R15   RFT4,R7           GRANULE SIZE TO R15                         
         AND,R15  M16               MASK                                        
         BAL,R8   SECTPERN          SET R15 = SECTORS PER GRANULE               
         LW,R13   R15               SAVE SECTORS/GRANULE IN R13          1370000
*   GET GRANULE NUMBER FOR I/O AND THEN DETERMINE THE FIRST                     
*   SECTOR FOR THE REQUEST RELATIVE TO THE FILE AND AREA.                       
         LI,R15   K8                SET N=8                              1371000
         BAL,R5   GETPI             GET KEY PARAMETER (GRANULE #)               
         NOP                         ALREADY KNOW IT'S THERE                    
         LW,R4    R13               SAVE SECTORS/GRANULE IN R4                  
         MW,R13   R15               R13=(GRAN #)X(SECTS/GRAN)                   
*                                      = 1ST SECTOR OF I/O REL TO FILE          
         BCS,4    RWRFIL19          B IF OVERFLOW                               
         LW,R9    R13               R9=1ST SECTOR OF I/0 REL TO FILE            
*   COMPUTE LAST SECTOR OF I/0 RELATIVE TO FILE.                                
         LW,R15   R11               BYTE COUNT                                  
         BAL,R8   SECTPERN          GET SECTORS PER USER RECORD IN R15          
         LW,R14   R15               SAVE IT IN R14                              
         AW,R9    R15               R9=LAST SECT+1 OF USER IO REL TO FILE       
         LW,R15   R9                MOVE IT TO R15 TOO.                         
*   COMPUTE LAST SECTOR OF I/O RELATIVE TO AREA                                 
         AW,R15   RFT2,R7           ADD START SECT OF FILE REL TO AREA          
         AI,R15   -1                R15=LAST SECT OF IO REL TO AREA             
         BLZ      RWRFX2            ERROR IF NEGATIVE                           
         CW,R15   RFT3,R7           IS IT > EOT ?                               
         BG       RWRFIL18          POST05 (EOT)  IF GREATER                    
*                                                                               
*   PREPARE FOR CALL TO QUEUE.                                                  
*   REGISTERS CONTAIN:                                                          
*        R1-R3    SAME AS AT ENTRY                                              
*        R4       NUMBER OF SECTORS PER GRANULE                                 
*        R7       RFT INDEX                                                     
*        R9       LAST SECTOR+1 OF USER I/O RELATIVE TO THE FILE                
*                 (SAME AS NUMBER OF SECTORS ACCESSED IN THE FILE)              
*        R10      BUFFER ADDRESS                                                
*        R11      BYTE COUNT                                                    
*        R13      FIRST SECTOR OF I/O RELATIVE TO FILE                          
*                                                                               
RWRFIL6  RES      0                                                             
         LW,R14   R13               SET START SECTOR FOR USE AT RWUFIL3         
         LB,R5    TCBPOINT          STI INDEX                                   
         LW,R13   STIPRIO,R5        PRIORITY WORD                               
         LB,R13   R13               TASK PRIORITY                               
         CI,R1    K10                                                           
         BE       RWRFIL9           B IF READ CALL                              
         DISABLE                                                                
         LB,R5    RFT16,R7          GET FLAGS                                   
         AND,R5   X3F               MASK                                        
         AI,R5    DIRWRT            SET 'DIRECTLY WRITTEN' BIT                  
         STB,R5   RFT16,R7          STORE BACK                                  
         LB,R5    RFT7,R7           SET DIRECT ACCESS BIT                       
         AND,R5   X3F               MASK OUT OLD BITS                           
         AI,R5    DIRACC            SET 'DIRECT ACCESS FILE' BIT                
         STB,R5   RFT7,R7                                                       
RWRFIL9  RES      0                                                             
*   REGISTERS CONTAIN:                                                          
*        R1-R3    SAME AS AT ENTRY                                              
*        R4       NUMBER OF SECTORS PER GRANULE                                 
*        R7       RFT INDEX                                                     
*        R9       LAST SECTOR+1 OF USER I/O RELATIVE TO THE FILE                
*                 (SAME AS NUMBER OF SECTORS ACCESSED IN THE FILE)              
*        R10      BUFFER ADDRESS                                                
*        R11      BYTE COUNT                                                    
*        R13      TASK PRIORITY                                                 
*        R14      FIRST SECTOR OF I/O RELATIVE TO FILE                          
*                                                                               
         DW,R9    R4                R9= NUMBER OF GRANULES IN FILE              
         CW,R9    RFT6,R7           IS IT GREATER THAN OLD # GRANULES           
         BLE      RWRFIL12          NO, BRANCH                                  
         CI,R1    K10               IS THIS A READ CAL                          
         BE       RWRFIL15          YES, PROCESS EOD                            
         STW,R9   RFT6,R7           NO, UPDATE FILE SIZE                        
RWRFIL12 RES      0                                                             
         ENABLE                                                                 
         B        RWUFIL3                                                1385000
*                                                                               
*   TEST FOR EOD ON A READ.  THIS CAN ONLY OCCUR WHEN READING A                 
*   FILE.  EOD WILL NOT BE RETURNED FOR AREA READ.                              
RWRFIL15 RES      0                                                             
         LD,R4    RFT1,R7           GET FILE NAME                               
         CD,R4    BLANKS            IS IT THE ENTTIRE AREA                      
         BE       RWUFIL3           YES, DON'T RETURN EOD                       
         B        RWX20             NO, EXCEEDING WRITTEN DATA FOR              
*                                    THIS EXTENT.                               
         SPACE 3                                                                
*                                                                               
*                                                                               
*   PROCESS EOT                                                                 
*                                                                               
*                                                                               
RWRFIL18 RES      0                                                             
         MTW,0    RFTESZ,R7         IS THE FILE EXTENSIBLE                      
         BEZ      RWRFIL19          NO, EOD/EOT                                 
         BAL,R8   RWEXTDIR          YES, GET/ALLOT NEXT EXTENT                  
         B        RWRFIL21          +1..ERROR, R9=TYC                           
         B        RWRFIL19          NO, EOD/EOT                                 
         B        RWRFIL6           +3..GOT/ALLOTTED NEXT EXTENT                
*                                                                               
RWRFIL19 RES      0                 EOD/EOT                                     
         CI,R1    K10                                                           
         BNE      RWRFX1            IF NOT READ, REPORT EOT                     
         LW,R4    RFT1,R7                                                       
         CD,R4    BLANKS                                                        
         BE       RWRFX1            FOR AREA, REPORT EOT                        
         B        RWX20             FOR FILE, REPORT EOD                        
*                                                                               
*                                                                               
*   PROCESS ERRORS IN FILE EXTENSION                                            
*                                                                               
RWRFIL21 RES      0                                                             
         CI,R9    TYCREENT          WERE WE REENTERED                           
         BE       RWRFILE           YES, TRY AGAIN                              
         LW,R12   R9                R12= TYC                                    
         B        RWX30             POST                                        
*                                                                               
RWRFIL24 RES      0                                                             
         LW,R12   R9                MOVE TYC TO R9                              
         PULL     6,R6              RESTORE R6-R11                              
         CI,R12   TYCREENT          WERE WE REENTERED                           
         BNE      RWX30             NO, POST ERROR                              
         B        RWRFILE           YES, TRY AGAIN                              
         PAGE                                                                   
**************                                                                  
*   FMCKWP   *                                                                  
**************                                                                  
*                                                                               
*  ROUTINE CHECKS FOR A SOFTWARE WRITE PROTECTION VIOLATION.                    
*  ROUTINE EXITS +1 IF VIOLATION, +2 OTHERWISE                                  
*                                                                               
*  AT ENTRY:      R6   AREA INDEX                                               
*                 R5   LINK                                                     
*                                                                               
*        BAL,R5   FMCKWP                                                        
*                                                                               
*  REGISTERS CHANGED:   R0                                                      
*                                                                               
FMCKWP   RES      0                                                             
         BIFRBM   RWX21             EXIT IF RBM                                 
         PUSH     R5                                                            
         LB,R5    TCBPOINT          GET TASK ID                                 
         LB,R5    STIJID,R5         GET JOB ID                                  
         LW,R5    SJI1,R5           GET JCB ADDRESS                             
         LW,R0    0,R5              GET JCB WORD 0                              
         CI,R0    JCBSY                                                         
         BAZ      FMCKWP1            NO SY PRIVILEGE                            
         LH,R0    MDLOCK,R6          GET AREA LOCK                              
         BEZ      FMCKWP2            AREA NOT LOCKED, WRITE OK                  
         LB,R5    TCBPOINT           GET TASK ID                                
         LB,R5    STIJID,R5          GET JOB ID                                 
         CH,R0    SJI4,R5            ARE LOCK AND KEY EQUAL                     
         BE       FMCKWP2            YES, WRITE OK                              
         LH,R0    K:SY                 IS IT A CATALOG PROCEDURE                
         CI,R0    X'5A'                                                         
         BE       FMCKWP2              YES  WRITE OK                            
*                                    NO, FALL THROUGH AS IF                     
FMCKWP1  RES      0                  NO SY PRIVILEGE                            
         PULL     R5                                                            
         LB,R0    MDFLAG,R6         GET FLAG BYTE                               
         AND,R0   M3                AND GET WRITE PROTECT CODE                  
         CI,R0    WPCSYS            IS IT A SYSTEM, IOEX, ETC. CODE ?           
         BGE      RWX22               YES, WRITE PROTECT CODE ERROR             
         BIFFGD   RWX21             OK IF FGD                                   
         CI,R0    WPCBKG            BKG WRITING BKG ?                           
         BLE      RWX21             OR PUBLIC, YES, TAKE NORMAL EXIT            
         B        RWX22             ERROR, RETURN +1                            
FMCKWP2  RES      0                                                             
         PULL     R5                                                            
         B        RWX21                                                         
         TITLE    '** RWFILE - SUB TO GET AREA INDEX **'                        
***************                                                                 
*   FMMASTX   *                                                                 
***************                                                                 
*                                                                               
*   ROUTINE DETERMINES THE MASTER DICTIONARY INDEX FOR A RAD AREA.              
*                                                                               
*   AT ENTRY:     R8   AREA NAME IN EBCDIC (BITS 16-31)                         
*                 R5   LINK                                                     
*                                                                               
*   AT EXIT:      R6   MASTER DICTIONARY INDEX OF AREA                          
*                 R8   MDFLAG FOR THE AREA                                      
*                                                                               
*        BAL,R5   FMMASTX                                                       
*                                                                               
*        EXITS:   LINK    AREA UNDEFINED, UNALLOCATED                           
*                 LINK+1  AREA VALID                                            
*                                                                               
*   REGISTERS CHANGED:   R6, R8                                                 
*                                                                               
FMMASTX  RES      0                                                             
         STH,R8   R8                                                            
         LH,R8    R8                EXTEND SIGN                                 
         LI,R6    SPINDEX-1         SET TO START SCAN WITH SP AREA              
FMMASTX1 AI,R6    1                 STEP TO NEXT AREA                           
         CW,R6    K:NUMDA           HAVE WE TESTED ALL AREA NAMES ?             
         BG       FMX1                YES, NOT FOUND NAME, SO ERROR             
         CH,R8    MDNAME,R6         NO, IS THIS THE AREA WE'RE HUNTING ?        
         BNE      FMMASTX1            NO, TRY NEXT AREA                         
         LB,R8    MDFLAG,R6         YES, IS IT ALLOCATED ?                      
         CI,R8    ALLOC                                                         
         BAZ      FMX1                NO, ERROR                                 
         AI,R5    1                 YES, SET TO RETURN TO FOUND EXIT            
FMX1     RES      0                                                             
         B        RWX22             EXIT VIA R5                                 
         OLAYEND                                                                
         END                                                                    
