         PCC      0                                                             
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
*   ENTRY POINTS                                                                
         DEF      REWIND                                                        
         DEF      WEOF,PRECORD,PFIL,SETUP                                       
*   EXIT POINTS                                                                 
         DEF      REWEXIT,REWERR                                                
         DEF      REWEX01,SETUPX1   EXIT POINT                                  
         DEF      REWX1,REWX2,REWX3,REWX4                                       
OLAYFLAG EQU      'REWI'                                                        
         SYSTEM   CPRMON                                                        
*                                                                               
*                                                                               
*                                                                               
EXTERR   CRASH    'BAD EXT'                                                     
         TITLE    '** REWIND **'                                                
**************                                                                  
*   REWIND   *                                                                  
**************                                                                  
*                                                                               
*                                                                               
*                                                                               
*   THIS ROUTINE PROCESSES ALL REWIND SYSTEM CALLS                              
*                                                                               
*                                                                               
*   AT ENTRY:     R1    FPT CODE                                                
*                 R3    FPT ADDRESS                                             
*                                                                               
*                                                                               
REWIND   BAL,R6   SETUP                                                         
*        ON RETURN, R7  DCT OR RFT INDEX                                        
*        R1  FPT CODE/ R2  DCB ADDRESS/  R3  FPT ADDRESS                        
REWEXIT  B        CALEXIT           NULL, GO TO CALEXIT                         
         B        REWFILE           RAD FILE                                    
REWX1    B        REWDEV            DEVICE                                      
REWERR   B        DCBERR            OPEN ERROR                                  
         SPACE 2                                                                
*                                                                               
*   REWIND RAD FILE                                                             
*                                                                               
REWFILE  RES      0                                                             
         BAL,R4   WLBLOCK           WRT/RLS LAST BB IF APPROPRIATE              
         B        REWFSTDX          ERROR, R9=TYC                               
         LW,R15   RENT:D            GET DIRECTORY REENT COUNT                   
         BAL,R8   FMREWF            REWIND THE FILE                             
         B        REWFE3             ERROR, R9=TYC                              
         LI,R9    TYCNORM           POST NORMAL TYC                             
         B        REWFSTDX                                                      
         SPACE 3                                                                
*                                                                               
*   REWFILE ERROR PROCESSING                                                    
*                                                                               
REWFE3   RES      0                                                             
         CI,R9    TYCREENT          REENTERED                                   
         BNE      REWFSTDX          NO, TAKE ERROR EXIT                         
         B        REWFILE           YES, TRY AGAIN                              
         TITLE    '** REWIND - WRITE END OF FILE **'                            
************                                                                    
*   WEOF   *                                                                    
************                                                                    
*                                                                               
*   THIS ROUTINE PROCESSES ALL WEOF SYSTEM CALLS                                
*                                                                               
*   AT ENTRY:     R1    FPT CODE                                                
*                 R3    FPT ADDRESS                                             
*                                                                               
*                                                                               
WEOF     BAL,R6   SETUP                                                         
*        ON RETURN, R7  DCT OR RFT INDEX                                        
*        R1  FPT CODE/ R2  DCB ADDRESS/  R3  FPT ADDRESS                        
         B        REWEXIT           CALEXIT                                     
         B        WEOFFILE          RAD FILE                                    
REWX2    B        WEOFDEV           DEVICE                                      
         B        REWERR            OPEN ERROR                                  
         SPACE 2                                                                
*                                                                               
*   WRITE END-OF-FILE TO A RAD FILE                                             
*                                                                               
WEOFFILE RES      0                                                             
         LB,R6    RFT8,R7           R6= AREA INDEX                              
         BAL,R5   FMCKWP            IS AREA PROTECTED FROM THIS USER ?          
         B        WEOFFE3           YES, WRT PROT ERROR                         
*                                                                               
         DISABLE                                                                
         LW,R8    RFT12,R7          R8= CURRENT RECORD NUMBER                   
         AI,R8    -1                                                            
         STW,R8   RFT6,R7           STORE IT IN FILE SIZE ENTRY                 
         LB,R8    RFT16,R7                                                      
         AND,R8   X3F               ZERO SEQWRT AND DIRWRT                      
         AI,R8    SEQWRT            SET SEQUENTIAL WRITE BIT                    
         STB,R8   RFT16,R7                                                      
         ENABLE                                                                 
         LI,R9    TYCNORM           POST NORMAL TYC                             
         B        REWFSTDX                                                      
         SPACE 2                                                                
WEOFFE3  RES      0                                                             
         LI,R9    X'0A'             TYC=0A (WRITE PROTCT VIOLATION)             
         B        REWFSTDX          POST TYC, ETC.                              
         PAGE                                                                   
*                                                                               
*   GENERAL EXIT FOR REWIND, UNLOAD AND WEOF CALS.                              
*   ASSUME IF R9 IS LESS THAN X'12' THAT IT IS A                                
*   TYC (I.E. TRANSLATABLE INTO AN ERROR CODE IF NOT X'01').                    
*   R2= DCB ADDRESS                                                             
*   R3= FPT ADDRESS                                                             
*   R9= TYC                                                                     
*                                                                               
REWFSTDX RES      0                                                             
         LW,R12   R9                MOVE TYC TO R12                             
         LW,R0    0,R3              GET FPT WORD 0                              
         CW,R0    Y008              IS P0 BIT SET                               
         BANZ     REWEX01           YES, POST TYC, ETC.                         
         CI,R9    TYCNORM           IS TYC NORMAL                               
         BLE      REWEXIT           YES, GO TO CALEXIT                          
         B        REWERR            NO, THEN USE DCB ERR/ABN ADDRESS            
         TITLE    '** REWIND - POSITION RECORD **'                              
***************                                                                 
*   PRECORD   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   AT ENTRY:     R1   FPT CODE                                                 
*                 R3   FPT ADDRESS                                              
*                                                                               
*                                                                               
PRECORD  BAL,R6   SETUP                                                         
*        ON RETURN, R7  DCT OR RFT INDEX                   /SIG7-2064/*C5732 C01
*        R1  FPT CODE/ R2  DCB ADDRESS/  R3  FPT ADDRESS   /SIG7-2064/*C5732 C01
         B        REWEXIT           NULL, CALEXIT                               
         B        PRECF             RAD FILE                                    
REWX3    B        PRECDEV           DEVICE                                      
         B        REWERR            OPEN ERROR                                  
         SPACE 2                                                                
*                                                                               
*                                                                               
*   POSITION RECORD ON A RAD  FILE                                              
*                                                                               
*                                                                               
PRECF    RES      0                                                             
         BAL,R4   WLBLOCK           WRT/RLS LAST BB IF APPROPRIATE              
         B        PRECFE18          ERROR, R9=TYC                               
         LI,R15   1                                                             
         BAL,R5   GETPI             GET N= # OF RECORDS TO SKIP                 
         LI,R15   1                  DEFAULT                                    
         LI,R12   TYCNORM           SET NORMAL TYC                              
         LW,R11   R15               N TO R11                                    
         BEZ      REWEX01           POST NORMAL TYC IF N=0                      
         LW,R9    1,R3              GET FPT WORD 1                              
         CI,R9    K10               TEST DIRECTION                              
         BAZ      %+2                                                           
         LCW,R11  R11               MAKE COUNT NEGATIVE FOR BACK SKIP           
         DISABLE                                                                
         AW,R11   RFT12,R7          R11= NEW RECORD NUMBER                      
         BGZ      PRECF24           B IF NOT BOT                                
*   BOT HAS BEEN HIT.  TEST FOR EXTENSIBLE FILE.                                
         LW,R9    RFTESZ,R7         GET EXTENT SIZE                             
         BEZ      PRECF6            B IF FILE NOT EXTENSIBLE                    
PRECF3   RES      0                                                             
         LH,R9    RFTE#,R7          R9= CURRENT EXTENT NUMBER                   
         BNEZ     PRECF9            B IF NOT IN EXTENT 0                        
*   SET TYC, RECORD NUMBER FOR BOT CONDITION.                                   
PRECF6   RES      0                                                             
         LI,R12   K3                SET TYC TO BOT                              
         LI,R11   1                 POSITION AT START OF FILE                   
         B        PRECF42                                                       
*                                                                               
*   THE FILE IS EXTENSIBLE AND THERE ARE INSUFFICIENT RECORDS                   
*   IN THE CURRENT EXTENT TO BACK UP THE SPECIFIED NUMBER OF                    
*   RECORDS.  THE NEXT LOWER NUMBERED EXTENT WILL BE TRIED.                     
*   IF IT CONTAINS ENOUGH RECORDS TO COMPLETE THE BACKSPACE,                    
*   THE FILE WILL BE POSITIONED IN THAT EXTENT.  IF NOT, THE                    
*   PROCESS WILL CONTINUE UNTIL THE SPECIFIED NUMBER OF RECORDS                 
*   CAN BE SKIPPED.  (OR UNTIL WE HAVE BACKED                                   
*   OUT OF EXTENT 0.)                                                           
*                                                                               
PRECF9   RES      0                                                             
         LW,R15   RENT:D            GET REENT COUNT                             
         LW,R4    R9                R4= CURRENT EXTENT                          
         LW,R5    RFT12,R7          R5= CURRENT RECORD NUMBER                   
*   UPDATE THE DIRECTORY ENTTRY FOR THE CURRENT EXTENT                          
         ENABLE                                                                 
         LB,R8    RFT16,R7          GET RFT FLAGS                               
         CI,R8    SEQWRT+DIRWRT     WAS THE FILE WRITTEN                        
         BAZ      PRECF10           NO, BRANCH                                  
         PUSH     8,R4              YES, SAVE R4-R11                            
         BAL,R8   CFUPDIR           UPDATE DIR FOR THIS EXTENT                  
         B        PRECFE3            ERROR, R9=TYC                              
         PULL     8,R4                                                          
PRECF10  RES      0                                                             
*   GET THE DIRECTORY ENTRY FOR THE NEXT FILE EXTENT                            
PRECF12  RES      0                                                             
         AI,R9    -1                NEXT EXTENT TO FIND                         
         PUSH     3,R7              SAVE RFTX,EXT#                              
         PUSH     R11               SAVE RECORD NUMBER                          
         LB,R6    RFT8,R7           AREA INDEX                                  
         LD,R10   RFTACNT,R7        ACCOUNT NAME                                
         LD,R12   RFT1,R7           FILE NAME                                   
         PUSH     2,R4              SAVE R4,R5                                  
         LI,R7    0                 SET R7 FOR FINDDIR                          
         BAL,R8   FINDDIRX          GO GET THE DIRECTORY ENTRY                  
         B        PRECFE9            ERROR, R9=TYC                              
         LW,R6    R4                R6= POINTER TO ENTRY IN CORE                
         PULL     2,R4                                                          
         PULL     R11                                                           
         PULL     3,R7                                                          
         CW,R9    DIREXTNT,R6       VALIDATE EXTENT NUMBER                      
         BNE      EXTERR            NOT THE ONE WE WANTED, CRASH                
         AW,R11   DIREFSIZ,R6       ENOUGH RECORDS IN THIS EXTENT               
         BGZ      PRECF18           YES, R11 HAS RECORD TO POS TO               
*                                                                               
         CI,R9    0                 ARE WE BACKED INTO EXTENT 0                 
         BE       PRECF15           YES, PROCESS BOT                            
*   RELEASE THE BLK BUFFER AND TRY NEXT EXTENT (N-1)                            
         LW,R6    R10               R6= BBCW ADDRESS                            
         PUSH     2,R4                                                          
         LW,R8    R11               SAVE ADJUSTED RECORD NUMBER                 
         BAL,R11  RELADBUF          RELEASE THE BB                              
         LW,R11   R8                R11= ADJUSTED RECORD #                      
         PULL     2,R4                                                          
         B        PRECF12           GET NEXT EXTENT                             
*                                                                               
*   HERE WE HAVE HIT BOT BY REACHING EXTENT 0 BEFORE THE                        
*   SPECIFIED NUMBER OF RECORDS COULD BE SKIPPED                                
*                                                                               
PRECF15  RES      0                                                             
         LI,R11   1                 SET RECORD NUMBER TO 1                      
         LI,R12   K3                SET TYC TO BOT                              
         B        PRECF21           B TO COMPLETE THE PREC                      
*                                                                               
*   HERE WE HAVE FOUND THE EXTENT WHICH WILL ALLOW THE                          
*   SPECIFIED NUMBER OF RECORDS TO BE SKIPPED.                                  
*                                                                               
PRECF18  RES      0                                                             
         LI,R12   TYCNORM           TYC= NORMAL                                 
PRECF21  RES      0                                                             
         DISABLE                                                                
         CH,R4    RFTE#,R7          ARE WE IN THE ORIGINAL EXTENT               
         BNE      PRECFE12          NO, REENTERED                               
         CW,R5    RFT12,R7          POSITIONED AT THE ORIGINAL RECORD           
         BNE      PRECFE12          NO, REENTERED                               
*   SET RFT PARAMETERS                                                          
         PUSH     2,R11             SAVE R11,R12                                
         LCI      3                                                             
         LM,R12   DIREFSIZ,R6       LOAD R12-R14 WITH DIR PARAMETERS            
         STW,R12  RFT6,R7           FILE SIZE                                   
         STW,R13  RFT2,R7           BOT                                         
         STW,R14  RFT3,R7           EOT                                         
         STH,R9   RFTE#,R7          EXTENT NUMBER                               
         BAL,R8   FMSETRFT          SET RFT IN A REWOUND POSITION               
         ENABLE                                                                 
         LW,R6    R10                                                           
         BAL,R11  RELADBUF          RELEASE BB POINTED TO IN R6                 
         PULL     2,R11                                                         
         B        PRECF42           NOW POSITION TO THE RECORD                  
*                                    NUMBER IN R11.                             
*                                                                               
*                                                                               
PRECF24  RES      0                                                             
         LI,R12   TYCNORM           SET TYC TO NORMAL                           
         LW,R8    R11               CHECK FOR POSITIONING                       
         AI,R8    -1                 BEYOND                                     
         CW,R8    RFT6,R7             END OF FILE                               
         BLE      PRECF42             NO, STILL WITHIN FILE                     
*                                                                               
         LD,R8    RFT1,R7           IS THE FILE THE ENTIRE AREA, AND            
         CD,R8    BLANKS            (FSIZE=0 UNTIL A WRITE)                     
         BNE      PRECF25           NOT AN AREA; TEST IF TRUE EOF.              
*                                                                               
         CW,R11   RFT3,R7           POSITION BEYOND EOA ?                       
         BLE      PRECF42             NO, DO PREC OK                            
         B        PRECF27             YES, GIVE END-OF-FILE                     
*                           THIS ASSUMES RSIZE=GSIZE=SECTOR SIZE                
*                                                                               
PRECF25  RES      0         EOD HIT. TEST FOR EXTENSIBLE FILES.                 
         LW,R9    RFTESZ,R7         GET EXTENT SIZE                             
         BEZ      PRECF27           B IF FILE NOT EXTENSIBLE                    
         LB,R9    RFT16,R7          GET RFT FLAGS                               
         CI,R9    SEQWRT+DIRWRT     WAS THERE A WRITE IN THIS EXT               
         BAZ      PRECF30           NO, CHECK FOR MORE EXTENTS                  
*                                                                               
PRECF27  RES      0                                                             
         LI,R12   TYCEOD            YES, WRITE IMPLIES EOF                      
         LW,R11   RFT6,R7           R11= FILE SIZE                              
         AI,R11   1                 CURRENT RECORD = FSIZE +1 RECORD            
         B        PRECF42           B TO FINISH PREC                            
*                                                                               
*   THE FILE IS EXTENSIBLE AND THERE ARE INSUFFICIENT RECORDS                   
*   IN THE EXTENT TO GO FORWARD THE SPECIFIED NUMBER OF RECORDS.                
*   THE NEXT HIGHER NUMBERED EXTENT WILL BE TRIED.  IF IT                       
*   CONTAINS ENOUGH RECORDS TO COMPLETE THE FORWARD PREC, THE                   
*   FILE WILL BE POSITIONED IN THAT EXTENT; IF NOT, THE PROCESS                 
*   WILL CONTINUE UNTIL THE SPECIFIED NUMBER OF RECORDS CAN                     
*   BE SKIPPED OR UNTIL WE HAVE RUN OUT OF EXTENTS.                             
*                                                                               
PRECF30  RES      0                                                             
         LW,R11   R15               R11= 'N'                                    
PRECF33  RES      0                                                             
         LW,R15   RENT:D            GET REENT COUNT                             
PRECF36  RES      0                                                             
         LW,R12   RFT6,R7           COMPUTE  # RECORDS WE CAN SKIP              
         AI,R12   1                  IN THIS                                    
         SW,R12   RFT12,R7            EXTENT.                                   
         CW,R11   R12               SUFFICIENT # RECORDS IN THIS EXT            
         BL       PRECF39           YES, BRANCH                                 
*   GET THE NEXT EXTENT INTO THE RFT.                                           
         LH,R9    RFTE#,R7          R9= CURRENT EXTENT NUMBER                   
         LW,R4    R9                PUT IT IN R4 TOO                            
         AI,R9    1                 NEXT EXTENT TO LOOK FOR                     
         LW,R5    RFT12,R7          R5= CURRENT RECORD NUMBER                   
         ENABLE                                                                 
         PUSH     2,R11             SAVE R11,R12                                
         BAL,R8   FMGETEXT          FIND THE NEXT EXTENT                        
         B        PRECFE14           ERROR, R9=TYC                              
         PULL     2,R11                                                         
         DISABLE                                                                
         SW,R11   R12               R11= REMAINING # OF RECORDS TO              
         B        PRECF36            SKIP AFTER THE PREVIOUS EXTENT.            
*                                                                               
PRECF39  RES      0                                                             
         AW,R11   RFT12,R7          R11= NEW RECORD NUMBER                      
         ENABLE                                                                 
         LI,R12   TYCNORM           TYC IS NORMAL                               
*                                                                               
*   HERE WE HAVE THE APPROPRIATE EXTENT IN THE RFT.                             
*   REGISTERS CONTAIN:                                                          
*        R1       FPT CODE                                                      
*        R2       DCB ADDRESS                                                   
*        R3       FPT ADDRESS                                                   
*        R7       RFT INDEX                                                     
*        R11      RECORD # TO SKIP TO                                           
*        R12      TYC                                                           
*                                                                               
*                                                                               
PRECF42  RES      0         TEST THE FILE'S ORG                                 
         DISABLE                                                                
         LB,R6    RFT8,R7           SET AREA INDEX                              
         LB,R13   RFT7,R7           GET FILE'S ORGANIZATION                     
         AND,R13  ORGMASK           REMOVE ACCESS MODE FLAGS                    
        DO       #CFILES       IF COMPRESSED FILES ALLOWED...                   
         CI,R13   COMPORG           IS IT A COMPRESSED FILE ?                   
         BNE      PRECF48             NO, TRY OTHER TYPES                       
*                                                                               
*   COMPRESSED FORMAT FILE                                                      
         LW,R9    R11               SET RECORD NUMBER TO SKIP TO                
         ENABLE                                                                 
         PUSH     R12               SAVE TYC                                    
         BAL,R5   PCFIL             POSITION THE FILE                           
         B        PRECF45           ERROR, R9= ERROR CODE                       
         PULL     R12               RESTORE TYC                                 
         B        REWEX01           EXIT AND POST TYC (R12=TYC)                 
*                                                                               
PRECF45  RES      0                                                             
         PULL     R12               CLEANUP STACK                               
         B        PRECFE18          ERROR, R9=TYC                               
*                                                                               
*                                                                               
PRECF48  RES      0         TEST FOR BLOCKED OR UNBLOCKED ORG                   
        FIN      #CFILES                                                        
*                                                                               
         STW,R11  RFT12,R7          SET NEW CURRENT RECORD NUMBER               
         CI,R13   BLKORG            IS IT A BLOCKED FILE ?                      
         BE       PRECF51             YES, GO PROCESS                           
*                                                                               
*   UNBLOCKED FORMAT FILE                                                       
*   R11= NEW 'CURRENT RECORD' NUMBER                                            
*   R12= TYC                                                                    
         LH,R15   RFT5,R7           RSIZE                                       
         AND,R15  M16               MASK                                        
         BAL,R8   SECTPERN          SET R15 = SECTORS PER RECORD                
         AI,R11   -1                (RECORD NUMBER -1 )                         
         MW,R15   R11               * (SECTORS PER RECORD)                      
         STW,R15  RFT11,R7          = NEW SECTOR POSITION                       
         B        PRECF54                                                       
*   BLOCKED FORMAT FILE                                                         
*   R11= NEW 'CURRENT RECORD' NUMBER                                            
*   R12= TYC                                                                    
PRECF51  RES      0                                                             
         LI,R13   BBSIZE            BLOCK SIZE                                  
         DH,R13   RFT5,R7           RECORDS PER BLOCK IN R13                    
         LI,R10   0                                                             
         AI,R11   -1                                                            
         DW,R10   R13               NO OF B'S IN R11, REMAIN IN R10             
         LI,R15   1024                                                          
         BAL,R8   SECTPERN          SET R15 = SECTORS PER BLOCK                 
         MW,R11   R15               SECTORS/BLOCK * RECORD POSITION             
         STW,R11  RFT11,R7          = NEW FILE POSITION                         
         LW,R11   R10               R11=REMAINDER FROM ABOVE                    
         MH,R11   RFT5,R7           RSIZE * REMAIN RECORD = NEW BB POS          
         STH,R11  RFT10,R7          SET BB POSITION                             
PRECF54  RES      0                                                             
         ENABLE                                                                 
REWEX01  B        POST              POST TYC (R12= TYC)                         
         SPACE 3                                                                
*                                                                               
*   PROCESS ERRORS IN PREC FILE                                                 
*                                                                               
PRECFE3  RES      0                                                             
         LW,R12   R9                TYC TO R12                                  
         PULL     8,R4              RESTORE R4-R11                              
PRECFE6  RES      0                                                             
         CI,R12   TYCREENT          REENTERED                                   
         BNE      REWEX01           NO, POST TYC                                
         B        PRECF             YES, DO IT AGAIN                            
*                                                                               
PRECFE9  RES      0                                                             
         LW,R12   R9                TYC TO R12                                  
         PULL     2,R4              CLEANUP STACK                               
         PULL     R11                                                           
         PULL     3,R7                                                          
         B        PRECFE6           B TO FINISH CLEANUP                         
*                                                                               
PRECFE12 RES      0                                                             
         ENABLE                                                                 
         LW,R6    R10               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          RELEASE THE BB                              
         B        PRECF             START AT BEGINING                           
*                                                                               
PRECFE14 RES      0                                                             
         PULL     2,R11             RESTORE R11,R12                             
         LW,R12   R9                R12= TYC                                    
         CI,R12   TYC03             IS IT NON-EXISTENT FILE                     
         BE       PRECF27           YES, CURRENT EXT# IS THE LAST ONE           
         CI,R12   TYCREENT          WERE WE REENTERED                           
         BNE      REWEX01           NO, POST THE ERROR                          
         DISABLE                    YES, CONTINUE WITH REMAINING                
         B        PRECF33            # RECORDS TO SKIP IN R11.                  
PRECFE18 RES      0                                                             
         LW,R12   R9                R12 = TYC                                   
         B        REWEX01           POST THE TYC                                
         TITLE    '** REWIND - POSITION FILE **'                                
*************                                                                   
*   PFILE   *                                                                   
*************                                                                   
*                                                                               
*   THIS ROUTINE PROCESSES ALL POSITION FILE SYSTEM CALLS                       
*                                                                               
*                                                                               
*   AT ENTRY:     R1    FPT CODE                                                
*                 R3    FPT ADDRESS                                             
*                                                                               
*                                                                               
PFIL     BAL,R6   SETUP                                                         
*        ON RETURN, R7  DCT OR RFT INDEX                   /SIG7-2064/*C5732 C01
*        R1  FPT CODE/ R2  DCB ADDRESS/  R3  FPT ADDRESS   /SIG7-2064/*C5732 C01
         B        REWEXIT           NULL, CALEXIT                               
         B        PFILF             RAD FILE                                    
REWX4    B        PFILDEV           DEVICE                                      
         B        REWERR            OPEN ERROR                                  
         SPACE 2                                                                
*                                                                               
*   POSITION FILE ON A RAD FILE                                                 
*                                                                               
PFILF    RES      0                                                             
         BAL,R4   WLBLOCK           WRT/RLS LAST BB IF APPROPRIATE              
         B        PFILFE9           ERROR, R9=TYC                               
         LW,R15   RENT:D            GET DIRECTORY REENT COUNT                   
         LW,R5    1,R3              FPT WORD 1                                  
         CI,R5    K10               TEST DIRECTION BIT                          
         BANZ     PFILFBK           B IF POSITION BACK                          
*                                                                               
*   POSITION FILE FORWARD.                                                      
*                                                                               
*   IF THE FILE IS EXTENSIBLE, WE MUST FIND THE LAST EXTENT                     
*   AND UPDATE THE RFT ACCORDINGLY.                                             
*                                                                               
         LW,R8    RFTESZ,R7         GET EXTENT SIZE                             
         BEZ      PFILF12           B IF FILE NOT EXTENSIBLE                    
         LB,R9    RFT16,R7          GET FLAGS                                   
         CI,R9    SEQWRT+DIRWRT     HAS THIS EXTENT BEEN WRITTEN                
         BANZ     PFILF12           YES, THIS IS THE LAST ONE                   
*   DETERMINE THE LAST EXTENT                                                   
         LB,R6    RFT8,R7           R6= AREA INDEX                              
         LW,R5    RFT12,R7          GET CURRENT RECORD NUMBER                   
         LH,R9    RFTE#,R7          R9= EXTENT NUMBER                           
         LW,R4    R9                R4= CURRENT EXTENT NUMBER                   
         LD,R10   RFTACNT,R7        ACCOUNT NAME                                
         LD,R12   RFT1,R7           FILE NAME                                   
         PUSH     4,R4              SAVE R4-R7                                  
         LI,R7    0                 R7= 0 FOR FINDDIR                           
PFILF1   RES      0                                                             
         AI,R9    1                 INCREMENT EXTENT NUMBER                     
         PUSH     3,R9                                                          
         BAL,R8   FINDDIRX          FIND THE EXTENT IF IT'S THERE               
         B        PFILF3             ERROR, R9=TYC                              
         PUSH     R6                SAVE AREA INDEX                             
         LW,R6    R10               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          RELEASE THE BB                              
         PULL     R6                                                            
         PULL     3,R9                                                          
         B        PFILF1            TRY NEXT EXTENT                             
*                                                                               
PFILF3   RES      0                                                             
         CI,R9    TYC03             IS IT NON-EXISTENT FILE                     
         BNE      PFILFE3           NO, PROCESS ERROR                           
         PULL     3,R9                                                          
         PULL     4,R4                                                          
         AI,R9    -1                R9= NUMBER OF LAST EXTENT                   
         CH,R9    RFTE#,R7          IS IT THE OPEN EXTENT                       
         BE       PFILF12           YES, PROCEED                                
*   UPDATE THE DIRECTORY FOR THE OPEN EXTENT AND GET                            
*   THE NEW EXTENT.                                                             
         BAL,R8   FMGETEXT          GET THE EXTENT                              
         B        PFILFE6           ERROR, R9=TYC                               
*   NOW WE HAVE THE LAST EXTENT OF THE FILE IN THE RFT.                         
*   THE FILE WILL BE POSITIONED AT THE LAST RECORD IN THE EXTENT.               
PFILF12  RES      0                                                             
         LB,R6    RFT8,R7           AREA INDEX TO R6                            
         LB,R11   RFT7,R7           GET FILE'S ORGANIZATION CODE                
         AND,R11  ORGMASK           AND REMOVE ACCESS CODES                     
        DO       #CFILES                                                        
         CI,R11   COMPORG           IS FILE COMPRESSED ?                        
         BE       PFILF24             YES, PROCESS                              
        FIN                                                                     
         CI,R11   BLKORG            IS FILE BLOCKED ?                           
         BNE      PFILF15             NO, UNBLOCKED                             
*                                                                               
*                           FILE IS BLOCKED                                     
         LI,R15   BBSIZE            SET BLOCK SIZE IN BYTES                     
         BAL,R8   SECTPERN          SET R15 = SECTORS PER BLOCK                 
         LI,R13   BBSIZE            SIZE OF A BLOCKING BUFFER IN BYTES          
         DH,R13   RFT5,R7           RECORDS PER BLOCK IN R13                    
         LW,R11   RFT6,R7           FILE SIZE                                   
         LI,R10   0                                                             
         DW,R10   R13               NO OF BLOCKS TO R11, REMAIN TO R10          
         MW,R15   R11               NO OF SECTORS TO R15 (FILE POSITION)        
         MH,R10   RFT5,R7           BB POSITION                                 
         B        PFILF18           B TO SET RFT PARAMETERS                     
*                                                                               
PFILF15  RES      0         FILE IS UNBLOCKED                                   
         LH,R15   RFT5,R7           GET RECORD SIZE FOR FILE AND                
         AND,R15  M16               MASK                                        
         BAL,R8   SECTPERN          SET R15 = SECTORS PER RECORD                
         MW,R15   RFT6,R7           TIMES FILE SIZE                             
         LI,R11   0                 BB POSITION FOR UNBLOCKED FILES             
PFILF18  RES      0                                                             
         LW,R8    R15               R8= NEW FILE POSITION IN SECTORS            
         LW,R9    RFT6,R7           FILE SIZE                                   
         AI,R9    1                                                             
         STW,R8   RFT11,R7          SET NEW FILE POSITION                       
         STW,R9   RFT12,R7          STORE IN CURRENT RECORD #                   
         STH,R11  RFT10,R7          BB POSITION                                 
PFILF21  RES      0                                                             
         LI,R12   TYCNORM           SET NORMAL TYPE COMPLETION                  
         B        REWEX01                                                       
*                                                                               
*                                                                               
        DO       #CFILES       IF COMPRESSED FILES ALLOWED...                   
*                                                                               
PFILF24  RES      0         POSITION COMPRESSED FILES                           
         LW,R9    RFT6,R7           GET CURRENT FILE SIZE                       
         AI,R9    1                 SET TO POSITION TO THE END                  
         BAL,R5   PCFIL             POSITION THE FILE                           
         B        PFILFE9           ERROR, R9=TYC                               
         B        PFILF21           EXIT AND POST                               
*                                                                               
*   POSITION FILE BACKWARD                                                      
*                                                                               
PFILFBK  RES      0                                                             
         BAL,R8   FMREWF            REWIND THE FILE                             
         B        PFILFE6            ERROR, R9=TYC                              
         B        PFILF21           TAKE NORMAL EXIT                            
         SPACE 3                                                                
*                                                                               
*   PROCESS ERRORS IN PFIL RAD FILE                                             
*                                                                               
*                                                                               
PFILFE3  RES      0                                                             
         LW,R12   R9                R12= TYC                                    
         PULL     3,R9                                                          
         PULL     4,R4                                                          
         CI,R12   TYCREENT          REENTERED                                   
         BNE      REWEX01           NO, POST TYC                                
         B        PFILF             YES, TRY AGAIN                              
*                                                                               
PFILFE6  RES      0                                                             
         LW,R12   R9                R12= TYC                                    
         CI,R12   TYCREENT          REENTERED                                   
         BNE      REWEX01           NO, POST TYC, ETC.                          
         B        PFILF             YES, TRY AGAIN                              
*                                                                               
PFILFE9  RES      0                                                             
         LW,R12   R9                R12 = TYC                                   
         B        REWEX01           POST TYC                                    
         TITLE    '** REWIND - PCFIL SUBROUTINE **'                             
*************                                                                   
*   PCFIL   *                                                                   
*************                                                                   
*                                                                               
*   ROUTINE POSITIONS A COMPRESSED FILE                                         
*                                                                               
*   ENTRY REGISTERS:                                                            
*                                                                               
*        R3       FPT ADDRESS                                                   
*        R5       LINK                                                          
*        R6       AREA INDEX                                                    
*        R7       RFT INDEX                                                     
*        R9       RECORD NUMBER                                                 
*                                                                               
*   EXIT REGISTERS:                                                             
*                                                                               
*        R5, R6, R8 - R15 ARE ALTERED AND NOT RESTORED                          
*                                                                               
*   EXITS:        LINK   IF ANY ERRORS, R9 = TYC                                
*                 LINK+1 IF NO  ERRORS                                          
*                                                                               
*                                                                               
PCFIL    RES      0         POSITION A COMPRESSED FILE FORWARD R9 RECS          
         PUSH     R5                SAVE LINK                                   
         BAL,R5   FINDBB            GET A BUFFER TO READ BLOCKS INTO            
         B        PCFILE6             NONE AVAILABLE, REPORT ERROR              
*                                                                               
         LI,R5    0                 SET FILE REWOUND                            
         STW,R5   RFT11,R7                                                      
         LW,R12   *R15                                                          
         BAL,R5   RBLOCK                                                        
         B        PCFILE7           ERROR IN RBLOCK                             
         LW,R10   R9                COPY RECORD NUMBER TO SKIP TO               
         AI,R9    -1                ADJUST TO NUMBER TO SKIP OVER               
         BEZ      PCFILE5                                                       
PCFILE2  LI,R5    0                 INITIALIZE INDEX                            
PCFILE3  LB,R11   *R12,R5           GET BYTE                                    
         AI,R5    1                                                             
         CI,R11   CBFCODE           CHAR A CONTROL BYTE PREFIX ?                
         BE       PCFILE8             YES, STEP OVER FOLLOWING BYTE             
*                                                                               
         CI,R11   BLFLAG            IS BYTE A BLANK SUPPRESSION CODE ?          
         BNE      PCFILE9             NO, TEST OTHER CODES                      
*                                                                               
PCFILE8  EQU      %         STEP OVER 2ND BYTE OF A CODE BYTE PAIR              
         AI,R5    1                 STEP OVER THE BYTE                          
*                                                                               
PCFILE9  EQU      %         TEST FOR OTHER CONTROL BYTES                        
         CI,R11   EOBCODE                                                       
         BE       PCFILE4           B IF END OF BLOCK                           
         CI,R11   EORCODE                                                       
         BNE      PCFILE3           B IF NOT END OF RECORD                      
         BDR,R9   PCFILE3           LOOP UNTIL ALL ARE SKIPPED                  
*                                                                               
PCFILE1  STH,R5   RFT10,R7          SET BB POSITION                             
PCFILE5  RES      0                                                             
         STW,R10  RFT12,R7          SET CURRENT RECORD NUMBER                   
         LW,R6    R15               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          RELEASE THE BB                              
         PULL     R5                R5= LINK                                    
         B        1,R5              RETURN +2, NORMAL RETURN                    
*                                                                               
PCFILE4  BAL,R4   IBBPARAM                                                      
         BAL,R5   RBLOCK                                                        
         B        PCFILE7           ERROR IN RBLOCK                             
         B        PCFILE2                                                       
*                                                                               
*   PROCESS ERRORS                                                              
*                                                                               
PCFILE6  LI,R9    K55               ERROR X'55'                                 
         PULL     R5                RESTORE LINK                                
         B        0,R5              TAKE ERROR EXIT (+1)                        
*                                                                               
PCFILE7  LW,R9    R6                ERROR CODE TO R9                            
         LW,R6    R15               R6=BBCW ADDRESS                             
         BAL,R11  RELADBUF          RELEASE THE BB                              
         PULL     R5                RESTORE LINK                                
         B        0,R5              TAKE ERROR EXIT (+1)                        
         FIN                                                                    
         TITLE    '** REWIND - MISCELLANEOUS SUBROUTINES **'                    
************                                                                    
*  FMREWF  *                                                                    
************                                                                    
*                                                                               
*   ROUTINE POSITIONS PERMANENT DISK FILES AT THE FIRST                         
*   RECORD OF THE FIRST EXTENT.                                                 
*                                                                               
*   AT ENTRY:                                                                   
*        R1       FPT CODE                                                      
*        R7       RFT INDEX                                                     
*        R8       LINK                                                          
*        R15      REENTRANCE COUNT FROM RENT:D                                  
*                                                                               
*   ROUTINE EXITS:   +2 NORMALLY                                                
*                    +1 IF ERROR...R9=TYC                                       
*                                                                               
*   REGISTERS PRESERVED:   R1-R3,R7                                             
*                                                                               
FMREWF   RES      0                                                             
         PUSH     R8                SAVE LINK REGISTER                          
         DISABLE                                                                
         CW,R15   RENT:D            REENTERED                                   
         BNE      FMREWE3           YES, TAKE ERROR EXIT                        
         LW,R4    RFTESZ,R7         GET EXTENT SIZE                             
         BEZ      FMREWF6           NOT EXTENSIBLE IF SIZE=0                    
         LH,R4    RFTE#,R7          GET CURRENT EXTENT NUMBER                   
         BEZ      FMREWF6           ALREADY IN EXTENT 0                         
         LW,R5    RFT12,R7          GET CURRENT RECORD NUMBER                   
*   WE ARE NOT IN EXTENT 0.  UPDATE THE DIRECTORY ENTRY FOR THIS                
*   EXTENT IF REQUIRED, THEN POSITION THE FILE AT EXTENT 0.                     
         ENABLE                                                                 
         LI,R9    0                 R9= EXTENT NUMBER TO GET                    
         BAL,R8   FMGETEXT          GO GET IT                                   
         B        FMREWE9            ERROR, R9=TYC                              
         B        FMREWF9           DONE, EXIT                                  
*    SET RFT TO A REWOUND POSITION                                              
FMREWF6  RES      0                                                             
         BAL,R8   FMSETRFT          SET RFT IN A REWOUND POSITION               
         ENABLE                                                                 
*                                                                               
FMREWF9  RES      0                                                             
         PULL     R8                RESTORE LINK                                
         AI,R8    1                 TAKE NORMAL EXIT (+2)                       
         B        *R8               EXIT                                        
         SPACE 3                                                                
*                                                                               
*   PROCESS ERRORS IN FMREWF SUBROUTINE                                         
*                                                                               
FMREWE3  RES      0                                                             
         ENABLE                                                                 
         LI,R9    TYCREENT          SET TYC FOR REENTERED                       
*                                                                               
FMREWE9  RES      0                                                             
         PULL     R8                                                            
         B        *R8               TAKE ERROR EXIT (+1)                        
         PAGE                                                                   
**************                                                                  
*  FMSETRFT  *                                                                  
**************                                                                  
*                                                                               
*   ROUTINE SETS THE RFT IN A REWOUND POSITION                                  
*                                                                               
*   AT ENTRY:   R7   RFT INDEX                                                  
*                                                                               
*   IF A BLOCKING BUFFER WAS ATTACHED TO THE FILE, IT SHOULD HAVE               
*   BEEN WRITTEN OUT BEFORE CALLING THIS SUBROUTINE.                            
*                                                                               
*   ROUTINE ALWAYS RETURNS +1                                                   
*                                                                               
*   ROUTINE CLOBBERS:   R0,R8                                                   
*                                                                               
FMSETRFT RES      0                                                             
         LI,R0    0                                                             
         STH,R0   RFT10,R7          ZERO BB POSITION                            
         STW,R0   RFT11,R7          ZERO CURRENT FILE POSITION                  
         LI,R0    1                                                             
         STW,R0   RFT12,R7          CURRENT RECORD NUMBER=1                     
         B        *R8               RETURN                                      
         PAGE                                                                   
*************                                                                   
*   SETUP   *                                                                   
*************                                                                   
*                                                                               
*                                                                               
*   ROUTINE OPENS A USER DCB & DETERMINES THE TYPE OF ASSIGNMENT                
*                                                                               
*   AT ENTRY:     R3   FPT ADDRESS                                              
*                 R6   LINK                                                     
*   AT EXIT:      R7   DCT OR RFT INDEX                                         
*                 R1   FPT CODE                                                 
*                 R2   DCB ADDRESS                                              
*                 R3   FPT ADDRESS                                              
*                 R8   DCB WORD 0                                               
*                                                                               
*   RETURNS:      +1  NULL                                                      
*                 +2  RAD FILE                                                  
*                 +3  DEVICE                                                    
*                 +4  ERROR, R9= ERROR CODE                                     
*                                                                               
SETUP    RES      0                                                             
         BAL,R4   GETDCBAD                                                      
         PUSH     R6                SAVE LINK                                   
         BAL,R4   OPENDCB                                                       
         B        SETUP3            TAKE ERROR EXIT (+4)                        
         PULL     R6                RESTORE LINK                                
         LW,R7    1,R2              DCB WORD 1                                  
         LW,R8    0,R2              DCB WORD 0                                  
         CI,R8    K1                TEST ASN                                    
         BAZ      SETUPX1           B IF NULL DCB                               
         CI,R8    K2                                                            
         BAZ      SETUP1            B IF RAD FILE                               
         BAL,R4   GETDCTX                                                       
         B        SETUP2            BAD DCT INDEX                               
         CI,R7    0                                                             
         BE       SETUPX1           NULL EXIT (+1)                              
         CI,R7    X'80'                                                         
         BANZ     SETUP1            B IF RAD FILE                               
         AI,R6    2                                                             
         B        SETUPX1           DEVICE EXIT (+3)                            
SETUP1   AND,R7   M7                EXTRACT RFT INDEX                           
         AI,R6    1                                                             
         B        SETUPX1           RAD FILE EXIT (+2)                          
*                                                                               
SETUP2   LI,R9    K1                ERROR, R9= ERROR CODE                       
         B        SETUP4            TAKE ERROR EXIT                             
SETUP3   PULL     R6                RESTORE LINK                                
SETUP4   AI,R6    3                                                             
SETUPX1  B        0,R6              ERROR EXIT (+4)                             
         OLAYEND                                                                
         END                                                                    
