         PCC      0                                                             
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      RWBFIL                                                        
         DEF      WBLOCK,WLBLOCK                                                
         DEF      RBLOCK,IBBPARAM                                               
         DEF      RELADBUF                                                      
*   EXITS                                                                       
         DEF      RWBFX1,RWBFX2,RWBFX3,RWBFX4                                   
         DEF      RWBFX6,RWBFX7,RWBFX8                                          
         DO       #SYMB                                                         
         DEF      RWBFX10                                                       
         FIN      #SYMB                                                         
         DEF      RWBFX11,RWBFX9                                                
         DEF      FBBX3                                                         
         PSYS     0                                                             
OLAYFLAG EQU      'RWBF'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** RWBFIL **'                                                
*                                                                               
*   EXIT POINTS FROM OVERLAY                                                    
*                                                                               
RWBFX1   B        0,R4                                                          
RWBFX2   B        1,R4                                                          
RWBFX3   B        0,R5                                                          
RWBFX4   B        1,R5                                                          
RWBFX6   B        POSTEOD                                                       
RWBFX7   B        POST01                                                        
RWBFX5   RES      0                                                             
         LW,R12   R9                R12 = TYC                                   
RWBFX8   B        POST                                                          
RWBFX9   B        POST05            EOT                                         
         DO       #SYMB                                                         
RWBFX10  B        READWRIT                                                      
         FIN      #SYMB                                                         
         TITLE    '** RWBFIL - READ AND WRITE **'                               
***************                                                                 
*   WLBLOCK   *                                                                 
***************                                                                 
*                                                                               
*                                                                               
*   ROUTINE WRITES OUT THE CURRENT BLOCK OF A RAD FILE IF                       
*      SUCH ACTION IS APPROPRIATE                                               
*                                                                               
*   AT ENTRY:     R7   RFT INDEX                                                
*                 R4   LINK                                                     
*                 R1   FPT CODE NORMALLY                                        
*                      = -1 IF TERMING (TO IGNORE ERRORS)                       
*                                                                               
*   EXITS:        NO ERRORS:   LINK+1                                           
*                 ERRORS       LINK+0; ERROR CODE IN R9                         
*                                                                               
*                                                                               
WLBLOCK  LW,R15   RFT17,R7          BB CW ADDRESS                               
         BEZ      RWBFX2            TAKE NORMAL EXIT                            
         LW,R12   *R15              BB ADDRESS                                  
         CB,R7    R12               TEST FOR BB TIED TO RFT                     
         BNE      RWBFX2            NO, NORMAL RETURN                           
         PUSH     R5                                                            
         BAL,R5   WBLOCK            YES, WRITE IT OUT                           
         B        WLBLOCK2          ERROR                                       
         PULL     R5                                                            
WLBLOCK1 RES      0                                                             
         PUSH     8,R4              SAVE R4-R11                                 
         LI,R11   0                                                             
         STB,R11  RFT14,R7          ZERO JOB USING BLK BUFFER                   
         STW,R11  RFT17,R7          ZERO BBCW ADDRESS                           
         LW,R6    R15               R6= BBCW ADDRESS                            
         BAL,R11  RELADBUF          UNTIE AND RELEASE BB                        
         PULL     8,R4                                                          
         B        RWBFX2            RETURN                                      
*                                                                               
*                                                                               
WLBLOCK2 RES      0                                                             
         PULL     R5                RESTORE R5                                  
         CI,R1    -1                                                            
         BE       WLBLOCK1          B IF TERMING (IGNORE ERROR)                 
         B        RWBFX1            TAKE ERROR EXIT: TYC CODE IN R9             
         TITLE    '** RWBFIL - R/W BLOCKED AND COMPRESSED FILES **'             
**************                                                                  
*   RWBFIL   *                                                                  
**************                                                                  
*                                                                               
*   ROUTINE HANDLES PRELIMINARY SETUP REQUIRED FOR                              
*   BLOCKED AND COMPRESSED FORMAT FILES AND THEN                                
*   BRANCHES TO THE APPROPRIATE ROUTINE AS FOLLOWS...                           
*        RWBLKF        READ/WRITE BLOCKED FILES                                 
*        WRITCOMP      WRITE COMPRESSED FILE                                    
*        READCOMP      READ COMPRESSED FILE                                     
*                                                                               
*                                                                               
*   ENTRY TO RWBFIL IS FROM RWFILE OVERLAY.                                     
*                                                                               
*   ROUTINE EXITS TO ONE OF THE GENERAL POSTING ROUTINES.                       
*                                                                               
*                                                                               
RWBFIL   RES      0                                                             
         LB,R4    TCBPOINT          GET TASK ID                                 
         LB,R4    STIJID,R4         R4= CALLER'S JOB ID                         
         LW,R15   RFT17,R7          BB CW ADDRESS                               
         BEZ      %4003             B IF NONE                                   
         CB,R4    RFT14,R7          IS BLK BUFFER IN CALLER'S JOB               
         BNE      RWBFE5            NO, ERROR                                   
         CB,R7    *R15              TEST IF BUFFER STILL TIED                   
         BE       %4002             YES                                         
%4003    BAL,R5   FINDBB            NO, FIND A BUFFER                           
         B        RWBFE1            ERROR                                       
         LW,R6    R15               R6= BBCW ADDRESS                            
*   MAKE SURE WE HAVE NOT BEEN REENTERED                                        
         DISABLE                                                                
         LW,R0    RFT17,R7          IS THERE A BLK BUFFER NOW                   
         BEZ      %4003A            NO, OK TO PROCEED                           
         CB,R4    RFT14,R7          COMPARE JOB ID                              
         BNE      RWBFE3            ERROR, UNLIKE JOB IDS                       
         CB,R7    *R0               IS IT STILL TIED TO THE FILE                
         BNE      %4003A            NO, BRANCH                                  
         ENABLE                     YES, RELEASE THE NEW BB AND CONTINUE        
         PUSH     R11               SAVE RECORD SIZE                            
         BAL,R11  RELADBUF                                                      
         PULL     R11                                                           
         B        %4002                                                         
*                                                                               
%4003A   RES      0                                                             
         STB,R7   *R15              TIE BLOCKING BUFFER TO THIS FILE            
         LW,R12   *R15              GET BBCW IN R12                             
         STW,R15  RFT17,R7                                                      
         STB,R4   RFT14,R7          STORE JOB ID                                
         ENABLE                                                                 
         CI,R1    K10               IS FPT CODE FOR READ                        
         BE       %4003B            YES, READ A BLOCK ALWAYS                    
         MTH,0    RFT10,R7          TEST BLK BUFF POSITION                      
         BNEZ     %4003B            B IF NOT STARTING NEW BLOCK                 
         BAL,R4   TESTEOT           BE SURE NEW BLOCK IS IN FILE                
         LW,R15   RFT17,R7          RESTORE BBCW ADDRESS                        
         B        %4002                                                         
%4003B   RES      0                                                             
         BAL,R5   RBLOCK            READ A BLOCK                                
         B        RWBFX5            ERROR: REPORT TYC IN R9                     
* HERE R15 CONTAINS THE ADDR OF THE BB CONTROL WORD                             
*                                                                               
%4002    RES      0         BRANCH TO BLOCKED OR COMPRESSED FILE PROCESS        
        DO       #CFILES                                                        
         LB,R4    RFT7,R7           FETCH FLAG BYTE AND EXTRACT OUT             
         AND,R4   ORGMASK           THE ORG BITS                                
         CI,R4    COMPORG           IS THE FILE COMPRESSED ?                    
         BNE      RWBLKF            NO, BLOCKED FILE                            
         CI,R1    K10               IS THIS A READ REQUEST                      
         BNE      WRITCOMP          NO, PROCESS WRITE                           
         B        READCOMP          YES, BRANCH                                 
         ELSE     #CFILES                                                       
         B        RWBLKF            PROCESS AS BLOCKED FILE                     
         FIN      #CFILES                                                       
         SPACE 3                                                                
*                                                                               
*   ERROR PROCESSING                                                            
*                                                                               
RWBFE1   LI,R9    K55               ERROR, NO BLK BUF                           
         B        RWBFX5            B TO DCBERR                                 
*                                                                               
RWBFE3   ENABLE                                                                 
         BAL,R11  RELADBUF          RELEASE THE BLK BUFFER                      
RWBFE5   RES      0                                                             
         LI,R9    TYC6A             ERROR, CALLER IS WRONG MODE                 
         B        RWBFX5            TAKE ERROR EXIT                             
         TITLE    '** RWBFIL - READ/WRITE BLOCKED FILE ROUTINE **'              
************                                                                    
*  RWBLKF  *                                                                    
************                                                                    
*                                                                               
*                                                                               
*   ROUTINE READS/WRITES BLOCKED FORMAT FILES                                   
*                                                                               
*   ROUTINE  ENTERED FROM RWBFIL ROUTINE.                                       
*                                                                               
*   AT ENTRY:     R1     FPT CODE                                               
*                 R2     DCB ADDRESS                                            
*                 R3     FPT ADDRESS                                            
*                 R7     RFT INDEX                                              
*                 R10    BUFFER ADDRESS                                         
*                 R11    BYTE COUNT                                             
*                 R15    BLK BUFF CONTROL WORD ADDRESS                          
*                                                                               
*                                                                               
RWBLKF   RES      0                                                             
         CH,R11   RFT5,R7                                                       
         BLE      %+2               B IF USER BYTE COUNT OK                     
         LH,R11   RFT5,R7           USE ACTUAL RECORD SIZE                      
         LW,R12   *R15              GET BBCW IN R12                             
         LH,R6    RFT10,R7          CURRENT BLK BUFF POSITION                   
         AH,R6    RFT5,R7           PLUS REC SIZE= NEW BB POSITION              
         CI,R6    BBSIZE            IS NEW BB POS WITHIN THE BLOCK              
         BLE      RWBLKF8           YES, BRANCH                                 
*   WRITE THE CURRENT BLOCK AND INITIALIZE ASSOCIATED PARAMETERS.               
         BAL,R5   WBLOCK            WRITE THE CURRENT BLOCK                     
         B        RWBFX5             ERROR, R9=TYC                              
         BAL,R4   IBBPARAM          INCREMENT FILE POSITION, ETC.               
         BAL,R4   TESTEOT                                                       
         LW,R15   RFT17,R7          RESTORE BBCW ADDRESS                        
         CI,R1    K10               IS THIS A READ                              
         BNE      RWBLKF            B IF NOT                                    
*   READ THE APPROPRIATE BLOCK FOR THIS REQUEST                                 
         BAL,R5   RBLOCK            READ THE BLOCK                              
         B        RWBFX5             ERROR, R9=TYC                              
         B        RWBLKF            CONTINUE                                    
*                                                                               
*                                                                               
*                                                                               
RWBLKF8  RES      0                                                             
         STH,R6   RFT10,R7          UPDATE BB POSITION                          
         SH,R6    RFT5,R7           COMPUTE BB POSITION                         
         LW,R14   R11               BYTE COUNT                                  
         LW,R5    R10               BUFFER ADDR TO R5 (BYTE)                    
         CI,R1    K10               IS THIS A READ REQUEST                      
         BE       RWBLKF16          YES, BRANCH                                 
*                                                                               
*   WRITE                                                                       
*                                                                               
RWBLKF12 RES      0                                                             
         LB,R8    0,R5              GET BYTE                                    
         STB,R8   *R12,R6           PUT BYTE                                    
         AI,R5    1                                                             
         AI,R6    1                                                             
         BDR,R14  RWBLKF12          LOOP IF NOT FINISHED                        
         OR,R12   Y008              SET BB WRITTEN BIT                          
         STW,R12  *R15              STORE NEW BBCW                              
         B        RWBLKF20                                                      
*                                                                               
*   READ                                                                        
*                                                                               
RWBLKF16 RES      0                                                             
         LB,R8    *R12,R6           GET BYTE FROM BLK BUFFER                    
         STB,R8   0,R5              PUT BYTE IN USER BUFFER                     
         AI,R5    1                                                             
         AI,R6    1                                                             
         BDR,R14  RWBLKF16          LOOP IF NOT FINISHED                        
*                                                                               
*   CLEANUP AND EXIT                                                            
*                                                                               
RWBLKF20 RES      0                                                             
         MTW,1    RFT12,R7          INCREMENT RECORD NUMBER                     
         LW,R2    R2                                                            
         BGEZ     RWBFX7            POST01 IF NOT C READ                        
         LW,R6    R10                                                           
         LB,R4    0,R6              FIRST BYTE OF CC                            
         CI,R4    '!'                                                           
         BNE      RWBLKF24          B IF NOT BANG                               
         LI,R5    -4                                                            
         LB,R12   0,R6                                                          
         STB,R12  R0+1,R5                                                       
         AI,R6    1                 INCREMENT FROM                              
         BIR,R5   %-3                                                           
         CW,R0    EODREC            IS IT BANG EOD                              
         BE       RWBLKF28          BRANCH IF BANG EOD                          
         LI,R4    BA(CCBUF)                                                     
         LI,R14   80                                                            
         LW,R6    R10                                                           
         BAL,R9   MOVEBYTS                                                      
         LI,R4    1                                                             
         STW,R4   CFLAG                                                         
         LI,R12   K7                EOF TYC                                     
         B        RWBFX8            B TO POST                                   
*                                                                               
RWBLKF24 RES      0                                                             
         LI,R4    0                                                             
         STW,R4   CFLAG                                                         
         B        RWBFX7            POST 01                                     
*                                                                               
RWBLKF28 RES      0                                                             
         LI,R4    0                                                             
         STW,R4   CFLAG                                                         
         LI,R12   K6                EOD TYC                                     
         B        RWBFX8            B TO POST                                   
         TITLE    '** RWBFIL - TESTEOT SUBROUTINE **'                           
***************                                                                 
*   TESTEOT   *                                                                 
***************                                                                 
*                                                                               
*   ROUTINE TESTS FOR EOT WHEN READING OR WRITING BLOCKED OR                    
*   COMPRESSED FORMAT FILES.                                                    
*                                                                               
*                                                                               
TESTEOT  RES      0                                                             
         LI,R15   BBSIZE            BLK BUFF SIZE IN BYTES                      
         PUSH     R6                SAVE R6 OVER SECTPERN                       
         LB,R6    RFT8,R7           SET AREA INDEX                              
         BAL,R8   SECTPERN          GET SECTORS PER BLOCK IN R15                
         PULL     R6                RECOVER CALLER'S R6                         
         AW,R15   RFT11,R7          PLUS CURRENT POSITION IN SECTORS            
         AI,R15   -1                TO FIND LAST SECTOR OF BLOCK                
         AW,R15   RFT2,R7           ADD FILE BEGIN TO GET ACTUAL END            
         CW,R15   RFT3,R7           ARE WE STILL WITHIN THE FILE ?              
         BLE      0,R4              OK, EXIT                                    
*   HERE WE HAVE STRUCK EOT                                                     
         DO       #SYMB                                                         
         CI,R1    K10               IS THIS A READ                              
         BE       RWBFX6            YES, PROCESS EOT                            
*   STRUCK EOT ON A WRITE. TEST FOR SYMBIONT AREA.                              
         LB,R5    RFT8,R7           GET AREA INDEX                              
         LH,R5    MDNAME,R5                                                     
         AND,R5   M16               R5= AREA NAME                               
         CI,R5    KIS               IS IT THE IS AREA                           
         BE       TEST3             YES, BRANCH                                 
         CI,R5    KOS               NO, IS IT THE OS AREA                       
         BNE      TEST6             NO, PROCESS STANDARD EOT                    
*   STRUCK EOT ON A SYMBIONT AREA                                               
TEST3    RES      0                                                             
         BAL,R5   SMXTND            ALLOCATE A SYMBIONT EXTENSION               
         B        RWBFX8            ERROR, POST IT                              
         B        RWBFX10           ALLOCATED EXTENSION FILE                    
*                                   B TO RETRY THE WRITE.                       
         FIN      #SYMB                                                         
*   PROCESS STANDARD AREA EOT.                                                  
TEST6    RES      0                                                             
         LW,R5    RFTESZ,R7         EXTENT SIZE TO R5                           
         BEZ      RWBFX6            NOT EXTENSIBLE, PROCESS EOT                 
         MTW,-1   RFT6,R7           WRITE SO DECREMENT FILE SIZE                
         BAL,R8   RWEXTSEQ          ALLOCATE NEXT EXTENT                        
         B        TESTE6            +1..ERROR, R9=TYC                           
         B        RWBFX9            +2..UNABLE TO GET NEXT EXTENT               
*                                   +3..NEXT EXTENT IN THE RFT                  
RWBFX11  B        RWFIL9            B TO TRY REQUEST AGAIN                      
         SPACE 2                                                                
*                                                                               
*   ERROR PROCESSING FOR TESTEOT ROUTINE                                        
*                                                                               
TESTE6   RES      0                                                             
         CI,R9    TYCREENT          WERE WE REENTERED                           
         BE       RWBFX11           YES, RETURN TO RETRY REQUEST                
         B        RWBFX5                                                        
         TITLE    '** RWBFIL - WRITE COMPRESSED FILE ROUTINE **'                
****************                                                                
*   WRITCOMP   *                                                                
****************                                                                
*                                                                               
*   ROUTINE PROCESSES WRITE REQUESTS TO COMPRESSED FORMAT FILES.                
*                                                                               
*   ROUTINE ENTERED FROM RWBFIL ROUTINE                                         
*                                                                               
*   AT ENTRY:     R1     FPT CODE                                               
*                 R2     DCB ADDRESS                                            
*                 R3     FPT ADDRESS                                            
*                 R7     RFT INDEX                                              
*                 R10    BUFFER ADDRESS                                         
*                 R11    BYTE COUNT                                             
*                 R15    BLK BUFF CONTROL WORD ADDRESS                          
*                                                                               
*                                                                               
        DO       #CFILES            COMPRESSED FILE READ / WRITE                
*                                                                               
*                                                                               
WRITCOMP RES      0                                                             
         LW,R6    R15               SAVE BBCW ADDRESS IN R6                     
         BAL,R4   TESTEOT           TEST FOR EOT                                
         LW,R15   R6                R15= BBCW ADDRESS                           
         LW,R5    R10               BUFFER ADDRESS (FROM INDEX)                 
         LI,R0    0                 COUNT                                       
         LW,R13   R11               USER BYTE COUNT                             
WCOMP1   LB,R12   0,R5              GET BYTE                                    
         CI,R12   EOBCODE           A COMPRESSION CODE ?                        
         BL       WCOMP1B             NO, PACK AWAY                             
         CI,R12   CBFCODE           X'FA' <= CHAR <= X'FD' ?                    
         BG       WCOMP1B             NO, PACK AWAY                             
         AI,R0    1                 INCLUDE SPACE FOR 'CBFCODE' BYTE            
*                                                                               
WCOMP1B  RES      0         NO SPECIAL CHARACTER CODES: TEST FOR BLANKS         
         CI,R12   X'40'                                                         
         BNE      WCOMP2            B IF NOT EBCDIC BLANK                       
         AI,R5    1                 FROM INDEX                                  
         AI,R0    1                 COUNT                                       
         BDR,R13  %+2                                                           
         B        WCOMP10           B IF USER BUFFER EXHAUSTED                  
         LB,R12   0,R5              GET BYTE                                    
         CI,R12   X'40'                                                         
         BNE      WCOMP2            B IF NOT 2ND CONSEC BLANK                   
         AI,R0    1                 COUNT                                       
WCOMP3   AI,R5    1                 FROM INDEX                                  
         BDR,R13  %+2                                                           
         B        WCOMP10           B IF USER BUFFER EXHAUSTED                  
         LB,R12   0,R5                                                          
         CI,R12   X'40'                                                         
         BE       WCOMP3            LOOP IF ANOTHER BLANK                       
WCOMP2   AI,R5    1                 FROM INDEX                                  
         AI,R0    1                 COUNT                                       
         BDR,R13  WCOMP1            LOOP IF USER BUFFER NOT EXHAUSTED           
*                                                                               
*                                                                               
*        WE HAVE NOW VERIFIED THAT THE RECORD WILL FIT IN THE CURRENT           
*        BLOCKING BUFFER.  MOVE IT THERE.                                       
*                                                                               
WCOMP10  LW,R5    R10               USER BUFFER ADDRESS (FROM INDEX)            
         LW,R13   R11               USER BYTE COUNT                             
         LH,R4    RFT10,R7          BB POSITION (TO INDEX)                      
         LW,R14   *R15              BB ADDRESS                                  
         OR,R14   Y008                                     /SIG7-4351/*C5732    
         STW,R14  *R15              SET BB WRITTEN IN BIT  /SIG7-4351/*C5732    
         AH,R0    RFT10,R7          COUNT PLUS BB POSITION                      
         CI,R0    BBSIZE-1                                                      
         BGE      WCOMP11           B IF RECORD + 1 WONT FIT                    
WCOMP13  LB,R12   0,R5              GET BYTE                                    
         CI,R12   X'40'                                                         
         BE       WCOMP14           B IF BLANK                                  
*                                                                               
WCOMP13A RES      0         TEST CHARACTER AFTER A SINGLE BLANK                 
         CI,R12   EOBCODE           X'FA' =< CHAR =< X'FD' ?                    
         BL       WCOMP15             NO, STORE BYTE                            
         CI,R12   CBFCODE                                                       
         BG       WCOMP15                                                       
*                                                                               
         LI,R0    CBFCODE           INSERT SPECIAL CODE TO MAKE THE             
         STB,R0   *R14,R4           COMPRESSION CODE NOT BE SEEN                
         AI,R4    1                                                             
WCOMP15  AI,R5    1                 FROM INDEX                                  
WCOMP20  STB,R12  *R14,R4           SEND BYTE                                   
         AI,R4    1                                                             
         BDR,R13  WCOMP13           LOOP IF NOT DONE                            
         LI,R12   EORCODE                                                       
         STB,R12  *R14,R4           END OF RECORD CODE                          
         AI,R4    1                                                             
         STH,R4   RFT10,R7                                                      
         B        RWBLKF20          B TO FINISH CLEANUP, THEN EXIT              
*                                                                               
*                                                                               
WCOMP14  BDR,R13  %+2                                                           
         B        WCOMP15           B IF DONE                                   
         AI,R5    1                 FROM INDEX                                  
         LB,R12   0,R5              GET BYTE                                    
         CI,R12   X'40'                                                         
         BE       WCOMP16           B IF BLANK                                  
         LI,R6    X'40'             EBCDIC BLANK                                
         STB,R6   *R14,R4           SEND BLANK                                  
         AI,R4    1                 TO INDEX                                    
         B        WCOMP13A          TEST CHAR AFTER THE SINGLE BLANK            
*                                                                               
*                                                                               
WCOMP16  LI,R0    2                 SET BLANK COUNT 2                           
WCOMP19  AI,R5    1                 FROM INDEX                                  
         BDR,R13  %+2                                                           
         B        WCOMP18           B IF USER BUFFER EXHAUSTED                  
         LB,R12   0,R5              GET BYTE                                    
         CI,R12   X'40'                                                         
         BNE      WCOMP18           B IF NOT BLANK                              
         AI,R0    1                                                             
         B        WCOMP19                                                       
WCOMP18  LI,R6    BLFLAG                                                        
         STB,R6   *R14,R4           SEND BLANK FLAG                             
         AI,R4    1                                                             
WCOMP17  LW,R12   R0                BLANK COUNT TO R12                          
         AI,R13   1                                                             
         B        WCOMP20                                                       
WCOMP11  LI,R12   EOBCODE                                                       
         STB,R12  *R14,R4                                                       
         LW,R12   R14               BB ADDRESS                                  
*                                                                               
*                                                                               
*   R12= BBCW                                                                   
*   R15= BBCW ADDRESS                                                           
*                                                                               
         BAL,R5   WBLOCK                                                        
         B        RWBFX5              ERROR:    RETURN TYC IN R9                
         BAL,R4   IBBPARAM                                                      
         B        WRITCOMP                                                      
         TITLE    '** RWBFIL - READ COMPRESED FILE ROUTINE **'                  
****************                                                                
*   READCOMP   *                                                                
****************                                                                
*                                                                               
*   ROUTINE PROCESSES READ REQUESTS TO COMPRESSED FORMAT FILES.                 
*                                                                               
*   ROUTINE ENTERED FROM RWBFIL ROUTINE                                         
*                                                                               
*   AT ENTRY:     R1     FPT CODE                                               
*                 R2     DCB ADDRESS                                            
*                 R3     FPT ADDRESS                                            
*                 R7     RFT INDEX                                              
*                 R10    BUFFER ADDRESS                                         
*                 R11    BYTE COUNT                                             
*                 R15    BLK BUFF CONTROL WORD ADDRESS                          
*                                                                               
*                                                                               
READCOMP LW,R14   *R15              BB ADDRESS                                  
         LH,R5    RFT10,R7          BB POSITION (FROM INDEX)                    
         LW,R4    R10               USER BUFFER ADDRESS (TO INDEX)              
         LI,R13   0                 RESET FLAG                                  
         LB,R12   *R14,R5           GET BYTE                                    
         AI,R5    1                 FROM INDEX                                  
         CI,R12   EOBCODE                                                       
         BE       RCOMP1            B IF END OF BLOCK                           
*                                                                               
RCOMP5   EQU      %         TEST NEXT BYTE FOR CONTROL CHARACTERS               
         CI,R12   CBFCODE           NEXT BYTE CONTROL BYTE PREFIX ?             
         BNE      RCOMP10             NO, TEST AS USUAL                         
         LB,R12   *R14,R5             YES, STEP TO NEXT                         
         AI,R5    1                                                             
         B        RCOMP11           AND PROCESS AS A DATA BYTE                  
*                                                                               
RCOMP10  EQU      %         TEST FOR BLANK COMPRESSION                          
         CI,R12   BLFLAG            IS CHAR A BLANK COMPRESSION FLAG ?          
         BE       RCOMP2                                                        
RCOMP11  EQU      %                 TEST IF TO MOVE THE BYTE                    
         LW,R13   R13                                                           
         BLZ      RCOMP3            B IF FLAG SET                               
         STB,R12  0,R4              SEND BYTE                                   
         AI,R4    1                 TO INDEX                                    
         BDR,R11  RCOMP3                                                        
         OR,R13   Y8                SET FLAG IF USER COUNT ZERO                 
RCOMP3   LB,R12   *R14,R5           GET BYTE                                    
         CI,R5    BBSIZE            STILL WITHIN THE BLOCKING BUFF.             
         BG       RCOMP14           NO, TAKE ERROR EXIT (LOST DATA)             
         AI,R5    1                 FROM INDEX                                  
RCOMP4   CI,R12   EORCODE                                                       
         BNE      RCOMP5            B IF NOT END OF RECORD                      
         STH,R5   RFT10,R7          SET BB POSITION                             
         LW,R11   R4                TO INDEX                                    
         SW,R11   R10               MINUS BUFFER ADDR = COUNT                   
         LI,R12   1                 TYC                                         
         B        RWBLKF20          B TO FINISH CLEANUP, THEN EXIT              
*                                                                               
*                                                                               
RCOMP1   LW,R12   R14               BB ADDRESS                                  
         BAL,R5   WBLOCK            BB MAY HAVE BEEN WRITTEN IN                 
         B        RWBFX5              ERROR:    RETURN TYC IN R9                
         BAL,R4   IBBPARAM                                                      
         BAL,R5   RBLOCK                                                        
         B        RWBFX5              ERROR:    RETURN TYC IN R9                
         LW,R6    R15                                                           
         BAL,R4   TESTEOT                                                       
         LW,R15   R6                                                            
         B        READCOMP                                                      
*                                                                               
*                                                                               
RCOMP2   LB,R0    *R14,R5           GET BLANK COUNT                             
         AI,R5    1                 FROM INDEX                                  
         LI,R12   X'40'             EBCDIC BLANK                                
         LW,R13   R13                                                           
         BLZ      RCOMP3            B IF FLAG SET                               
RCOMP6   STB,R12  0,R4                                                          
         AI,R4    1                 TO INDEX                                    
         BDR,R11  RCOMP7                                                        
         OR,R13   Y8                SET FLAG                                    
         B        RCOMP3                                                        
*                                                                               
*                                                                               
RCOMP7   BDR,R0   RCOMP6            B IF MORE BLANKS                            
         B        RCOMP3                                                        
*                                                                               
*                                                                               
*   ERROR PROCESSING                                                            
*                                                                               
*                                                                               
RCOMP14  RES      0                                                             
         LI,R12   TYC02             SET TYC= LOST DATA                          
         B        RWBFX8            B TO POST                                   
        FIN      #CFILES                                                        
         PAGE                                                                   
****************                                                                
*   RELADBUF   *                                                                
****************                                                                
*                                                                               
*                                                                               
*   THIS ROUTINE UNDOES WHAT FINDBB DOES.                                       
*                                                                               
*    AT ENTRY:    R6   BB CONTROL WORD ADDRESS                                  
*                 R11  LINK                                                     
*   AT EXIT:                                                                    
*              BUFFER HAS BEEN RELEASED                                         
*                                                                               
*                                                                               
*                                                                               
RELADBUF RES      0                                                             
         PUSH     13,R7             SAVE R7-R15,R0-R3                           
         DISABLE                                                                
         LW,R11   0,R6              GET BUFFER CONTROL WORK                     
         BIFREAL  RELADB2           B IF USER REAL                              
         LW,R15   R11               BB ADDR TO R15                              
         AND,R15  M17               MASK                                        
         SLS,R15  -9                VIRTUAL PAGE NO.                            
         CI,R15   MMJRPLL           COMPARE WITH JRP LL                         
         BL       RELADB2C          B IF NOT IN JRP                             
         CI,R15   MMJRPUL           COMPARE WITH JRP UL                         
         BG       RELADB2C          B IF NOT IN JRP                             
*   GET ADDR OF BBCW TABLE                                                      
         LB,R1    TCBPOINT          TASK ID                                     
         LB,R1    STIJID,R1         JOB ID                                      
         LW,R1    SJI1,R1           JCB ADDRESS                                 
         LW,R1    JCBBBCT,R1        BBCW TABLE ADDRESS                          
*   TEST FOR BB PAIR                                                            
         CW,R11   Y004              IS THIS THE 1ST OF A PAIR                   
         BANZ     %+2               YES, DON'T ZERO 'RFT' & 'S'                 
         AND,R11  M17               NO, ZERO ALL BUT ADDRESS                    
         LW,R15   FFFFFE00          MASK FOR ADDR COMPARE                       
         LW,R9    R6                BB CONTROL WORD ADDR.                       
         AI,R9    -1                R9 POINTS TO PREVIOUS BBCW                  
         LW,R14   *R9               GET BB CONTROL WORD                         
         CS,R14   R11               IS IT IN SAME PAGE                          
         BE       RELADB1           YES, RELASE THE PAGE                        
         AI,R9    +2                R9 POINTS TO NEXT BBCW                      
         AND,R9   M17               MASK                                        
         LW,R0    R1                GET ADDR OF BBCW TABLE                      
         AND,R0   M17                                                           
         AI,R0    MAXBBS            ADDR OF LAST TABLE ENTRY                    
         CW,R9    R0                IS BBCW ADDR BEYOND TABLE END               
         BG       RELADB2           YES, DONE                                   
         LW,R14   *R9               GET BB CONTROL WORD                         
         CS,R14   R11               IS IT IN SAME PAGE                          
         BNE      RELADB2           NO, CANNOT RELEASE PAGE                     
*   HERE WE HAVE TWO BB'S IN THE SAME JOB RES. PAGE WHICH                       
*   ARE NOT TIED TO AN RFT ENTRY.  R6 AND R9 ARE                                
*   POINTERS TO THE 2 BLOCKING BUFFER CONTROL                                   
*   WORDS.                                                                      
RELADB1  RES      0                                                             
         SLS,R14  -9                VIRTUAL PAGE TO RELEASE                     
         LI,R0    0                                                             
         STW,R0   *R9               ZERO  THE BBCW'S WHICH                      
         STW,R0   0,R6               POINT TO THE PAGE TO RELEASE               
         MTW,-2   0,R1              DECREMENT BB COUNT BY 2                     
         ENABLE                                                                 
         BAL,R8   MMRJRP            RELEASE THE PAGE                            
         B        RELPERR           SYSTEM ERROR,CRASH                          
         B        RELADB3                                                       
*                                                                               
*                                                                               
*                                                                               
RELADB2  RES      0                                                             
         CW,R11   Y004              IS THIS A BLK BUFF PAIR                     
         BAZ      RELADB2C          NO, BRANCH                                  
         LW,R12   1,R6              YES, GET 2ND BB                             
         AND,R12  M17               ZERO ALL BUT ADDRESS                        
         STW,R12  1,R6              STORE IT BACK                               
RELADB2C RES      0                                                             
         AND,R11  M17               ZERO ALL BUT ADDRESS                        
         STW,R11  0,R6              STORE IT BACK                               
         ENABLE                                                                 
RELADB3  PULL     13,R7             RESTORE REGISTERS                           
FBBX3    B        *R11              RETURN                                      
*                                                                               
*                                                                               
RELPERR  RES      0                                                             
         CRASH    'RELADBUF ERR'                                                
         PAGE                                                                   
***********************                                                         
*   WBLOCK & RBLOCK   *                                                         
***********************                                                         
*                                                                               
*                                                                               
*   ENTRY REGISTERS:                                                            
*                                                                               
*        R3       FPT ADDRESS                                                   
*        R5       LINK                                                          
*        R7       RFT INDEX                                                     
*        R12      BLOCKING BUFFER CONTROL WORD                                  
*        R15      BBCW ADDRESS                                                  
*                                                                               
*   EXIT REGISTERS:                                                             
*                                                                               
*        R9       TYC CODE IF ERRORS; ELSE UNCHANGED                            
*                                                                               
*   EXITS:        LINK+1 IF NO ERRORS                                           
*                 LINK   IF ERRORS                                              
*                                                                               
*                                                                               
WBLOCK   CW,R12   Y008              HAS BB BEEN WRITTEN IN                      
         BAZ      RWBFX4            NO, NORMAL RETURN                           
         PUSH     16,R0                                                         
         LI,R4    FCWRAD            FUNC CODE                                   
         B        RWBLOCK                                                       
*                                                                               
RBLOCK   PUSH     16,R0             SAVE REGS                                   
         LI,R4    FCRRAD            FUNC CODE                                   
*                                                                               
RWBLOCK  LB,R6    RFT8,R7           MAST DICT INDEX                             
         LI,R11   BBSIZE            BYTE COUNT FOR A BLOCK                      
         LW,R10   R12               BB ADDRESS TO R10                           
         AND,R10  M17               MASK                                        
         SLS,R10  2                MAKE BYTE ADDRESS                            
         LW,R14   RFT11,R7          GET FILE POSITION                           
         CI,R4    FCWRAD            WRITE BB                                    
         BNE      %+3               NO                                          
         STW,R14  RFT6A,R7          YES, UPDATE RFT6A                           
         MTW,+1   RFT6A,R7          RFT11 IS REL 0                              
         BAL,R5   CVTFILE           CONVERT TO SEEK ADDRESS IN R12              
         B        RWBLERRX            ERROR OF SOME SORT: REPORT IT             
         LW,R8    CUPCOD4           CODE TO NOT POST FPT OR DCB                 
         LI,R15   -1                DON'T CHECK DIRECTORY REENTRANCE            
         BAL,R5   CALLQ                                                         
         B        RWBLERR           ERROR, ERROR CODE IN R6                     
         PULL     16,R0             RESTORE REGS                                
         AND,R12  FF7FFFFF          RESET BB WRITTEN IN BIT                     
         STW,R12  *R15              STORE UPDATED BBCW                          
         B        RWBFX4            NORMAL EXIT                                 
*                                                                               
*   ERROR PROCESSING                                                            
*                                                                               
RWBLERR  RES      0                                                             
         DISABLE                                                                
         STW,R6   TEMP              SAVE ERROR CODE                             
*                                                                               
RWBLERRC RES      0         COMMON CODE TO CLEAR STACK, SET TYC CODE            
         PULL     16,R0             RESTORE REGISTERS                           
         LW,R9    TEMP              SET TYC = TYC RETURNED BY CALLQ             
         ENABLE                                                                 
         B        RWBFX3            ERROR EXIT                                  
*                                                                               
RWBLERRX RES      0         ERROR FOUND IN SECTOR ADDRESS                       
         DISABLE                                                                
         STW,R15  TEMP              SAVE ERROR CODE                             
         B        RWBLERRC          DO COMMON REGISTER PULL                     
         PAGE                                                                   
****************                                                                
*   IBBPARAM   *                                                                
****************                                                                
*                                                                               
*  ROUTINE ZEROS THE BB POSITION (RFT10) AND INCREMENTS THE                     
*    FILE POSITION BY ONE BLOCK                                                 
*                                                                               
*   AT ENTRY:     R7   RFT INDEX                                                
*                 R4   LINK                                                     
*                                                                               
*                                                                               
*                                                                               
*                                                                               
IBBPARAM PUSH     R15               SAVE R15                                    
         PUSH     3,R6              SAVE R6-R8                                  
         LI,R6    0                 ZERO BLOCKING BUFFER POSITION               
         STH,R6   RFT10,R7                                                      
         LB,R6    RFT8,R7           SET AREA INDEX AND                          
         LI,R15   BBSIZE            BUFFER SIZE IN BYTES, THEN                  
         BAL,R8   SECTPERN          COMPUTE NUMBER OF SECTORS TO R15            
         AWM,R15  RFT11,R7          STEP FILE POS BY NUM SECTORS REQD           
         PULL     3,R6              RESTORE R6 AND R8 (AND R7)                  
         PULL     R15               AND THEN R15, TOO                           
         B        RWBFX1            RETURN                                      
*                                                                               
         OLAYEND                                                                
         END                                                                    
