         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      DELETE                                                        
         DEF      FMDELETE                                                      
         DEF      TRUNCATE                                                      
         DEF      DELEXIT,DELTRAPX                                              
         DEF      FMDELX1                                                       
         PSYS     0                                                             
OLAYFLAG EQU      'DELE'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    'DELETE CALL ROUTINE'                                         
**************                                                                  
*   DELETE   *                                                                  
**************                                                                  
*                                                                               
*   ROUTINE DELETES AN ENTRY FROM A PERMANENT FILE DIRECTORY BY                 
*    ZEROING OUT ALL WORDS EXCEPT THE BOT AND EOT PARAMETERS.                   
*                                                                               
*   AT ENTRY:     R1   FPT CODE                                                 
*                 R3   FPT ADDRESS                                              
*                 R4   STI INDEX                                                
*                                                                               
*                                                                               
DELETE   RES      0                                                             
         LW,R8    0,R3                                                          
         CW,R8    Y008              IS P0 BIT SET                               
         BAZ      DELTRAPX          NO, BAD CAL                                 
         AND,R8   M16               R8= AREA NAME                               
         BNEZ     DELETE0A          GIVEN: TEST IF VALID (ALLOTED)              
*                                                                               
         LI,R6    -1                NO AREA: USE A PUBLIC AREA                  
         B        DELETE0B                                                      
*                                                                               
DELETE0A RES      0         TEST IF NAMED AREA DEFINED                          
         BAL,R5   FMMASTX           GET AREA INDEX IN R6                        
         B        DELER70             NAME NOT DEFINED: GIVE ERROR 70           
*                                                                               
*                           TEST IF OK TO DELETE IN NAMED AREA                  
         CLM,R6   CKXABT            IS AREA CK, XA, OR BT ?                     
         BCR,6    DELER70           YES, NOT LEGAL                              
*                                                                               
         BAL,R5   FMCKWP            CHECK FOR WRT PROT VIOLATION                
         B        DELER42           ERROR                                       
*   GET FILE NAME                                                               
DELETE0B RES      0                                                             
         LI,R15   K3                                                            
         BAL,R5   GETFPTN           GET 1ST WORD OF FILE NAME                   
         B        DELER71           NOT PRESENT                                 
         LW,R12   R15               R12= 1ST WORD OF FILE NAME                  
         LI,R15   K4                                                            
         BAL,R5   GETFPTN           GET 2ND WORD OF FILE NAME                   
         LW,R15   BLANKS            SET DEFAULT 2ND HALF IF NOT GIVEN           
         LW,R13   R15               FINISH FORMING FILENAME                     
*                                                                               
        DO       #DFACNT         IF ACCOUNT NAMES IN USE...                     
         LI,R15   KE                GET ACCOUNT NAME IF GIVEN                   
         BAL,R5   GETPII            IN THE FPT                                  
         B        DELETE1             NOT GIVEN: USE DEFAULT                    
*                                                                               
         LCI      2                 GET THE GIVEN ACCOUNT NAME                  
         LM,R10   *R14              FROM THE 2 WORD DATA PACKET                 
         CD,R10   ZEROS             DOES IT SPECIFY THE DEFAULTED               
         BE       DELETE2           SYSTEM ACCOUNT ?     YES, GET IT            
*                                                                               
         CD,R10   BLANKS            IN EITHER DEFAULT FORMAT...                 
         BE       DELETE2                                                       
*                                                                               
         B        DELETE3           STORE NAME IN TSPACE BLOCK                  
*                                                                               
DELETE1  RES      0         GET DEFAULT ACCOUNT NAME                            
         CI,R6    -1                WAS AREA NAME SPECIFIED                     
         BNE      DELETE2             IF GIVEN, DEFAULT = #SYSACNT              
*                                   IF NOT, DEFAULT = JOB'S ACCOUNT             
         LB,R5    STIJID,R4         NO AREA GIVEN: GET THE JOB'S                
         LW,R5    SJI1,R5           ACCOUNT FROM ITS JCB ACCOUNT ANME           
         LCI      2                                                             
         LM,R10   JCBACCNT,R5                                                   
         B        DELETE3           AND STORE IN TSPACE BLOCK                   
*                                                                               
DELETE2  RES      0         DEFAULT ACCOUNT = #SYSACNT: GET IT                  
         LD,R10   SYSACNT                                                       
*                                                                               
*                                                                               
DELETE3  RES      0         USE GIVEN OR DEFAULTED ACCOUNT NAME                 
        FIN      #DFACNT                                                        
*                                                                               
         LW,R15   RENT:D            GET REENTRANCE COUNT                        
         BAL,R5   FMFINDF           TEST IF FILE IS IN RFT TABLES               
         CI,R7    0                 IS THE FILE OPEN                            
         BG       DELER60            YES, ERROR                                 
         LI,R9    0                 EXTENT # TO START DELETING WITH             
*                                                                               
*   WE ARE READY TO DELETE THE FILE.  REGISTERS CONTAIN:                        
*        R1       FPT CODE                                                      
*        R3       FPT ADDRESS                                                   
*        R6       AREA INDEX                                                    
*        R9       EXTENT NUMBER                                                 
*        R10,R11  ACCOUNT NAME                                                  
*        R12,R13  FILE NAME                                                     
*        R15      REENTRANCE COUNT FROM RENT:D                                  
*                                                                               
         BAL,R8   FMDELETE          DELETE FILE+ ALL EXTENTS                    
         B        DELERR            ERROR, R9= TYC                              
         LI,R15   TYCNORM           POST NORMAL TYC                             
*                                                                               
DELEX2   RES      0         COMMON EXIT FOR OK AND ERRORS                       
         LW,R2    R3                SET FPT ADDRESS FOR POSTING RESULTS         
*                                                                               
DELEXIT  B        TMX1              GO TMSETERR, TMTYC15, ETC                   
         SPACE 3                                                                
*                                                                               
*   PROCESS ERRORS IN DELETE CALL                                               
*                                                                               
*                                                                               
DELTRAPX B        TRAPX             'BAD CAL' EXIT                              
*                                                                               
*                                                                               
DELERR   RES      0         ERROR FINDING AND READING DIRECTORY ENTRY           
         CI,R9    TYCREENT          WAS ERROR DUE TO REENTRY ?                  
         BE       DELETE              YES, RETURN TO START                      
         LW,R15   R9                MOVE ERROR TYC FOR POSTING                  
         B        DELEX2            EXIT                                        
*                                                                               
DELER42  RES      0                                                             
         LI,R15   KA                TYC FOR WRT PROT ERROR                      
         B        DELEX2                                                        
*                                                                               
DELER60  RES      0                                                             
         LI,R15   K60               ERROR, FILE IS OPEN                         
         B        DELEX2                                                        
*                                                                               
DELER70  RES      0                                                             
         LI,R15   K70               INVALID AREA NAME                           
         B        DELEX2                                                        
*                                                                               
DELER71  RES      0                                                             
         LI,R15   K71               INVALID FILE NAME                           
         B        DELEX2                                                        
         TITLE    'FMDELETE SUBROUTINE'                                         
**************                                                                  
*  FMDELETE  *                                                                  
**************                                                                  
*                                                                               
*   SUBROUTINE DELETES FILE ENTRIES IN A PERMANENT DISK AREA.                   
*   THE SPECIFIED EXTENT AND ALL THOSE NUMERICALLY HIGHER                       
*   ARE DELETED.   THE NUMERICALLY HIGHEST EXTENT IS                            
*   DELETED FIRST AND SUCCESSIVELY LOWER NUMBERED EXTENTS                       
*   ARE DELETED UNTIL THE SPECIFIED EXTENT NUMBER HAS BEEN                      
*   DELETED.  THIS METHOD IS USED TO PREVENT FILE INCONSISTENCYS.               
*                                                                               
*   AT ENTRY:                                                                   
*        R1       FPT CODE                                                      
*        R6       AREA INDEX                                                    
*        R8       LINK                                                          
*        R9       LOWEST NUMBERED EXTENT TO DELETE                              
*        R10,R11  ACCOUNT NAME                                                  
*        R12,R13  FILE NAME                                                     
*        R15      REENTRANCE COUNT FROM RENT:D                                  
*                                                                               
*   ROUTINE EXITS +1 IF ERROR                                                   
*   ROUTINE EXITS +2 IF NO ERRORS                                               
*                                                                               
*   REGISTERS DESTROYED:  R8, R14 AND R9=TYC IF ERROR                           
*   BLOCKING BUFFER IS RELEASED AT EXIT                                         
*                                                                               
FMDELETE RES      0                                                             
         PUSH     7,R2              SAVE R2-R8                                  
         LW,R2    R9                R2= STARTING EXTENT #                       
         LI,R7    0                 SET R7=0 FOR FINDDIRX                       
FMDEL3   RES      0                                                             
         PUSH     3,R9              SAVE EXT#, ACCOUNT NAME                     
         BAL,R8   FINDDIRX          SEE IF EXTENT EXISTS                        
         B        FMDEL6             ERROR, R9=TYC                              
*                                                                               
         LW,R8    DIREESIZ,R4       GET EXTENT SIZE                             
         BEZ      FMDEL12           0 MEANS FILE NOT EXTENSIBLE                 
         PUSH     R6                SAVE AREA INDEX                             
         LW,R6    R10               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          RELEASE THE BLOCKING BUFFER                 
         PULL     R6                RESTORE AREA INDEX                          
         PULL     3,R9                                                          
         AI,R9    1                 INCRMENT EXTENT NUMBER                      
         B        FMDEL3            SEE IF IT EXISTS                            
*                                                                               
FMDEL6   RES      0                                                             
         CI,R9    TYC03             IS IT NON-EXISTENT FILE                     
         BNE      FMDELE3           NO, PROCESS ERROR EXIT                      
         PULL     3,R9              YES, RESTORE R9-R11                         
         CW,R9    R2                IS IT THE INITIAL EXTENT                    
         BE       FMDELE6           YES, RETURN ERROR X'71'                     
*   NOW WE HAVE DETERMINED THE HIGHEST NUMBERED EXTENT                          
*   THAT EXISTS.  START DELETING EXTENTS IN DESCENDING ORDER                    
*   UNTIL THE INITIAL EXTENT IS DELETED                                         
FMDEL9   RES      0                                                             
         AI,R9    -1                DECREMENT EXTENT NUMBER                     
         PUSH     3,R9                                                          
         BAL,R8   FINDDIRX          LOCATE THE ENTRY                            
         B        FMDELE3            ERROR, R9=TYC                              
*   THE ENTRY HAS BEEN FOUND.  CLEAR THE FILE NAME AND WRITE                    
*   THE MODIFIED DIRECTORY SECTOR TO THE DISK.                                  
FMDEL12  RES      0                                                             
         LI,R8    0                                                             
         STW,R8   DIRENAM1,R4       ZERO FILE NAME                              
         STW,R8   DIRENAM2,R4                                                   
         BAL,R8   WRITDIR           WRITE MODIFIED DIR SECTOR                   
         B        FMDELE1            ERROR, R9=TYC                              
         AI,R15   1                 BALANCE  REENTRANCE COUNT                   
         PUSH     R6                SAVE AREA INDEX                             
         LW,R6    R10               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          RELEASE THE BLOCKING BUFFER                 
         PULL     R6                R6= AREA INDEX                              
         PULL     3,R9                                                          
         CW,R9    R2                IS THE INITIAL EXTENT DELETED               
         BG       FMDEL9            NO, CONTINUE                                
         PULL     7,R2              CLEANUP STACK                               
         AI,R8    1                 INCRMENT LINK FOR NORMAL EXIT               
FMDELX1  B        *R8               EXIT                                        
         SPACE 3                                                                
*                                                                               
*   ERROR PROCESSING FOR FMDELETE SUBROUTINE                                    
*                                                                               
FMDELE1  RES      0                                                             
         LW,R6    R10               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          RELEASE THE BLOCKING BUFFER                 
FMDELE3  RES      0                                                             
         DISABLE                                                                
         STW,R9   TEMP              SAVE TYC                                    
         PULL     10,R2             CLEANUP STACK                               
         LW,R9    TEMP              R9= TYC                                     
         ENABLE                                                                 
         B        FMDELX1           EXIT                                        
*                                                                               
FMDELE6  RES      0                                                             
         PULL     7,R2              ILLEGAL FILE NAME                           
         LI,R9    TYC71                                                         
         B        FMDELX1           EXIT                                        
         TITLE    'TRUNCATE CALL ROUTINE'                                       
****************                                                                
*   TRUNCATE   *                                                                
****************                                                                
*                                                                               
*   ROUTINE TRUNCATES EMPTY SPACE FROM A FILE IN A PERMANENT RAD AREA           
*    BY SETTING THE ALLOCATED SPACE EQUAL TO THE ACTUAL LENGTH OF               
*    THE FILE.                                                                  
*                                                                               
*   AT ENTRY:     R1   FPT CODE                                                 
*                 R3   FPT ADDRESS                                              
*                 R4   STI INDEX                                                
*                                                                               
*                                                                               
TRUNCATE RES      0                                                             
         LW,R8    0,R3              GET AREA NAME                               
         CW,R8    Y008              IS P0 BIT SET                               
         BAZ      DELTRAPX          NO, BAD CAL                                 
         AND,R8   M16               R8= AREA NAME                               
         BNEZ     TRUNC0A           GIVEN: TEST IF VALID (ALLOTED)              
*                                                                               
         LI,R6    -1                NO AREA: USE A PUBLIC AREA                  
         B        TRUNC0B                                                       
*                                                                               
TRUNC0A  RES      0         TEST IF NAMED AREA DEFINED                          
         BAL,R5   FMMASTX           GET AREA INDEX IN R6                        
         B        TRUER70             NAME NOT DEFINED: GIVE ERROR 70           
*                                                                               
*                           TEST IF OK TO DELETE IN NAMED AREA                  
         CLM,R6   CKXABT            IS AREA CK, XA, OR BT ?                     
         BCR,6    TRUER70           YES, NOT VALID AREA NAME                    
*                                                                               
         BAL,R5   FMCKWP            CHECK FOR WRT PROT VIOLATION                
         B        TRUER42           ERROR                                       
TRUNC0B  RES      0                                                             
*   GET FILE NAME                                                               
         LI,R15   K3                                                            
         BAL,R5   GETFPTN           GET 1ST WORD OF FILE NAME                   
         B        TRUER71           NOT PRESENT                                 
         LW,R12   R15               R12= 1ST WORD OF FILE NAME                  
         LI,R15   K4                                                            
         BAL,R5   GETFPTN           GET 2ND HALF OF NAME, IF PRESENT.           
         LW,R15   BLANKS              NOT; SPACE FILLL                          
         LW,R13   R15               FORM REST OF FILENAME                       
*                                                                               
        DO       #DFACNT         IF ACCOUNT NAMES IN USE...                     
         LI,R15   KE                GET ACCOUNT NAME IF GIVEN                   
         BAL,R5   GETPII            IN THE FPT                                  
         B        TRUNC1              NOT GIVEN: USE DEFAULT                    
*                                                                               
         LCI      2                 GET THE GIVEN ACCOUNT NAME                  
         LM,R10   *R14              FROM THE 2 WORD DATA PACKET                 
         CD,R10   ZEROS             DOES IT SPECIFY THE DEFAULTED               
         BE       TRUNC2            SYSTEM ACCOUNT ?     YES, GET IT            
*                                                                               
         CD,R10   BLANKS            IN EITHER DEFAULT FORMAT...                 
         BE       TRUNC2                                                        
*                                                                               
         B        TRUNC3            STORE NAME IN TSPACE BLOCK                  
*                                                                               
TRUNC1   RES      0         GET DEFAULT ACCOUNT NAME                            
         CI,R6    -1                WAS AN AREA NAME SPECIFIED ?                
         BNE      TRUNC2              IF GIVEN, DEFAULT = #SYSACNT              
*                                   IF NOT, DEFAULT = JOB'S ACCOUNT             
         LB,R5    STIJID,R4         NO AREA GIVEN: GET THE JOB'S                
         LW,R5    SJI1,R5           ACCOUNT FROM ITS JCB ACCOUNT NAME           
         LCI      2                                                             
         LM,R10   JCBACCNT,R5                                                   
         B        TRUNC3            AND STORE IN TSPACE BLOCK                   
*                                                                               
TRUNC2   RES      0         DEFAULT ACCOUNT = #SYSACNT: GET IT                  
         LD,R10   SYSACNT                                                       
*                                                                               
*                                                                               
TRUNC3   RES      0         USE GIVEN OR DEFAULTED ACCOUNT NAME                 
        FIN      #DFACNT                                                        
*                                                                               
*   MAKE SURE THE FILE BEING TRUNCATED IS NOT OPEN                              
         LW,R15   RENT:D            GET DIRECTORY ACTIVITY COUNT                
         BAL,R5   FMFINDF           TEST IF FILE IS IN RFT TABLES               
         CI,R7    0                 DO WE HAVE A VALID RFT INDEX ?              
         BG       TRUER60             YES, OPEN: CANNOT TRUNCATE: ERROR         
         LI,R9    0                 1ST EXTENT TO LOOK FOR IS 0                 
*                                                                               
*   READY NOW TO BEGIN SEARCH FOR THE LAST EXTENT IN THE FILE.                  
*   REGISTERS CONTAIN:                                                          
*        R1       FPT CODE (NEEDED FOR FINDDIR)                                 
*        R3       FPT ADDRESS                                                   
*        R6       AREA INDEX                                                    
*        R7       0 FOR FINDDIRX                                                
*        R9       EXTENT NUMBER (ALWAYS ZERO INITIALLY)                         
*        R10,R11  ACCOUNT NAME                                                  
*        R12,R13  FILE NAME                                                     
*        R15      REENTRANCE COUNT                                              
*                                                                               
TRUNC6   RES      0                                                             
         PUSH     3,R9                                                          
         BAL,R8   FINDDIRX          LOOK FOR 1ST/NEXT EXTENT                    
         B        TRUNC9            ERROR, R9=TYC                               
         LW,R8    DIREESIZ,R4       GET EXTENT SIZE                             
         BEZ      TRUNC12           0 MEANS FILE NOT EXTENSIBLE                 
         PUSH     R6                SAVE AREA INDEX                             
         LW,R6    R10               R6=BBCW ADDRESS                             
         BAL,R11  RELADBUF          RELEASE THE BLOCKING BUFFER                 
         PULL     R6                R6= AREA INDEX                              
         PULL     3,R9                                                          
         AI,R9    1                 INCREMENT EXTENT NUMBER                     
         B        TRUNC6            FIND NEXT EXTENT                            
*                                                                               
TRUNC9   RES      0                                                             
         CI,R9    TYC03             IS IT A NON-EXISTENT FILE                   
         BNE      TRUERR9            NO, PROCESS ERROR                          
         PULL     3,R9              YES, WE HAVE FOUND THE HIGHEST              
*                                    NUMBERED EXTENT (+1)                       
         CI,R9    0                 IS IT THE FIRST EXTENT IN FILE              
         BLE      TRUER71           YES, FILE DOESN'T EXIST                     
         AI,R9    -1                R9= LAST EXTENT IN FILE                     
         BAL,R8   FINDDIRX          GET THE DIR SECT FOR LAST EXTENT            
         B        TRUERR1           ERROR, R9=TYC                               
         B        TRUNC15           B TO TRUNCATE THE LAST EXTENT               
         PAGE                                                                   
*                                                                               
*        THE DIRECTORY ENTRY FOR THE LAST EXTENT OF THE FILE                    
*        THOSE MARKED + WERE SET BY FINDDIR. (DESCRIPTIONS IN PAREN-            
*        THESES SHOW HOW THEY WILL BE USED IN THE CODE FOLLOWING.)              
*                                                                               
*        R0       (SAVED ADDRESS OF THE DIRECTORY SECTOR, FROM R14)             
*        R1       FPT CODE                                                      
*        R2       (NUMBER OF RECORDS IN A COMPRESSED FILE)                      
*        R3       FPT ADDRESS                                                   
*        R4     + ADDRESS OF DIRECTORY ENTRY IN CORE (IN BLOCKING BUFR)         
*        R5       (TEMPS, LINKS, ETC)                                           
*        R6       AREA INDEX                                                    
*        R7       ---- UNUSED ----                                              
*        R8       (TEMPS, LINKS)                                                
*        R9       (RETURNED TYC ON ERRORS IN SUBROUTINES)                       
*        R10    + ADDRESS OF THE BLOCKING BUFFER CONTROL WORD - BBCW            
*        R11      (TEMPS)                                                       
*        R12      ---- UNUSED ----                                              
*        R13      (SAVED COPY OF R15, REENTRANCE COUNT FROM RENT:D)             
*        R14    + SECTOR ADDRESS OF DIRECTORY SECTOR;                           
*                 (ADDRESS OF SECTOR TO READ FOR COMPRESSED FILES;              
*                  TEMP FOR OTHER FILE TYPES)                                   
*        R15      REENTRANCE COUNT FROM RENT:D;                                 
*                 (PARAM TO AND FROM SECTPERN; TEMP)                            
*                                                                               
*                                                                               
TRUNC12  RES      0         TRUNCATE THE LAST (ONLY) EXTENT OF A FILE           
         PULL     3,R11             POP STACK; VALUES NOT NEEDED NOW            
TRUNC15  RES      0                                                             
         LW,R13   R15               SAVE RENT:D                                 
         LW,R0    R14               SAVE ADDRESS OF DIRECTORY SECTOR            
*                                                                               
         LW,R15   DIREFSIZ,R4       ARE THERE ANY RECORDS IN THE FILE ?         
         BEZ      TRUNC45             NO, DONE; SET TYC = NORMAL                
*                                                                               
         LW,R15   DIREFLGS,R4       GET ORGANIZATION FLAGS                      
         LB,R15   R15               FROM THE FILE'S ENTRY                       
         AND,R15  ORGMASK           EXTRACT ORGANIZATION BITS                   
         BEZ      TRUNC36             ZERO, ORG IS UNBLOCKED                    
*                                                                               
        DO       #CFILES            TEST BLOCKED OR COMPRESSED ORG              
         CI,R15   BLKORG            IS FILE BLOCKED ?                           
         BE       TRUNC33             YES,                                      
*                                                                               
*                                                                               
************************************                                            
*                                                                               
*        COMPRESSED FORMAT FILE                                                 
*                                                                               
*                 SCAN THE FILE IN A 'PREC' MODE TO FIND THE SECTOR             
*                 CONTAINING THE LAST RECORD. THIS BECOMES THE NEW              
*                 LAST SECTOR.                                                  
*                                                                               
         LI,R15   1024              SET NUMBER OF BYTES/BLOCK AND THEN          
         BAL,R8   SECTPERN          NUMBER OF SECTORS PER BLOCK IN R15          
         LW,R9    R15               AND SAVE FOR STEPPING THRU FILE             
         LW,R14   DIREBOT,R4        SET START SECTOR TO READ                    
         LW,R2    DIREFSIZ,R4       GET # RECORDS TO SKIP OVER                  
*                                                                               
TRUNC18  RES      0         READ NEXT BLOCK OF FILE                             
         LW,R15   R13               SET REENTRANCE COUNT FOR READ               
         BAL,R8   READBLK           READ IN A BLOCK OF THE FILE                 
         B        TRUERR6           ERROR, R9=TYC                               
         LW,R8    *R10              SET ADDRESS OF THE BUFFER                   
         LI,R5    0                 INIT INDEX TO NEXT BYTE IN REC              
*                                                                               
TRUNC21  RES      0         SCAN OVER NEXT COMPRESSED RECORD                    
         LB,R11   *R8,R5            GET NEXT BYTE OF RECORD                     
         AI,R5    1                 STEP TO NEXT BYTE                           
         CI,R11   CBFCODE           IS IT 'DATA FOLLOWS' FLAG                   
         BNE      TRUNC24             NO, TEST FOR OTHER CODES                  
         AI,R5    1                 YES, INCR PAST DATA BYTE                    
         B        TRUNC21           GET NEXT BYTE                               
*                                                                               
TRUNC24  RES      0         PROCESS 'BLANK SUPRESSION' CODE                     
         CI,R11   BLFLAG            IS IT 'BLANK SUPRESSION' FLAG               
         BNE      TRUNC27             NO, TEST FOR OTHER CODES                  
         AI,R5    1                 YES, INCREMENT PAST 'COUNT'                 
         B        TRUNC21           GET NEXT BYTE                               
*                                                                               
TRUNC27  RES      0         PROCESS 'END OF BLOCK' CODE                         
         CI,R11   EOBCODE           IS IT 'END OF BLOCK' ?                      
         BNE      TRUNC30             NO, TEST FOR 'END RECORD' CODE            
         AW,R14   R9                STEP TO SECTOR # OF NEXT BLOCK              
         B        TRUNC18           READ AND PROCESS NEXT BLOCK                 
*                                                                               
TRUNC30  RES      0         PROCESS 'END OF RECORD' CODE                        
         CI,R11   EORCODE           IS IT 'END OF RECORD' ?                     
         BNE      TRUNC21             NO, SKIP IT AND TEST NEXT BYTE            
         BDR,R2   TRUNC21           YES, GET NEXT RECORD IF NOT AT LAST         
*                                                                               
         AW,R9    R14               LAST RECORD FOUND: SET EOT+1                
         LW,R14   R0                POINT AT SECTOR CONTAINING DIRE             
         LW,R15   R13               RESET REENTRANCE COUNT FOR READ             
         BAL,R8   READDIR           RE-READ THE DIRECTORY SECTOR                
         B        TRUERR6           ERROR, R9=TYC                               
         LW,R14   R9                COPY NEW EOT+1                              
         B        TRUNC42           GO STORE IT IN DIRECTORY                    
        FIN      #CFILES                                                        
*                                                                               
*                                                                               
************************************                                            
*                                                                               
*        BLOCKED FILE FORMAT                                                    
*                                                                               
TRUNC33  RES      0                                                             
         LW,R11   DIREGRSZ,R4       GET FILE'S GSIZE/RSIZE VALUES               
         AND,R11  M16               R11= RECORD SIZE IN BYTES                   
         SLS,R11  -2                CONVERT TO WORDS                            
         LI,R5    K100              R5= NO OF WORDS PER BLOCK                   
         DW,R5    R11               R5= NO OF RECORDS PER BLOCK                 
         LW,R11   DIREFSIZ,R4       GET FILE SIZE (NUMBER OF RECORDS)           
         PUSH     R10               SAVE BBCW ADDR FOR A BIT                    
         LI,R10   0                                                             
         DW,R10   R5                R11= FSIZE/RECORDS PER BLOCK                
         CI,R10   0                 IS THERE A REMAINDER                        
         BE       %+2               NO                                          
         AI,R11   1                 R11= NUMBER OF BLOCKS                       
         PULL     R10               RECOVER BBCW ADDRESS FOR WRITE              
         LI,R15   1024              NO OF BYTES PER BLOCK                       
         BAL,R8   SECTPERN          GET NUMBER OF SECTOR PER BLOCK, R15         
         MW,R11   R15               R11= NUMBER OF SECTORS                      
         B        TRUNC39           GO COMPUTE NEW EOT SECTOR                   
*                                                                               
************************************                                            
*                                                                               
*        UNBLOCKED FILE FORMAT                                                  
*                                                                               
*                                                                               
TRUNC36  RES      0                                                             
         LW,R15   DIREGRSZ,R4       GET RECORD SIZE FOR FILE                    
         AND,R15  M16                                                           
         BAL,R8   SECTPERN          GET NUMBER OF SECTOR PER BLOCK, R15         
         LW,R11   DIREFSIZ,R4       GET NUMBER OF RECORDS (BLOCKS), THEN        
         MW,R11   R15               NUMBER OF SECTORS NEEDED FOR THEM           
*                                                                               
TRUNC39  RES      0         SET NEW EOT+1 FOR BLOCKED, UNBLOCKED FILES          
         LW,R14   DIREBOT,R4        GET FILE'S START SECTOR                     
         AW,R14   R11               ADD NUMBER OF SECTORS USED                  
*                                                                               
TRUNC42  RES      0         UPDATE EOT ENTRY IF FILE SHORTENS                   
         AI,R14   -1                R14= NEW EOT FOR FILE                       
*        THE NEXT TWO INSTRUCTIONS ARE A DIRTY SOLUTION TO                      
*        TO CONVERT PRE-H00 DIRECTORIES TO H00 FORMAT                           
*        THIS WORKS IN CONJUNCTION WITH RADEDIT SQUEEZE.                        
         SPACE                                                                  
         LW,R8    DIREUSEC,R4                                                   
         BEZ      TRUNC42A          CONVERTING - SET USEC ONLY                  
**       END OF FIX                                                             
         SPACE                                                                  
         CW,R14   DIREEOT,R4        IS NEW EOT < OLD EOT ?                      
         BGE      TRUNC45             NO, DON'T UPDATE: POST TYC = NORMAL       
*                                                                               
         STW,R14  DIREEOT,R4        YES, SET NEW, TRUNCATED, EOT                
TRUNC42A RES      0                                                             
         SW,R14   DIREBOT,R4        CAL FSIZE IN SECTORS                        
         AI,R14   1                                                             
         STW,R14  DIREUSEC,R4                                                   
*                                                                               
*   THE DIRECTORY ENTRY HAS BEEN UPDATED IN CORE. NOW WE PROCEED                
*    TO WRITE THE UPDATED SECTOR.                                               
         LW,R14   R0                DIRECTORY SECTOR NUMBER                     
         LW,R15   R13               RESET REENTRANCE COUNT FOR WRITE            
         BAL,R8   WRITDIR           WRITE OUT THE UPDATED DIRECTORY             
         B        TRUERR6             ERROR: TEST FOR REENTRANCE                
*                                                                               
TRUNC45  RES      0         RELEASE BBCW                                        
         LI,R15   TYCNORM           SET TRUNCATE DONE OK                        
         LW,R6    R10               SET ADDRESS AS SAVED BY FINDDIRX            
         BAL,R11  RELADBUF          RELEASE IT                                  
*                                                                               
TRUNC48  RES      0         SET ADDRESS OF FPT FOR POST AND EXIT                
         LW,R2    R3                SET FPT ADDRESS                             
         B        DELEXIT                                                       
         SPACE 3                                                                
*                                                                               
*   ERROR PROCESSING FOR TRUNCATE CALL                                          
*                                                                               
TRUERR1  RES      0                                                             
         LW,R15   R9                R15= TYC                                    
TRUERR3  RES      0                                                             
         CI,R15   TYCREENT          WERE WE REENTERED                           
         BE       TRUNCATE          YES, RETURN TO START                        
         CI,R15   TYC03             IS IT UNDEFINDED FILE                       
         BE       TRUER71           YES, BRANCH                                 
         B        TRUNC48           NO, EXIT POSTING ERROR                      
*                                                                               
TRUERR6  RES      0                                                             
         LW,R15   R9                                                            
         LW,R6    R10               R6=BBCW ADDRESS                             
         BAL,R11  RELADBUF          RELEASE THE BLK BUFFER                      
         CI,R15   TYCREENT          WERE WE REENTERED                           
         BNE      TRUNC48           NO, TAKE ERROR EXIT                         
         B        TRUNCATE          YES, START OVER AGAIN                       
*                                                                               
TRUERR9  RES      0                                                             
         LW,R15   R9                R15= TYC                                    
         PULL     3,R9                                                          
         B        TRUERR3                                                       
*                                                                               
TRUER42  RES      0                                                             
         LI,R15   KA                WRITE PROCTECTION ERROR                     
         B        TRUNC48                                                       
*                                                                               
TRUER60  RES      0                                                             
         LI,R15   K60               ERROR, FILE IS OPEN                         
         B        TRUNC48                                                       
*                                                                               
TRUER70  RES      0                                                             
         LI,R15   K70               INVALID AREA NAME                           
         B        TRUNC48                                                       
*                                                                               
TRUER71  RES      0                                                             
         LI,R15   K71               INVALID FILE NAME                           
         B        TRUNC48                                                       
         PAGE                                                                   
***************************                                                     
*   READBLK AND WRITEBLK  *                                                     
***************************                                                     
*                                                                               
*   ROUTINE TO READ OR WRITE A SPECIFIED BLOCK OF A FILE                        
*                                                                               
*   AT ENTRY:                                                                   
*        R6       AREA INDEX                                                    
*        R8       LINK                                                          
*        R10      ADDRESS OF BBCW                                               
*        R14      RELATIVE SECTOR NUMBER TO READ OR WRITE                       
*        R15      REENTRANCE COUNT FROM RENT:D                                  
*                                                                               
*  AT EXIT:                                                                     
*        R8       LINK+1 IF NO ERRORS; LINK IF ANY ERRORS                       
*        R9       TYC CODE IF ANY ERRORS                                        
*                                                                               
*                                                                               
*   CALL:                                                                       
*        BAL,R8   READBLK                                                       
*        BAL,R8   WRITEBLK                                                      
*                                                                               
*   EXITS:        LINK   IF ERRORS                                              
*                 LINK+1 IF NO ERROR                                            
*                                                                               
READBLK  RES      0         READ A BLOCK                                        
         PUSH     16,R0             SAVE ALL REGISTERS                          
         LI,R4    FCRRAD            SET FUNCTION CODE = READ                    
         B        RWBLK1                                                        
*                                                                               
WRITEBLK RES      0         WRITE A BLOCK                                       
         PUSH     16,R0             SAVE ALL REGISTERS                          
         LI,R4    FCWRAD            SET FUNCTION CODE = WRITE                   
*                                                                               
RWBLK1   RES      0                                                             
         LW,R10   *R10              SET  BA(BLOCKING BUFFER) FROM BBCW          
         AND,R10  M17                                                           
         SLS,R10  2                                                             
         BAL,R5   CVTAREA           GET SEEK ADDRESS IN R12                     
         B        RWBLK7              ERROR OF SOME SORT: REPORT IT             
         LI,R11   BBSIZE            READ LENGTH = BLOCK SIZE                    
         LI,R6    3                 SET NUMBER OF RETRIES                       
         LW,R8    CUPCOD4           CLEANUP CODE = DO NOT POST FPT/DCB          
         BAL,R5   CALLQ             DO THE READ/WRITE                           
         B        RWBLK5              ERROR, R6=TYC                             
*                                                                               
RWBLK3   RES      0         RETURN TO SUCCESSFUL EXIT                           
         PULL     16,R0             RECOVER THE REGISTERS                       
         AI,R8    1                 STEP TO 'OK' RETURN                         
         B        *R8               AND RETURN WITH NO ERRORS                   
*                                                                               
*   ERROR PROCESSING FOR READBLK/WRITEBLK                                       
*                                                                               
RWBLK5   RES      0         ERROR EXIT: SET TYC CODE                            
         PULL     9,R7              RESTORE LAST HALF OF PUSH; SAVE R6          
         LW,R9    R6                MOVE ERROR TYC TO RETURN REGISTER           
         PULL     7,R0              RECOVER REST OF REGISTERS                   
         B        *R8               AND RETURN WITH ERROR                       
*                                                                               
*                                                                               
RWBLK7   RES      0         ERROR FROM CVTAREA                                  
         LW,R0    R15               SAVE CVTAREA ERROR CODE                     
         PULL     15,R1             RECOVER MOST OF REGISTERS                   
         LW,R9    R0                SET ERROR IN CORRECT REGISTER               
         PULL     R0                GET LAST SAVED REGISTER                     
         B        *R8               AND RETURN WITH AN ERROR                    
         PAGE                                                                   
***************                                                                 
*   FMFINDF   *                                                                 
***************                                                                 
*                                                                               
*   ROUTINE SEARCHES THE RFT FOR A FILE.                                        
*   ROUTINE ALWAYS RETURNS +1.                                                  
*   A MATCH IS FOUND WHEN FILE NAME AND AREA MATCH.                             
*                                                                               
*   AT ENTRY:     R5   LINK                                                     
*                 R6   AREA INDEX OR -1 FOR PUBLIC FILE                         
*                 R10,R11  ACCOUNT NAME                                         
*                 R12  FIRST WORD OF FILE NAME                                  
*                 R13  SECOND WORD OF FILE NAME                                 
*                                                                               
*   AT EXIT:      R7= 0 IF NO MATCH                                             
*                 R7= RFT INDEX OF FILE IF A MATCH IS FOUND                     
*                 R6= AREA INDEX                                                
*                                                                               
*        BAL,R5   FMFINDF                                                       
*                                                                               
FMFINDF  RES      0                                                             
         LH,R7    RFT#              GET NUMBER OF RFT ENTRIES TO CHECK          
*                                                                               
FMFINDF1 CD,R12   RFT1,R7           DOES FILE NAME COMPARE                      
         BNE      FMFINDF2          NO                                          
         CD,R10   RFTACNT,R7                                                    
         BNE      FMFINDF2          B IF ACNT NAMES DONT MATCH                  
         CI,R6    -1                                                            
         BE       FMFINDF3          B IF PUBLIC FILE SEARCH                     
         CB,R6    RFT8,R7           DO AREA INDEXES MATCH                       
         BE       0,R5              YES, EXIT                                   
FMFINDF2 BDR,R7   FMFINDF1          NO, CHECK NEXT ENTRY                        
         B        0,R5              DONE, EXIT                                  
*                                                                               
FMFINDF3 RES      0                 SPECIAL FOR PUBLIC FILE SEARCH              
         LB,R6    RFT8,R7           GET RFT FILE'S AREA INDEX                   
         LB,R6    MDFLAG,R6         GET AREA FLAGS                              
         CI,R6    X'80'                                                         
         BNE      FMFINDF4          B IF NOT ALLOC AND PUBLIC                   
         LB,R6    RFT8,R7           FOUND (SET AREA INDEX)                      
         B        0,R5                                                          
*                                                                               
FMFINDF4 RES      0                                                             
         LI,R6    -1                RESTORE R6                                  
         B        FMFINDF2          CONTINUE RFT SEARCH                         
*                                                                               
         OLAYEND                                                                
         END                                                                    
