*DECK,ROLLOUT 
USETEXT CYBRDEF 
USETEXT MISC$ 
USETEXT RBF$COM 
      PROC ROLLOUT; 
      BEGIN # ROLLOUT # 
*IF DEF,IMS 
 #
*1DC  ROLLOUT 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        ROLLOUT             FOX                 77/07/05 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        ROLLOUT DETERMINES IF A ROLLOUT SHOULD BE DONE. IF SO, IT ROLLS
*        OUT  RBF- AND CALLS -ROLLIN- TO MEM DOWN, WAIT AND ROLL BACK IN
*        IF A CIO ERROR IS DETECTED (EITHER A DISK ERROR OR A BAD CIO 
*        CALL) ROLLOUT/IN IS PERMANENTLY INHIBITED. 
* 
*     3. METHOD USED. 
*        ROLLOUT DOES THE FOLLOWING SEQUENCE -
*         A) FETCHES THE CURRENT FL 
*         B) REWINDS THE ROLL FILE
*         C) SAVES THE LAST WORD OF THE FL IN -LAST-
*         D) WRITES OUT LWA + 1 OF (0,0) THRU FL
*         E) INHIBITS ROLLIN/OUT IF CIO ERROR DETECTED = INHROLL TRUE 
*         F) SETS UP THE MEM DOWN CALL AND ROLL FET PARAMS FOR -ROLLIN- 
*         G) CALLS ROLLIN IMMEDIATELY IF ROLLOUT/IN IS NOT INHIBITED
* 
*     4. ENTRY PARAMETERS.
*        NONE 
* 
*     5. EXIT PARAMETERS. 
*        NONE 
* 
*     6. SYMPL TEXTS USED.
*        RBF$COM
*        CYBRDEF
*        MISC$
* 
*     7. ROUTINES CALLED. 
*        ROLLIN 
* 
*     8. DAYFILE MESSAGES.
*        "RBF DISK ERROR, CANNOT REDUCE SIZE" 
* 
 #
*ENDIF
  
      ARRAY GETACTIVITY;                   #CPM -GETACT- CALL WORD     #
         ITEM 
            PPACT            U (0,0,12),   #PP ACTIVITY                #
            MISCACT          U (0,12,24),  #K DISPLAY, CFO ETC         #
            GETACTWD0        U (0); 
      XREF ARRAY MEMUP;                    #MEM REQUEST FOR FL RESTORE #
         ITEM 
            MEMUP$FL         U (0,0,30),   #FL TO INCREASE UP TO       #
            MEMUP$JUNK       U (0,30,30),  #COMPLETE BIT ETC.          #
            MEMUP$WORD0      U (0); 
      XREF ARRAY MEMDN;                    #MEM REQUEST TO ROLLOUT TO  #
         ITEM 
            MEMDN$FL         U (0,0,30),   #FL TO ROLLOUT TO           #
            MEMDN$JUNK       U (0,30,30),  #COMPLETE BIT ETC.          #
            MEMDN$WORD0      U (0); 
      XREF ARRAY ROLLFET;                  #FET FOR THE RBF ROLLOUT    #
         ITEM 
            ROLL$LFN         C (0,0,7),    #ROLLOUT -LFN-              #
            ROLL$STATUS      U (0,42,18),  #FET STATUS FIELD           #
            ROLL$ERROR       U (0,46,4),   #FET ERROR FIELD            #
            ROLL$CODE        U (0,46,10),  #FET CODE AND STATUS FIELD  #
            ROLL$FETRAN      B (1,12,1),   #FET RANDOM BIT             #
            ROLL$FETLEN      U (1,36,6),   #FET LENGTH                 #
            ROLL$FIRST       U (1,42,18),  #FIRST                      #
            ROLL$IN          U (2),        #IN                         #
            ROLL$OUT         U (3),        #OUT                        #
            ROLL$LIMIT       U (4,42,18),  #LIMIT                      #
            ROLL$CRI         U (6,0,30),   #CURRENT RANDOM INDEX       #
            ROLL$WRITE       B (6,30,1),   #REWRITE REQUEST FLAG       #
            ROLL$INDEX       U (6,30,30),  #INDEX TO READ/WRITE        #
            ROLL$WORD6       U (6); 
      ITEM LAST;               # SAVE AREA FOR LAST WD OF FL           #
      XREF ITEM RPVROLL U;     # RBF REPRIEVED OR ROLLED IN/OUT FLAG   #
      XREF ITEM INHROLL B;     # INHIBIT ROLL IN/OUT FLAG              #
      DEF CIO$ERROR #ROLL$ERROR NQ 0#;
      XDEF LABEL ROLLRTN; 
      XREF ITEM ROLLFWA;       # FIRST WORD TO ROLL                    #
      XREF PROC ROLLIN; 
      XREF ITEM SRHTIME;
      XREF ITEM ROLL B; 
      DEF READSKP  # O"020" #;
      DEF WRITEF   # O"034" #;
      DEF REWIND   # O"050" #;
      XREF PROC SYSCALL;
      XREF PROC ENDRBF; 
      IF INHROLL
      THEN
        BEGIN 
        ROLL$MSG; 
        END 
      ELSE
        BEGIN 
        IF ROLL 
           AND
           SRHTIME GR 3 
        THEN
          BEGIN 
          MEMUP$WORD0 = ZERO; 
          SYSCALL("MEMP", LOC (MEMUP));          # GET CURRENT FL      #
          MEMUP$JUNK = ZERO;                     # CLEAR COMPLETE BIT  #
          LAST = MEMORY [MEMUP$FL - 1];          # SAVE LAST WORD IN FL#
          ROLL$FETLEN = 2;                       # ALLOW RANDOM I/O    #
          ROLL$FETRAN = TRUE; 
          ROLL$INDEX = 1;                        # REWIND FILE         #
          ROLL$WRITE = TRUE;                     # WRITE REQUEST       #
          ROLL$IN = MEMUP$FL - 1;                # SET UP FET POINTERS #
          ROLL$OUT = ROLLFWA; 
          ROLL$LIMIT = ROLL$IN + 1; 
          ROLL$STATUS = WRITEF; 
          SYSCALL("CIOP", LOC (ROLLFET));        # CALL CIO            #
          IF CIO$ERROR
          THEN
            BEGIN                                # WRITE ERROR         #
            INHROLL = TRUE;                      # DO NOT ROLL OUT     #
            ROLL$MSG;                            # ALERT OPERATOR      #
            END 
          ELSE
            BEGIN 
            ROLL$INDEX = 1;                      # REWIND FILE         #
            ROLL$STATUS = READSKP;               # SET UP FOR ROLLIN   #
            ROLL$IN = ROLL$FIRST;                # SET UF FET POINTERS #
            ROLL$OUT = ROLL$FIRST;
            MEMDN$FL = ROLLFWA;                  # MEM DOWN TO LWA(0,0)#
            MEMDN$JUNK = ZERO;
            RPVROLL = 1;       # RBF IS ROLLED OUT                     #
            END 
          END 
        END 
      ROLLIN;                              #RECALL A WHILE THEN ROLLIN #
ROLLRTN:                                   #THIS LABEL MUST GO RIGHT   #
                                           #AFTER THE ROLLIN CALL      #
      IF RPVROLL EQ 2 
      THEN                     # RBF REPRIEVED, TERMINATE EXECUTION    #
        BEGIN 
        ENDRBF; 
        END 
      IF NOT INHROLL AND RPVROLL EQ 1 
      THEN
        BEGIN #  RBF IS ROLLED OUT #
        MEMORY [MEMUP$FL - 1] = LAST; # RESTORE LAST WORD OF FL        #
        END 
      RPVROLL = 0;             # RBF ROLLED IN                         #
      RETURN; 
      CONTROL EJECT;
      PROC ROLL$MSG;
      BEGIN #ROLL$MSG#
      XREF PROC MESSAGE;
      ARRAY DSKERRMSG [0:0] S(5); 
        BEGIN 
        ITEM DSKTEXT C (0,0,40) = 
                          ["RBF DISK ERROR, CANNOT REDUCE SIZE."];
        ITEM DSKERR  U (4,0,60) = [0];
        END 
#                                                                     # 
      MESSAGE(DSKERRMSG,DFLOPT);
      RETURN; 
      END    #ROLL$MSG# 
      END  # ROLLOUT #
      TERM; 
