COMKARF 
COMMON
          CTEXT  COMKARF - ALLOCATE TAF/CRM RECOVERY FILES. 
          SPACE  4,10 
          BASE   D
*         COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          IF     -DEF,QUAL$ 
          QUAL   COMKARF
          ENDIF 
          SPACE  4,10 
***       AAF - ALLOCATE TAF/CRM RECOVERY FILES.
* 
*         L. E. LOVETT       80/04/01.
          SPACE  4,10 
***       AAF - ALLOCATE TAF/CRM RECOVERY FILES.
* 
*         THIS ROUTINE ALLOCATES BEFORE IMAGE AND AFTER IMAGE 
*         RECOVERY FILES WHICH ARE USED BY *TAF/CRM* RECOVERY.
*         DEPENDING ON AN ENTRY CODE ONE *BRF* AND ONE *ARF* IS 
*         ALLOCATED.  THE CALLER MUST MAKE THE FILE PERMANENT.
*         THE FILES WILL BE REWOUND BEFORE AND AFTER ALLOCATION.
*         AFTER IMAGE RECOVERY FILES WILL BE IN EMPTY CONDITION I.E.
*         *EOF* WILL BE WRITTEN IMMEDIATELY AFTER THE HEADER
*         RECORD. 
*         FIRST RECORD OF THE FILE ALLOCATED WILL BE A *HEADER* 
*         RECORD, WHICH IS SUPPLIED BY THE CALLER.
          SPACE  4,10 
**        AAF - ALLOCATE TAF/CRM RECOVERY FILES.
* 
*         THE FILE HEADER MUST BE SET BY THE CALLER AS IT WILL
*         APPEAR ON THE FILE, EXCEPT THE CREATION DATE AND TIME  FIELD
*         IS SET BY THE APPROPRIATE SUBROUTINE OF *ARF*.
* 
*         ENTRY  (A0) = FWA OF FILE FET.
*                (A5) = FWA OF FILE HEADER. 
*                (X5) = FIRST WORD OF FILE HEADER.
*                (B1) = 1.
*                (B7) = ENTRY CODE. 
*                     = 0, TO ALLOCATE A AFTER IMAGE RECOVERY FILE. 
*                     = 1, TO ALLOCATE A BEFORE IMAGE RECOVERY FILE.
* 
*         EXIT   (X6) = EXIT CONDITION. 
*                     = 0, IF NO ERRORS ENCOUNTERED.
*                     > 0, CONTAINS CIO ERROR CODE. 
*                     < 0, IF CONTENTS OF B7 ARE INVALID UPON ENTRY.
* 
*         USES   X - NONE.
*                B - 6. 
*                A - NONE.
* 
*         CALLS  ALF, AQF, QSF. 
  
 AAF      SUBR   ENTRY/EXIT 
          RJ     QSF         PRESET FET FIELDS
          NZ     X6,AAFX     IF *CIO* ERRORS ON REWIND - RETURN 
          SB6    0           REQUEST CODE 0 
          NE     B7,B6,AAF1  IF REQUEST CODE NOT 0
          RJ     ALF         ALLOCATE *ARF* 
          EQ     AAFX        RETURN 
  
 AAF1     SB6    B6+1        REQUEST CODE 1 
          NE     B7,B6,AAF2  IF REQUEST CODE NOT 1
          RJ     AQF         ALLOCATE *BRF* 
          EQ     AAFX        RETURN 
  
 AAF2     SX6    -1 
          EQ     AAFX        RETURN TO CALLER, WITH ERROR INDICATION
  
 AAFA     CON 0  CURRENT PDATE
          SPACE  4,10 
**        ALF - ALLOCATE AFTER IMAGE RECOVERY FILE. 
* 
*         THIS SUBROUTINE ALLOCATES ONE AFTER IMAGE RECOVERY FILE 
*         FOR TAF/CRM.
*         THE FILE TO PREALLOCATE MUST HAVE BEEN REWOUND
*         BY THE CALLER.
* 
*         ENTRY  (A0) = FWA OF FILE FET.
*                (A5) = FWA OF FILE HEADER. 
*                (X5) = FIRST WORD OF FILE HEADER.
*                (B1) = 1.
* 
*         EXIT   (X6) = EXIT CONDITION. 
*                       0 IF NO ERRORS ENCOUNTERED. 
*                       .NE. 0 CONTAINS CIO ERROR CODE. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6.
*                B - 6, 7.
*                A - 1, 2, 5, 6.
* 
*         CALLS  QER, RFH.
* 
*         MACROS REWIND, REWRITEF, REWRITER, WRITE. 
  
 ALF      SUBR               ENTRY/EXIT 
          MX6    0
          SA1    A0+B1       FIRST
          SA2    A0+4        LIMIT
          SX1    X1 
          SX2    X2 
          IX2    X2-X1       AMOUNT OF BUFFER SPACE IN WORDS
          BX0    X2          (X0) = AVAILABLE BUFFER SPACE
          SB6    X2-1        SET COUNT OF WORDS TO ZERO OUT 
 ALF1     SA6    X1+B6       CLEAR ENTIRE BUFFER
          SB6    B6-B1
          PL     B6,ALF1     IF MORE TO ZERO OUT
          MX5    -TAFLN      MASK FOR FILE LENGTH 
          SA2    A5+TAFLW-TAFNW 
          AX2    TAFLS-TAFLN+1
          BX2    -X5*X2      EXTRACT FILE LENGTH (PRU-S)
          SX5    B1+
          IX5    X2+X5       ADD ONE PRU FOR HEADER RECORD
          EQ     ALF3        ENTER FILE PREALLOCATION LOOP
  
 ALF2     SA2    A0 
          LX2    59-0        COMPLETE BIT FROM FET
          PL     X2,ALF3     IF IO NOT COMPLETE 
          RJ     QER         CHECK FOR IO ERRORS ON FILE
          NZ     X6,ALFX     IF CIO ERRORS - RETURN 
          WRITE  A0 
 ALF3     ZR     X5,ALF7     IF NO MORE PRU*S TO ALLOCATE 
          SA1    A0+2        IN 
          SA2    A1+B1       OUT
          IX2    X2-X1       COMPUTE EMPTY SPACE
          SB7    X2+
          GT     B7,ALF4     IF NO WRAP AROUND
          IX2    X2+X0       SUBTRACT FROM TOTAL SPACE
 ALF4     SX6    X2-64
          NG     X6,ALF2     IF LESS THAN ONE PRU 
          AX2    6           WORDS TO PRUS
          IX3    X5-X2
          PL     X3,ALF5     IF AVAILABLE PRU*S .LE. REQUIRED PRU*S 
          SX2    X5+         CHANGE AVAILABLE PRU*S TO REQUIRED PRU*S 
 ALF5     SB7    X2+         SET DECREMENT COUNT
          LX2    6
          IX6    X1+X2       IN = IN + AVAILABLE SPACE
          SA1    A2+B1       LIMIT
          SX1    X1 
          IX3    X6-X1       IN - LIMIT 
          SA2    A0+B1       FIRST
          NG     X3,ALF6     IF NO WRAP AROUND
          SX2    X2 
          IX6    X2+X3       RECOMPUTE IN 
 ALF6     SA6    A2+B1       SET IN POINTER 
          SX2    B7 
          IX5    X5-X2       DECREMENT PRU COUNT
          NZ     X5,ALF2     IF MORE PRU-S TO ALLOCATE
          SB7    X6          SAVE LAST *IN* PIONTER 
          RECALL A0          WAIT FOR COMPLETION
          SA1    A0+3        *OUT*
          SX2    B7          LAST *IN*
          BX1    X1-X2
          NZ     X1,ALF2     IF I/O COMPLETED BEFORE LAST *IN* STORED 
* 
*         WRITE FILE HEADER.
* 
 ALF7     RECALL A0 
          RJ     QER         FETCH CIO STATUS 
          NZ     X6,ALFX     IF CIO ERROR - RETURN
          REWIND A0,R 
          RJ     RFH         REWRITE FILE HEADER
          EQ     ALFX        RETURN 
          SPACE  4,10 
**        AQF - ALLOCATE BEFORE IMAGE RECOVERY FILE.
* 
*         THIS SUBROUTINE ALLOCATES ONE BEFORE IMAGE RECOVERY FILE FOR
*         TAF/CRM RECOVERY. 
*         THE FILE TO PREALLOCATE MUST BE REWOUND BY THE CALLER.
*         THE BRF BUFFER SIZE IS ASSUMED TO BE AN EVEN
*         MULTIPLE OF 64 WORDS (SEE *IAM* BRF BUFFER ALLOCATION). 
* 
*         ENTRY  (A0) = FWA OF FILE FET.
*                (A5) = FWA OF FILE HEADER. 
*                (X5) = FIRST WORD OF FILE. 
*                (B1) = 1.
* 
*         EXIT   (X6) = EXIT CONDITION. 
*                       0 IF NO ERRORS. 
*                       .NE. 0 CONTAINS CIO ERROR CODE. 
* 
*         USES   X - 1, 2, 5, 6.
*                B - 6. 
*                A - 1, 2, 5, 6.
* 
*         CALLS  QSF, QER.
* 
*         MACROS PDATE, REWIND, WRITER. 
  
 AQF      SUBR               ENTRY/EXIT 
          SB6    TQHDL-1     FILE HEADER LENGTH 
          PDATE  AAFA        PACKED DATE/TIME 
          SA2    AAFA        PACKED DATE/TIME 
          SA1    A5+TQCDW-TQFNW 
          LX2    TQCDS-35    POSITION DATE/TIME 
          MX6    36 
          BX1    -X6*X1 
          BX6    X1+X2       MERGE DATE/TIME
          SA6    A1          CREATION DATE/TIME TO HEADER 
          SA1    A0+B1       FIRST
 AQF1     SA2    A5+B6       MOVE HEADER TO FILE BUFFER 
          BX6    X2 
          SA6    X1+B6
          SB6    B6-B1       DECREMENT COUNT REMAINING
          PL     B6,AQF1     IF MORE HEADER REMAINS 
          SX6    X1+TQHDL    FIRST + HEADER LENGTH
          SA6    A1+B1       SET IN 
          WRITER A0,R 
          RJ     QER         FETCH CIO STATUS 
          NZ     X6,AQFX     IF CIO ERROR - RETURN
          SA2    A5+TQNSW-TQFNW 
          SX5    X5+
          AX2    30          NUMBER OF SEGMENTS 
          IX2    X2*X5       NUMBER OF RECORDS TO WRITE 
          SA5    A0+4 
          SA1    A0+B1       FIRST
          SX5    X5 
          SX1    X1 
          IX5    X5-X1       LIMIT - FIRST
          SB6    X5-1        NO OF WORDS TO ZERO OUT
 AQF2     SA6    X1+B6       CLEAR BUFFER AREA
          SB6    B6-B1
          PL     B6,AQF2     IF NOT COMPLETE
          SB6    X2+         SET NUMBER OF RECORDS TO WRITE 
          SA2    A0+4        LIMIT
 AQF3     SX6    X2-2        INSURE WORDS NOT MULTIPLE OF 64
          SA6    A0+2        IN 
          SX6    X1 
          SA6    A6+B1       SET OUT = FIRST
          SA1    X1+5        SET RECORD NUMBER
          SX6    X1+B1       UPDATE RECORD COUNT
          SA6    A1          RECORD NUMBER TO FET 
          WRITER A0,R 
          RJ     QER         FETCH CIO STATUS 
          NZ     X6,AQFX     IF CIO ERROR - RETURN
          SA2    A0+4        LIMIT
          SA1    A0+B1       FIRST
          SB6    B6-B1       DECREMENT RECORD COUNT 
          NE     B6,B0,AQF3  IF MORE RECORDS TO WRITE 
          SX2    B1 
          LX2    45-0        UP BIT 
          BX6    -X2*X1      CLEAR UP BIT 
          LX2    47-45-0     R BIT
          BX6    X1+X2       SET R BIT
          SA6    A1+
          REWIND A0,R 
          RJ     QER         FETCH CIO STATUS 
          EQ     AQFX        RETURN 
          SPACE  4,10 
**        RFH - REWRITE THE FILE HEADER ON AN *ARF* FILE. 
* 
*         THIS SUBROUTINE CLEARS THE *UP* BIT, SETS THE *R* BIT,
*         PACKS THE DATE/TIME THEN REWRITES THE FILE HEADER.  AN
*         *EOF* MARKER IS WRITTEN AFTER THE HEADER. 
* 
*         ENTRY  (A0) = FWA OF FILE FET.
*                (A5) = FWA OF FILE HEADER. 
*                (B1) = 1.
*                (ARFA) = PACKED DATE/TIME. 
* 
*         EXIT   (X6) = 0 - IF NO ERRORS. 
*                       .NE. 0 IF CIO ERRORS. 
*                FILE HEADER REWRITTEN FOLLOWED BY *EOF* MARKER.
* 
*         USES   X - 1, 2, 6. 
*                B - 1, 6.
*                A - 1, 2, 6. 
* 
*         CALLS  QER. 
* 
*         MACROS PDATE, REWRITER, REWRITEF, REWIND. 
  
 RFH      SUBR               ENTRY/EXIT 
          PDATE  AAFA 
          SA1    A0+B1
          MX2    59 
          LX2    45-0        UP BIT 
          BX1    X2*X1       CLEAR UP BIT 
          LX2    47-45-0     R BIT
          BX6    -X2+X1      SET R BIT
          SA2    AAFA        PACKED DATE/TIME 
          SA6    A1 
          BX6    X2 
          SA6    A5+TACDW-TAFNW 
          SB6    TAHDL-1     FILE HEADER LENGTH 
 RFH1     SA2    A5+B6       MOVE FILE HEADER TO FILE BUFFER
          BX6    X2 
          SA6    X1+B6
          SB6    B6-B1
          PL     B6,RFH1     IF NOT COMPLETED 
          SA1    A1+B1
          SX6    X1+TAHDL 
          SA6    A1          SET IN 
          REWRITER  A0,R     WRITE FILE HEADER IN PLACE 
          REWRITEF  A0,R     WRITE *EOF* TO SET FILE EMPTY
          REWIND A0,R 
          RJ     QER         FETCH CIO STATUS 
          EQ     RFHX        RETURN 
          SPACE  4,10 
**        QER - CHECK CIO ERROR ON FILE.
* 
*         RETURNS CIO ERROR CODE TO CALLER. 
* 
*         ENTRY  (A0) = FWA OF FET. 
* 
*         EXIT   (X6) = CIO ERROR CODE. 
* 
*         USES   X - 1, 6.
*                B - NONE.
*                A - 1. 
* 
*         CALLS  QER. 
  
 QER      SUBR               ENTRY/EXIT 
          SA1    A0 
          MX6    -4 
          AX1    10 
          BX6    -X6*X1      CIO ERROR CODE 
          EQ     QERX        RETURN 
          SPACE  4,10 
**        QSF - PRESET FET FIELDS.
* 
*         SETS/CLEARS THE FOLLOWING FET FIELDS: 
*                SET EP AND UP BITS.
*                CLEARS R BIT, AND CURRENT RANDOM INDEX.
*                SET FILE NAME. 
*         IT ALSO REWINDS THE FILE. 
* 
*         ENTRY  (A0) = FWA OF FILE FET.
*                (X5) = FILE NAME.
*                (B1) = 1.
* 
*         EXIT   (X6) = CIO ERROR CODE. 
* 
*         USES   X - 0, 1, 6. 
*                B - NONE.
*                A - 1, 6.
* 
*         CALLS  NONE.
* 
*         MACROS REWIND.
  
 QSF      SUBR               ENTRY/EXIT 
          MX0    42          FILE MASK
          BX6    X0*X5
          SA1    A0 
          BX1    -X0*X1 
          BX6    X1+X6
          SA6    A0          FILE NAME TO FET 
          MX0    1
          SA1    A1+B1       FET+1
          LX0    48-0        R BIT
          BX1    -X0*X1      CLEAR R BIT
          SX6    3
          LX6    44-0        EP, UP BITS
          BX6    X1+X6       SET EP AND UP BITS 
          SA6    A1 
          BX6    X6-X6
          SA6    A0+6        CLEAR CURRENT RANDOM INDEX 
          REWIND A0,R 
          RJ     QER         CHECK CIO ERROR
          EQ     QSFX        RETURN 
          SPACE  4,10 
          BASE   *
QUAL$     IF     -DEF,QUAL$ 
          QUAL   *
 AAF      EQU    /COMKARF/AAF 
 RFH      EQU    /COMKARF/RFH 
QUAL$     ENDIF 
          ENDX
