         SYSTEM SIG9P                                                           
         SYSTEM   OPTIONS                                                       
*   ENTRY POINTS                                                                
         DEF      CLOSEX                                                        
         DEF      CLOSRFIL,CRFIL                                                
         DEF      CFUPDIR                                                       
         DO1      #DISKPAK                                                      
         DEF      CFDPIDLE                                                      
*   EXIT POINTS                                                                 
         DEF      CLOSE1A,CLOSE1B                                               
         DEF      CLOSE1C,CFUPDX                                                
         DO1      #DISKPAK                                                      
         DEF      CFDPIDX                                                       
         PSYS     0                                                             
OLAYFLAG EQU      'CLOS'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** CLOSEX - CLOSEDCB **'                                     
**************                                                                  
*   CLOSEX   *                                                                  
**************                                                                  
*                                                                               
*   ROUTINE CLOSES A DCB                                                        
*                                                                               
*   AT ENTRY:     R1    FPT CODE                                                
*                 R2    DCB ADDRESS                                             
*                 R3    FPT ADDRESS                                             
*                 R5    LINK                                                    
*                 R8    DCB WORD 0                                              
*                                                                               
CLOSEX   RES      0                                                             
         LW,R7    1,R2              DCB WORD 1                                  
         CI,R8    K2                TEST WORD 0 BIT 30                   0868000
         BAZ      %0203             B IF RAD FILE                        0869000
         BAL,R4   GETDCTX           GET DCT INDEX IN R7                  0870000
         B        CLERR59           ILLEGAL DCT INDEX                           
%0203    AND,R7   M8                EXTRACT DCT INDEX                    0872000
         DISABLE                                                         0874000
         CW,R8    0,R2              DCB WORD 0 CHANGED                   0875000
         BNE      %0201             YES, BRANCH                          0876000
         AND,R8   FFDFEFFF          NO, RESET OPEN & BUSY                0877000
         STW,R8   0,R2              PUT IN DCB WORD 0                    0878000
         CI,R8    K2                TEST WORD 0 BIT 30                   0879000
         BAZ      CLOSRFIL          BRANCH IF ASSIGNED TO A RAD FILE     0880000
         CI,R7    X'80'             IS R7 AN RFT INDEX     /SIG7-2097/*C5732    
         BAZ      %0206             NO                     /SIG7-2097/*C5732    
         AND,R7   X7F               YES                    /SIG7-2097/*C5732    
         B        CLOSRFIL                                                      
%0206    RES      0                                                             
         DO       #SYMB                                                         
         BIFFGD   %0206A            BRANCH IF FGD                               
         LB,R15   DCTSYM1,R7        GET SYMBIONT FLAGS                          
         CI,R15   DCTSYMSM          IS THIS A DEDICATED SYMB DEVICE             
         BANZ     %0202             YES, DON'T GO ANY FARTHER                   
         FIN      #SYMB                                                         
%0206A   RES      0                                                             
         LB,R11   DCTJID,R7         IS IT AN EXCLUSIVE DEVICE                   
         BNEZ     %0207             YES, BRANCH                                 
         MTB,-1   DCTDCB,R7         NO, DECREMENT COUNT                         
         B        %0202             EXIT                                        
%0207    LB,R4    TCBPOINT          TASK ID                                     
         CB,R11   STIJID,R4         DOES JOB ID MATCH                           
         BNE      CLERR5B           NO, CALLER IN WRONG JOB                     
         MTB,-1   DCTDCB,R7         YES, DECREMENT DCB COUNT                    
         BNEZ     %0202             B IF NOT ZERO                               
         LI,R11   X'FF'             SET JOB I.D.= X'FF'                         
         STB,R11  DCTJID,R7                                                     
         DO       #ECB                                                          
*   REMOVE DEVICE FROM ENQUEUE CHAIN                                            
         PUSH     7,R1                                                          
         LI,R11   0                                                             
         LW,R10   R7                DCT INDEX FOR DEVICE TO REMOVE              
         LB,R4    TCBPOINT          TASK ID                                     
         LW,R9    YE                FLAGS FOR TMDEQ                             
         BAL,R8   TMDEQ                                                         
         NOP                                                                    
         PULL     7,R1                                                          
         FIN      #ECB                                                          
%0202    ENABLE                                                          0882000
CLOSE1A  B        1,R5              NORMAL RETURN                               
*                                                                               
*                                                                               
CLERR0A  RES      0                                                             
         LI,R9    KA                DCB ALREADY CLOSED                          
         B        CLOSE1B                                                       
CLERR5B  RES      0                                                             
         ENABLE                                                                 
         LI,R9    K5B               ILLEGAL JOB ID FOR CLOSE                    
         B        CLOSE1B           EXIT                                        
CLERR59  RES      0                                                             
         LI,R9    K59               BAD DCTX, DCB CHANGED                       
CLOSE1B  B        0,R5              ERROR EXIT (+1)                             
*                                                                        0884000
%0201    ENABLE                                                          0885000
CLOSE1C  B        CLOSEDCB                                                      
         PAGE                                                            0887000
****************                                                         0888000
*   CLOSRFIL   *                                                         0889000
****************                                                         0890000
*                                                                        0891000
*   ROUTINE CLOSES A DCB ASSIGNED TO A RAD FILE                          0892000
*                                                                        0893000
*   AT ENTRY:     R1    FPT CODE                                                
*                 R2    DCB ADDRESS                                             
*                 R3    FPT ADDRESS                                             
*                 R5    LINK                                                    
*                 R7    RFT INDEX                                               
*                                                                               
*   ROUTINE EXITS +2 IF NO ERRORS                                               
*                 +1 IF ERROR; R9=ERROR CODE                                    
*                                                                               
*                                                                        0896000
CLOSRFIL RES      0                                                             
         LW,R15   RENT:D            GET ACTIVITY COUNT                          
         ENABLE                                                                 
         LB,R4    TCBPOINT          TASK ID                                     
         LB,R6    STIJID,R4         R6= JOB ID                                  
         CB,R6    RFT9,R7           DOES JOB ID MATCH RFT                       
         BE       CLOSRF3           YES, BRANCH                                 
         MTB,0    RFT9,R7           NO, IS THIS A SYSTEM LEVEL FILE             
         BNEZ     CLERR5B           NO, ILLEGAL JOB ID FOR CLOSE                
         MTB,0    RFT14,R7          DOES ANY JOB HAVE THE FILE OPEN             
         BEZ      CLOSRF3           NO, BRANCH                                  
         CB,R6    RFT14,R7          YES, IS IT THE CALLER'S JOB                 
         BE       CLOSRF3           YES, OK TO CLOSE                            
         MTW,0    RFT17,R7          IS A BB TIED TO THE FILE                    
         BNEZ     CLERR5B           YES, CALLER CANNOT CLOSE                    
CLOSRF3  RES      0                                                             
         LB,R0    RFT13,R7          GET TOTAL OPEN DCB COUNT                    
         AI,R0    -1                DECREMENT                                   
         BLEZ     CLOSRF6           B IF OK TO CONTINUE                         
         DISABLE                                                                
         CW,R15   RENT:D            WERE WE REENTERED                           
         BNE      CLOSRFIL          YES, START OVER                             
         BAL,R8   CFSUBCT           DECREMENT COUNTS AND EXIT                   
         MTW,1    RENT:D            INCREMENT ACTIVITY COUNT                    
         B        %0202             EXIT                                        
*   THE NUMBER OF DCBS OPEN TO THE RAD FILE IS ZERO AND THE FILE                
*   WILL BE CLOSED UNLESS AN OP LABEL IN A   JOB IS ASSIGNED                    
*   TO THE FILE.                                                                
*   R1   FPT CODE                                                               
*   R2   DCB ADDRESS                                                            
*   R3   FPT ADDRESS                                                            
*   R5   LINK                                                                   
*   R7   RFT INDEX                                                              
*   R15  ACTIVITY COUNT FROM RENT:D                                             
CLOSRF6  RES      0                                                             
         BAL,R8   CFCKOPLB          CHECK FOR OPLB ASSIGNED TO FILE             
         B        CLOSRF9           +1..FOUND ONE                               
*                                   +2..NONE, CONTINUE WITH CLOSE               
         PUSH     R5                SAVE LINK                                   
         BAL,R5   CRFIL             UPDATE THE DIRECTORY                        
         B        CLOSRF12          ERROR                                       
         PULL     R5                RESTORE LINK                                
         B        CLOSE1A           TAKE NORMAL EXIT                            
*                                                                               
*                                                                               
CLOSRF9  RES      0                                                             
         BAL,R8   CFCUPBB           CLEANUP BLOCKING BUFFER                     
         B        CLOSE1B           ERROR, R9=TYC                               
         DISABLE                                                                
         CW,R15   RENT:D            WERE WE REENTERED                           
         BNE      CLOSRFIL          YES, START OVER                             
         BAL,R8   CFSUBCT           DECREMENT DCB COUNTS                        
         MTW,1    RENT:D            INCREMENT ACTIVITY COUNT                    
         ENABLE                                                                 
         B        CLOSE1A           EXIT NORMALLY                               
*                                                                               
*                                                                               
*   ERROR PROCESSING                                                            
*                                                                               
*                                                                               
CLOSRF12 RES      0                                                             
         PULL     R5                RESTORE LINK REGISTER                       
         CI,R9    TYCREENT          WERE WE REENTERED                           
         BE       CLOSRFIL          YES, TRY AGAIN                              
         B        CLOSE1B           NO, TAKE ERROR EXIT                         
         TITLE    '** CLOSEX - CRFIL SUBROUTINE **'                             
**************                                                                  
*   CRFIL    *                                                                  
**************                                                                  
*                                                                               
*   SUBROUTINE CLEANS UP THE BLOCKING BUFFER, UPDATES THE                       
*   FILE DIRECTORY, AND RELEASES  THE RFT ENTRY                                 
*                                                                               
*                                                                               
*   AT ENTRY:     R1    FPT CODE                                                
*                 R5    LINK                                                    
*                 R7    RFT INDEX                                               
*                 R15   ACTIVITY COUNT FROM RENT:D                              
*                                                                               
*   EXITS: LINK   IF ERROR; ERROR TYC IN R9                                     
*          LINK+1 IF NO ERROR                                                   
*                                                                               
*                                                                               
CRFIL    RES      0                                                             
         BAL,R8   CFCUPBB           CLEANUP USER BLOCKING BUFFER                
         B        CLOSE1B           IF  ERROR, R9=ERROR CODE                    
*                                   CONTINUE                                    
         PUSH     R5                SAVE LINK                                   
         CB,R7    BT#               IS IT A TEMP FILE ?                         
         BLE      CRFIL5              YES, DO NOT CLEAR RFT ENTRY               
*                                                                               
         BAL,R8   CFUPDIR           GO UPDATE THE DIRECTORY                     
         B        CRFERR6            ERROR, R9=TYC                              
         LD,R10   ZEROS             SET NAME FOR A FREE ENTRY                   
         DISABLE                                                                
         CW,R15   RENT:D            REENTERED                                   
         BNE      CRFERR4           YES, TAKE ERROR EXIT                        
         STD,R10  RFT1,R7           ZERO NAME                                   
         STH,R10  RFTE#,R7          ZERO EXTENT NUMBER                          
         STW,R10  RFT12,R7          ZERO RECORD NUMBER                          
         MTW,1    RENT:D            INCREMENT ACTIVITY COUNT                    
         BIFFGD   CRFIL5            B IF NOT BACKGROUND                         
         MTB,-1   RFT14             DECREMENT NUMBER OF BKG ENTRIES             
CRFIL5   EQU      %                                                             
         DISABLE                                                                
         BAL,R8   CFSUBCT           DECREMENT OPEN DCB COUNTS                   
         ENABLE                                                                 
         DO       #DISKPAK                                                      
         BAL,R8   CFDPIDLE          SEE IF DISK PACK IS 'IDLE'                  
         FIN      #DISKPAK                                                      
         PULL     R5                RECOVER LINK                                
         B        CLOSE1A           RETURN                                      
*                                                                               
*                                                                               
*   ERROR PROCESSING                                                            
*                                                                               
*                                                                               
CRFERR4  RES      0         RENETERED: RETURN WITH THAT CODE FOR RETRY          
         LI,R9    TYCREENT          SET REENETERED TYC CODE                     
*                                                                               
CRFERR6  RES      0                                                             
         PULL     R5                RESTORE LINK REGISTER                       
         B        CLOSE1B           TAKE ERROR EXIT, R9=TYC                     
         TITLE    '** CLOSEX - CFUPDIR SUBROUTINE **'                           
*************                                                                   
*  CFUPDIR  *                                                                   
*************                                                                   
*                                                                               
*   ROUTINE UPDATES THE DIRECTORY ENTRY FOR A PERMANENT                         
*   DISK FILE WHEN APPLICABLE.   IF THE FILE IS EXTENSIBLE, ALL HIGHER          
*   NUMBERED EXTENTS ARE DELETED.   INFORMATION FOR THE                         
*   DIRECTORY UPDATE IS TAKEN FROM THE RFT.                                     
*                                                                               
*   AT ENTRY:                                                                   
*        R1       FPT CODE                                                      
*        R3       FPT ADDRESS IF CALL IS READ,WRITE,OPEN OR CLOSE               
*        R7       RFT INDEX                                                     
*        R8       LINK                                                          
*        R15      REENT COUNT FROM RENT:D                                       
*                                                                               
*   REGISTERS PRESERVED:  R0-R3,R7                                              
*                                                                               
*   ROUTINE EXITS    +2 IF NO ERRORS                                            
*                    +1 IF ERROR WITH TYC IN R9                                 
*                                                                               
*                                                                               
CFUPDIR  RES      0                                                             
         PUSH     R8                SAVE LINK                                   
         DISABLE                                                                
         CB,R7    BT#               IS THIS A BT FILE                           
         BLE      CFUPDIR9          YES, EXIT                                   
         LB,R9    RFT16,R7          GET FLAGS                                   
         CI,R9    SEQWRT+DIRWRT     WAS FILE WRITTEN                            
         BAZ      CFUPDIR9          NO, EXIT                                    
         LD,R12   RFT1,R7           GET FILE NAME                               
         CD,R12   BLANKS            IS ENTRY FOR ENTIRE AREA                    
         BE       CFUPDIR9          YES, NO UPDATE TO DO                        
*   GET RFT PARAMETERS NOW AND SAVE UNTIL UPDATE TIME.                          
         LB,R9    RFT7,R7           GET NEW FLAGS FROM CURRENT USAGE            
         LH,R10   RFT5,R7           RSIZE                                       
         LH,R8    RFT4,R7           GSIZE                                       
         STH,R8   R10               FORM COMBINED 'GSIZE/RSIZE' WORD            
         LW,R11   RFT6,R7           FSIZE                                       
         PUSH     3,R9              SAVE DIRECTORY PARAMETERS                   
         LW,R10   RFT6A,R7          FSIZE (IN SECTORS)                          
         BNEZ     %+2                                                           
         LW,R10   R11               U FORMAT USE FSIZE                          
         PUSH     R10               SAVE LAST DIR PARAM                         
*   SET UP REGISTERS FOR CALLS TO FMDELETE AND FINDDIR                          
         LB,R6    RFT8,R7           SET AREA INDEX                              
         DO1      #DFACNT                                                       
         LD,R10   RFTACNT,R7        GET ACCOUNT NAME FOR DIRE SEARCH            
         LH,R9    RFTE#,R7          AND WHICH EXTENT OF THE FILE                
         ENABLE                                                                 
         LW,R8    RFTESZ,R7         IS THE FILE EXTENSIBLE                      
         BEZ      CFUPDIR5          0 EXTENT SIZE MEANS NO                      
         LB,R8    RFT7,R7           GET RFT FLAGS                               
         CI,R8    DIRACC            IS IT A DIRECT ACCESS FILE                  
         BANZ     CFUPDIR5          YES, DON'T DELETE EXTENTS                   
         PUSH     R9                SAVE CURRENT EXTENT                         
         AI,R9    1                 R9= LOWEST EXT # FOR DELETE                 
         BAL,R8   FMDELETE          DELETE ALL EXTENTS HIGHER THAN CURRENT      
         B        CFUPDE9            ERROR, R9=TYC                              
CFUPDIR3 RES      0                                                             
         PULL     R9                RESTORE CURRENT EXTENT #                    
CFUPDIR5 RES      0                                                             
         PUSH     R7                SAVE RFT INDEX                              
         LI,R7    0                 R7 SET FOR FINDDIR                          
         BAL,R8   FINDDIRX          LOOK NAME UP IN THE DIRECTORY               
         B        CFUPDE3            ERROR, R9=TYC                              
         LI,R12   0                                                             
         LW,R13   K:TIME            R13 = TIME OF DAY IN SEC                    
         DW,R12   XD60              R13 = TIME OF DAY IN MIN                    
         LI,R12   0                                                             
         DW,R12   XD60              R12 = MIN IN HOUR                           
*                                   R13 = HOUR OF DAY                           
         XW,R12   R13                                                           
         SLS,R13  24                                                            
         SLD,R12  8                 R12 = MIN ,HOUR                             
         LW,R13   K:DATE2           R13 = DAY OF YEAR                           
         LI,R7    0                                                             
         LB,R11   K:MONTH,R7                                                    
         SW,R13   R11                                                           
         BLEZ     %+3                                                           
         AI,R7    4                                                             
         B        %-4                                                           
         AW,R13   R11               DAY OF MONTH                                
         STH,R13  R12               R12 = DAY,HOUR,MIN                          
         SLS,R7   -2                                                            
         AI,R7    1                 MONTH (1-12)                                
         STB,R7   R12               R12 = MON,DAY,HOUR,MIN                      
         LW,R13   K:DATE1                                                       
         AI,R13   -80                                                           
         SLS,R13  28                                                            
         AW,R12   R13                                                           
         STW,R12  DIREDATE,R4       R12 = YEAR,MON,DAY,HOUR,MIN                 
*                                            4   4   8    8   8 BITS            
         PULL     R7                RESTORE RFT INDEX                           
*                                                                               
         PULL     R11               RESTORE LAST DIR PARAM                      
         STW,R11  DIREUSEC,R4                                                   
         PULL     3,R11             RESTORE DIRECTORY PARAMS INTO R11-R13       
         LW,R8    DIREFLGS,R4       GET CURRENT DIR FLAG WORD                   
         STB,R11  R8                UPDATE FLAG1 BYTE                           
         STW,R8   DIREFLGS,R4       STORE UPDATED FLAG WORD                     
         STW,R12  DIREGRSZ,R4       STORE NEW GSIZE/RSIZE WORD                  
         STW,R13  DIREFSIZ,R4       STORE NEW FILE SIZE                         
         BAL,R8   WRITDIR           WRITE OUT UPDATED DIRECTORY                 
         B        CFUPDE6           ERROR OF SOME SORT: REPORT IT               
         AI,R15   1                 R15 NOW = RENT:D AS STEPPED BY              
         DISABLE                                                                
         LB,R8    RFT16,R7          GET RFT FLAGS                               
         CW,R13   RFT6,R7           HAS FILE POSITION CHANGED                   
         BNE      CFUPDIR7          YES, CAN'T RESET 'WRITE' BITS               
         AND,R8   X3F               NO, RESET SEQWRT AND DIRWRT                 
         STB,R8   RFT16,R7          STORE UPDATED FLAGS                         
CFUPDIR7 RES      0                                                             
         ENABLE                                                                 
*                                   WRITDIR IF NOT REENTERED                    
         LW,R6    R10               SET ADDRESS OF BBCW                         
         BAL,R11  RELADBUF          AND RELEASE THE DIRECTORY BUFFER            
CFUPDIR9 RES      0                                                             
         ENABLE                                                                 
         PULL     R8                RESTORE LINK                                
         AI,R8    1                 RETURN +2 (NORMAL)                          
CFUPDX   B        *R8               EXIT                                        
         SPACE 3                                                                
*                                                                               
*   PROCESS ERRORS IN  CFUPDIR SUBROUTINE                                       
*                                                                               
CFUPDE3  RES      0                                                             
         PULL     R7                RESTORE RFT INDEX                           
         PULL     R8                CLEANUP STACK                               
         LW,R14   R9                SAVE TYC IN R14                             
         PULL     4,R8                                                          
         LW,R9    R14               R9= TYC                                     
         B        CFUPDX            TAKE ERROR EXIT, R9=TYC                     
*                                                                               
CFUPDE6  RES      0                                                             
         LW,R6    R10               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          RELEASE THE BB                              
         PULL     R8                RESTORE LINK                                
         B        CFUPDX            TAKE ERROR EXIT, R9=TYC                     
*                                                                               
CFUPDE9  RES      0                                                             
         CI,R9    TYC71             IS IT NON-EXISTENT FILE                     
         BE       CFUPDIR3          YES, NOT AN ERROR                           
         LW,R14   R9                NO, SAVE TYC IN R14                         
         PULL     R8                CLEANUP STACK                               
         PULL     5,R8              CLEANUP STACK                               
         LW,R9    R14               R9 CONTAINS TYC                             
         B        CFUPDX            EXIT                                        
         TITLE    '** CLOSEX - CLEANUP BB SUBROUINE **'                         
***************                                                                 
*   CFCUPBB   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   ROUTINE WRITES OUT THE BLOCKING BUFFER ATTACHED TO THE                      
*   FILE (IF ANY) AND RELEASES IT BY CALLING RELADBUF.                          
*                                                                               
*   AT ENTRY:     R7     RFT INDEX                                              
*                 R8     LINK                                                   
*                 R15    DIRECTORY ACTIVITY COUNT                               
*                                                                               
*   ROUTINE EXITS +1 IF ERRORS; R9 CONTAINS ERROR CODE                          
*   ROUTINE EXITS +2 IF NO ERRORS.                                              
*                                                                               
*                                                                               
CFCUPBB  RES      0                                                             
         MTW,0    RFT17,R7          IS THERE A BLK BUFF CONTROL WORD            
         BEZ      CFCUPBB1          NO, EXIT                                    
         PUSH     R15               SAVE REENT COUNT                            
         BAL,R4   WLBLOCK                                  /SIG7-2097/*C5732    
         B        CFCUPBB2          ERROR                                       
         PULL     R15                                                           
CFCUPBB1 RES      0                                                             
         AI,R8    1                 TAKE +2 EXIT                                
         B        *R8                                                           
*                                                                               
CFCUPBB2 RES      0                                                             
         PULL     R15                                                           
         B        *R8               TAKE ERROR EXIT (+1)                        
         TITLE    '** CLOSEX - CFCKOPLB SUBROUTINE **'                          
****************                                                                
*   CFCKOPLB   *                                                                
****************                                                                
*                                                                               
*   SUBROUTINE SEARCHES THE OPLB TABLES OF  ALL ACTIVE JOBS                     
*   TO DETERMINE IF THERE IS AN OPERATIONAL LABEL ASSIGNED                      
*   TO THE FILE.                                                                
*                                                                               
*   AT ENTRY:     R1      FPT CODE                                              
*                 R2      DCB ADDRESS                                           
*                 R3      FPT ADDRESS                                           
*                 R7      RFT INDEX                                             
*                 R8      LINK                                                  
*                 R15     REENTRANCE COUNT                                      
*                                                                               
*                                                                               
*   ROUTINE RETURNS +2 IF NO OPLBS ARE ASSIGNED TO THE FILE.                    
*   ROUTINE RETURNS +1 IF AN OPLB WAS FOUND THAT IS ASSIGNED                    
*                      TO THE FILE.                                             
*                                                                               
*                                                                               
CFCKOPLB RES      0                                                             
         PUSH     R5                SAVE R5                                     
         LB,R5    SJI3              R5= MAXIMUM NO. OF JOBS                     
CFCKOP2  LW,R4    SJI1,R5           GET JCB ADDRESS IN R4                       
         BEZ      CFCKOP8           B IF NOT USED                               
         LH,R6    OPLBS1            R6= # OF OPLBS IN TABLE                     
         LW,R9    JCBOPL2,R4        R9= ADDR OF OPLBS2 TABLE FOR JOB            
         LW,R0    R7                RFT INDEX                                   
         OR,R0    X80                                                           
CFCKOP4  CB,R0    *R9,R6            DOES RFT INDEX MATCH                        
         BNE      CFCKOP6           B IF NOT EQUAL                              
         PULL     R5                RESTORE R5                                  
         B        *R8               EXIT+1                                      
CFCKOP6  BDR,R6   CFCKOP4           NO, LOOP                                    
CFCKOP8  BDR,R5   CFCKOP2           TEST NEXT OPLB TABLE                        
         PULL     R5                DONE, RESTORE R5                            
         AI,R8    1                                                             
         B        *R8               TAKE +2 EXIT                                
         TITLE    '** CLOSEX - SFSUBCT SUBROUTINE **'                           
***************                                                                 
*   CFSUBCT   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   SUBROUTINE DECREMENTS THE APPROPRIATE OPEN DCB COUNTS                       
*                                                                               
*   AT ENTRY:     R1      FPT CODE                                              
*                 R2      DCB ADDRESS                                           
*                 R3      FPT ADDRESS                                           
*                 R6      JOB ID                                                
*                 R7      RFT INDEX                                             
*                 R8      LINK                                                  
*                 R15     REENTRANCE COUNT                                      
*                                                                               
*   ROUTINE ALWAYS RETURNS +1                                                   
*                                                                               
*                                                                               
CFSUBCT  RES      0                                                             
         MTB,0    RFT13,R7          CHECK OPEN DCB COUNT                        
         BEZ      *R8               EXIT                                        
         BIFFGD   CFSUBCT2          B IF FGD                                    
         MTB,-1   RFT15,R7          DECREMENT BACKGROUND DCB COUNT              
CFSUBCT2 RES      0                                                             
         LB,R4    TCBPOINT          TASK ID                                     
         LB,R4    STILMID,R4        LM ID                                       
         LW,R4    LMIRFT,R4         ADDR OF FILE ACTIVITY TABLE                 
         BEZ      %+2               B IF IT DOESN'T EXIST                       
         MTB,-1   *R4,R7            DECREMENT COUNT FOR THIS FILE               
         MTB,-1   RFT13,R7          DECREMENT TOTAL USERS                       
         B        *R8               EXIT                                        
         TITLE    '** CLOSEX - CFDPIDLE SUBROUTINE **'                          
****************                                                                
*   CFDPIDLE   *                                                                
****************                                                                
*                                                                               
*                                                                               
*   IF THE FILE BEING CLOSED IS ON A DISK PACK SCHEDULED FOR                    
*   REMOVAL, THIS SUBROUTINE LOOKS FOR FILES THAT ARE OPEN ON                   
*   THE DISK PACK. IF NONE ARE FOUND THE MESSAGE 'DPNDD IDLE'                   
*   IS OUTPUT TO THE OC DEVICE.                                                 
*                                                                               
*   AT ENTRY:     R7    RFT INDEX                                               
*                 R7 = 0 MEANS R2 = AREA INDEX                                  
*                 R8    LINK                                                    
*                                                                               
*   ROUTINE ALWAYS RETURNS TO LINK                                              
*                                                                               
*   ROUTINE PRESERVES ALL REGISTERS                                             
*                                                                               
*   ROUTINE HAS LONG INHIBIT TIME                                               
*   ASSUMES ONE WILL NOT MOUNT/DISMOUNT PACKS AT CRITCAL TIMES                  
*                                                                               
         DO       #DISKPAK                                                      
CFDPIDLE RES      0                                                             
         PUSH     16,R0                                                         
         CI,R7    0                                                             
         BE       %+2               B IF AN AREA INDEX WAS SENT                 
         LB,R2    RFT8,R7           GET AREA'S INDEX AND USE TO                 
         LB,R1    MDDCTI,R2         GET DCT INDEX                               
         LD,R4    DCT16,R1          GET DEVICE NAME                             
         SLD,R4   8                                                             
         AND,R4   XFFFF             EXTRACT YY                                  
         CI,R4    'DP'              IS IT A DISKPACK                            
         BNE      CFDP9              BRANCH IF NOT                              
         DISABLE                                                                
         LB,R3    DCTRBM,R1         CHECK REPLACE FLAG                          
         CI,R3    K2                                                            
         BAZ      CFDP9               BRANCH IF NOT SET                         
         LH,R7    RFT#              R7= NUMBER OF RFT TABLE ENTRIES             
*                                                                               
CFDP3    RES      0         LOOK AT ALL RFT ENTRIES FOR DCT INDEX = R1          
         LD,R3    RFT1,R7           IS THE ENTRY IN USE ?                       
         BEZ      CFDP6               NO, SKIP IT                               
         LB,R3    RFT8,R7           GET AREA INDEX                              
         LB,R3    MDDCTI,R3         TO GET DCT INDEX                            
         CW,R3    R1                CHECK FOR SAME DEVICE                       
         BE       CFDP9              BRANCH IF IT IS                            
CFDP6    BDR,R7   CFDP3              NEXT RF ENTRY                              
*        DISC IS IDLE (I.E., IT HAS NO OPEN FILES)                              
         DO       #PRIV                                                         
         LC       MDFLAG,R2         GET AREA FLAGS                              
         BCR,USERACC  CFDP8         B IF NOT A PRIVATE PACK                     
         LW,R2   K:NUMDA                                                        
         LI,R10   0                                                             
         LI,R11   USERA                                                         
CFDP7    RES      0                                                             
         CB,R1    MDDCTI,R2                                                     
         BNE      CFDP7B            B IF AREA NOT ON THIS DISC                  
         STB,R11  MDFLAG,R2         RESET AREAS MD ENTRIES                      
         STB,R10  MDDCTI,R2                                                     
         STH,R10  MDNAME,R2                                                     
         STB,R10  MDDISCI,R2                                                    
         STW,R10  MDBOA,R2                                                      
         STW,R10  MDEOA,R2                                                      
         STD,R10  MDVSN,R2                                                      
CFDP7B   BDR,R2   CFDP7             CHECK NEXT AREA IN MD                       
CFDP8    RES      0                                                             
         FIN      #PRIV                                                         
         ENABLE                                                                 
         LI,R13   MSG6              R1=DCTX FOR MESG                            
         BAL,R5   MSGOUT              'DPYDD IDLE'                              
CFDP9    PULL     16,R0             ALL CLOSED -                                
         ENABLE                                                                 
CFDPIDX  B        *R8                                                           
         FIN      #DISKPAK                                                      
         OLAYEND                                                                
         END                                                                    
