*M*      CFUR     CFU AREA RECONSTRUCTION MODULE.
CFUR:    EQU      %
         PCC      0
         DEF      CFUR:             FOR MODULE PATCHING PURPOSES
         DEF      CFUGARB           ONLY MODULE ENTRY POINT
         SYSTEM   SIG7FDP
UTSPROC  SET      0
MONPROC  SET      1
         SYSTEM   UTS
PUSH     CNAME    X'0B'
PULL     CNAME    X'0A'
         PROC
LF       EQU      %
TMP      SET      -2
         DO       NUM(AF)>1
         DO       AF(1)<16
         LCI      AF(1)
         ELSE
         LCI      0
         FIN
TMP      SET      0
         FIN
         GEN,8,4,20 NAME+TMP,AF(NUM(AF)),TSTACK
         PEND
         TITLE    '    CFU AREA RECONSTRUCTION MODULE  '
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
         REF      TSTACK            STACK IN JIT
         REF      BGRCFU            1ST USER CFU LOCATION
         REF      ACNCFU            ACCOUNT CFU
         REF      LASTCFU           END OF USER CFU AREA
         REF      CFUSIZE           # OF WORDS IN A USER CFU
         REF      Y4                BIT 1
         REF      J:BASE            SCRATCH STORAGE IN JIT
         REF      SRT               SCHED REAL TIME STATE #
         REF      E:AP              ASSOCIATE PROCESSOR CODE
         REF      SB:HQ             SCHEDULER STATE TABLE
         REF      GARBTIME          ACCUMULATE TICKS FOR TIME
*,*                                 IN THIS MODULE
         REF      MASKS             TABLE IN TABLES
         REF      T:REG             REPORT EVENT & GIVE UP
         REF      Y03               BITS 2 & 3
         REF      S:CLOCK4          CLOCK4 DIRECTOR
*
*P*
*P*      NAME:    CFUR
*P*
*P*      PURPOSE: TO RECOVER THE CURRENTLY UNUSED SPACE IN
*P*               THE CFU AREA.
         PAGE
         PAGE
         DO       0
CFUINIT  PUSH     4,0
         LI,0     LASTCFU+21-BGRCFU
         SLS,0    1
         AI,0     LASTCFU+21-BGRCFU
         SLS,0    -3                3/8 IS 1ST GUESS
         AI,0     BGRCFU
         LI,1     BGRCFU
         LI,2     X'FF00'
CFUIN1   CW,1     0
         BLE      CFUIN2            GET ANOTHER 8 WORDS
         AI,1     -1
         SLS,1    -1
         SLS,1    1
         STW,1    ACNCFU+13
         REF      SYSACCT
         LI,1     1**16
         STW,1    ACNCFU+14
         LI,1     1
         LD,2     SYSACCT           1ST ACCT ENTRY
         STD,2    *ACNCFU+13,1       IS :SYS
         LI,1     LASTCFU+23
         SW,1     ACNCFU+13
         SLS,1    -3
         AW,1     ACNCFU+13
         SLS,1    -1
         SLS,1    1
         STW,1    ACNCFU+16            1ST NAME LOC
         STW,1    ACNCFU+15
         PULL     4,0
         B        *11
CFUIN2   STW,2    0,1
         AI,1     8                 NXT CFU POS'N
         B        CFUIN1
         FIN
         PAGE
ID       EQU      2                 ID WORD IN CFU
ACT      EQU      0                 ACTIVITY WORD IN CFU
#CS      EQU      R5                # OF POTNTIAL 8 WORD BLOCKS
XCS      EQU      D3                COUNT OF 8 WRD BLKS TO GO
         OPEN     CFU
CFU      SET      R4                8 WD BLK POINTER
ABIT     EQU      D4                ACTIVE CFU BIT HERE
OFS      SET      R0  LENGTH OF OFFSET FOR NAME OR ACCT POSN
PTR      SET      R2  POINTER TO CURRENT NAME OR ACCOUNT
LEN      SET      R1  LENGTH OF CURRENT NAME
#OFCLSES EQU      ACNCFU+12  # OF CLOSES OR OPEN ABORTS WHICH MAY
*  HAVE FREED UP A NAME OR ACCOUNT SPACE SINCE LAST COLLECTION.
STRTACCS EQU      ACNCFU+13  DBLWD ADDR PRIOR TO START OF ACCTS
#ACCTS   EQU      ACNCFU+14  NUMBER OF ACCOUNT ENTRIES IN CFU AREA.
STRTNAMS EQU      ACNCFU+15  WORD ADDRESS OF 1ST NAME IN CFU AREA
EOFNAMS  EQU      ACNCFU+16  WORD ADDRESS OF NEXT SPACE AVAILABLE
*  FOR A NAME INSERTION IN THE CFU AREA.
WANT     EQU      J:BASE+6          NEG=CFU BLK,0=ACCT,POS=NAME
NAMLEN   EQU      J:BASE+9          NEW NAME LENGTH
LSTACCT  EQU      J:BASE+8          LAST ACCT LOC
         SPACE    3
*D*
*D*      NAME:    CFUGARB
*D*
*D*      REGISTERS: 6,7,8,9,11,12,& 13 ARE SAVED
*D*                 ALL OTHERS ARE VOLATILE.
*D*
*D*      CALL:    LOAD REGISTER 0 WITH NEGATIVE FOR A CFU BLOCK
*D*               REQUEST, ZERO FOR AN ACCOUNT DOUBLEWORD
*D*               REQUEST, OR POSITIVE FOR A NAME REQUEST.
*D*               REGISTER 11(SR4) IS THE LINK REGISTER.
*D*               ON RETURN, J:BASE+9 HAS THE REQUIRED ITEM
*D*               OR IS ZERO IF THE ENTIRE CFU AREA IS FULL.
*D*
*D*      DESCRIPTION: THE CFU AREA IS ORDERED TO ASCERTAIN
*D*               ANY UNUSED AREA.  THE CONTROL POINTERS
*D*               IN THE ACCOUNT CFU ARE MODIFIED TO INDICATE
*D*               THE CLEANED UP STATE OF AFFAIRS.
*D*
         SPACE    3
CFUGARB  RES      0                 GARBAGE COLLECT CFU AREA
         SPACE    3
         LW,SR3   *S:CLOCK4         GET THE TIME
         PUSH     8,R6               & SAVE IT
         STW,R0   WANT              CFU, ACCT, OR NAME
         LW,ABIT  Y4                ACTIVE CFU BIT
         LW,#CS   STRTACCS          END OF 8 WD BLKS
         AI,#CS   2-BGRCFU
         SLS,#CS  -3                # OF 8 WD BLKS
         SPACE    3
*  RESTART POINT IF WE HAD TO LET THE REAL TIME IN.
REGRTN   LI,R1    X'FFFF'
         AND,R1   #OFCLSES          # OF CLOSES SINCE
         BEZ      GG1                LAST GARB COLL
         SPACE    3
*  THERE IS PROBABLY SOME NAME & ACCT SPACE TO BE COLLECTED.
         LW,R2    WANT
         BGZ      GB0               TRY 4 A NAME SPACE ONLY
         PAGE
*  TRY TO FREE UP SOME ACCOUNT SPACE.
GA0      LI,PTR   2**16             SKIP OVER :SYS
         LI,PTR+1 X'F0000'          ACT INDEX IN HI HALFWD
         LI,R6    SRT               SCHEDULED REAL TIME Q
GA13     RES      0                 CHK SCHEDULED REAL TIME
         LB,SR1   SB:HQ,R6
         BEZ      %+2               BR IF NO REAL TIME
         B        REG   ***LET THE REAL TIME IN***
         LW,XCS   #CS               # OF 8 WD BLKS
         LI,CFU   BGRCFU            1ST 8 WD BLK
GA11     CS,PTR   ID,CFU            CHK THIS ACT
         BNE      GA2               BR IF NO HIT
         CW,ABIT  ACT,CFU           CHK IF ACTIVE
         BANZ     GA12              BR IF ACTIVE
         STW,ABIT ID,CFU            BLITZ THE ID
GA2      AI,CFU   CFUSIZE           NEXT 8 WD BLK
         BDR,XCS  GA11              BR IF THERE IS ANOTHER
*  WE HAVE FOUND THE FIRST INACTIVE ACCOUNT
         LI,OFS   (-1)**16          INIT # OF POSITIONS TO MOVE
         B        GA16              ENTER MAIN LOOP
*  ALL ACCOUNTS ARE STILL ACTIVE.
GA12     AI,PTR   1**16             MOVE TO NEXT ACCT
         CW,PTR   #ACCTS            IS THERE ANOTHER ACCT
         BLE      GA13              BRANCH IF THERE IS
*  THERE IS NO ACCOUNT SPACE TO FREE UP.
         SPACE    3
*  WE HAVE COMPLETED COLLECTION ON THE ACCOUNT AREA.
GA15     LW,D3    WANT
         BGZ      GC1               NAMES ALREADY DONE
         BLZ      GB0               WE NEED AN 8 WORDER
         AI,OFS   0                 DID WE RECOVER ANY ACCTS?
         BLZ      GD5               YUP-AT LEAST 1
         B        GG1               TRY FOR A CFU BLOCK
         SPACE    3
*  AT LEAST ONE INACTIVE ACCOUNT HAS BEEN FOUND.
GA23     RES      0                 CHK SCHEDULED REAL TIME
         LB,SR1   SB:HQ,R6
         BEZ      %+2               BR IF NO REAL TIME
         B        REG   ***LET THE REAL TIME IN***
         LW,XCS   #CS               # OF 8 WD BLKS
         LI,CFU   BGRCFU            1ST 8 WD BLK
GA21     CS,PTR   ID,CFU            CHK THIS ACCT
         BNE      GA6               BR IF NO HIT
         CW,ABIT  ACT,CFU           IS THE CFU ACTIVE
         BANZ     GA22              BR IF ACTIVE
         STW,ABIT ID,CFU            BLITZ THE ID
GA6      AI,CFU   CFUSIZE           NEXT 8 WD BLK
         BDR,XCS  GA21              BR IF THERE IS 1
*  THIS ACCOUNT IS NO LONGER ACTIVE.
         AI,OFS   (-1)**16          INCREMENT MOVE COUNT
GA16     AI,PTR   1**16             NEXT ACCT LOC
         CW,PTR   #ACCTS            IS THERE ANOTHER
         BLE      GA23              BRANCH IF THERE IS
         AWM,OFS  #ACCTS            NEW # OF ACCTS
         B        GA15              WE'RE DONE WITH ACCTS
         SPACE    3
*  AN ACTIVE ACCOUNT HAS BEEN FOUND AND MUST BE MOVED
*  UPWARDS IN THE CFU ACCOUNT AREA.
GA22     LH,R1    PTR               INDEX FOR ACCT
         LD,SR1   *STRTACCS,R1      GET THE ACCT
         AH,R1    OFS               NEW INDEX FOR ACCT
         STD,SR1  *STRTACCS,R1      PUT IT IN ITS NEW PLACE
         B        GA24              ENTER LAST LOOP
*
GA25     CS,PTR   ID,CFU            CHK THIS ACCT
         BNE      GA61              BR IF NO HIT
GA24     AWM,OFS  ID,CFU            PUT IN NEW INDEX
GA61     AI,CFU   CFUSIZE           NEXT 8 WD BLK
         BDR,XCS  GA25              BR IF THE IS 1
         B        GA16              TO CHK FOR THE END
*
         PAGE
*  TRY TO FREE UP SOME NAME SPACE.
GB0      LI,PTR+1 X'FFFF'           NAME PTR IN LO HALFWORD
         LW,PTR   STRTNAMS          1ST NAME LOC IN CFU AREA
         LI,R6    SRT               SCHEDULED REAL TIME Q
GB13     LB,LEN   *PTR              TEXTC COUNT OF NAME
         SLS,LEN  -2                # WDS IN NAME -1
         AI,LEN   1                 # WDS IN NAME
*  CHECK SCHEDULED REAL TIME
         LB,SR1   SB:HQ,R6
         BEZ      %+2               BR IF NO REAL TIME
         B        REG   ***LET THE REAL TIME IN***
         LW,XCS   #CS               # OF 8 WD BLKS NOW
         LI,CFU   BGRCFU            1ST 8 WD BLOCK
GB11     CS,PTR   ID,CFU            CHK THE NAME
         BNE      GB2               BR IF NO HIT
         CW,ABIT  ACT,CFU           IS THE CFU ACTIVE
         BANZ     GB12              BR IF IT IS
GB2M1    STW,ABIT ID,CFU            BLITZ THE ID
GB2      AI,CFU   CFUSIZE           NEXT 8 WD BLK
         BDR,XCS  GB11              BR IF THERE IS ANOTHER BLK
*  WE HAVE FOUND THE FIRST INACTIVE NAME
         CI,LEN   8                 CHK THE NAME LENGTH
         BLE      %+2               SKIP IF OK
         LI,LEN   1                 PASS OVER 1 AT A TIME
         LCW,OFS  LEN               INITIALIZE # OF WDS TO SLIDE
         B        GB16              ENTER MAIN LOOP
*
GB12     CI,LEN   8
         BG       GB2M1             NAME LENGTH TOO LONG
         AW,PTR   LEN               MOVE TO NEXT NAME
         CW,PTR   EOFNAMS           IS THERE ANOTHER NAME
         BL       GB13              BR TO LOOK AT NEXT NAME
*  ALL THE NAMES ARE ACTIVE
         SPACE    3
*  WE HAVE COMPLETED COLLECTION ON THE NAME AREA.
GB15     LW,R2    WANT              WHAT DO WE NEED
         BLEZ     GC1               DON'T NEED NAME SPACE
         LI,R4    LASTCFU+19
         SW,R4    EOFNAMS           # UNUSED NAME WORDS
         CW,R4    NAMLEN            CHK NAME LENGTH
         BGE      GF4               BR IF IT FITS
         B        GG1               TRY FOR A CFU BLK OR ACCT SPACE
*
*  AT LEAST ONE INACTIVE NAME HAS BEEN FOUND.
GB23     LB,LEN   *PTR              TEXTC COUNT OF NAME BYTES
         SLS,LEN  -2                # WDS IN NAME -1
         AI,LEN   1                 # WDS IN NAME
*  CHECK SCHEDULED REAL TIME
         LB,SR1   SB:HQ,R6
         BEZ      %+2               BR IF NO REAL TIME
         B        REG   ***LET THE REAL TIME IN***
         LW,XCS   #CS               # OF 8 WD BLOCKS
         LI,CFU   BGRCFU            1ST 8 WD BLOCK
GB21     CS,PTR   ID,CFU            CHK THE NAME
         BNE      GB6               BR IF NO HIT
         CW,ABIT  ACT,CFU           IS THE CFU ACTIVE
         BANZ     GB22              BR IF IT IS ACTIVE
GB6M1    STW,ABIT ID,CFU            BLITZ THE ID
GB6      AI,CFU   CFUSIZE           NEXT 8 WD BLK
         BDR,XCS  GB21              BR IF THERE IS ANOTHER BLK
*  THIS NAME IS NO LONGER ACTIVE.
         CI,LEN   8                 CHECK THE LENGTH
         BLE      %+2               SKIP IF OK
         LI,LEN   1                 PASS OVER 1 AT A TIME
         SW,OFS   LEN               NEW OFFSET FOR MOVES
GB16     AW,PTR   LEN               NEXT NAME LOC
         CW,PTR   EOFNAMS           IS THERE ANOTHER NAME
         BL       GB23              BR IF THERE IS
         AWM,OFS  EOFNAMS           NEW NEXT NAME LOC
         B        GB15              WE'RE DONE WITH THE NAMES
         SPACE    3
*  AN ACTIVE NAME HAS BEEN FOUND AND MUST BE MOVED UPWARDS
*  IN THE CFU NAME AREA.
GB22     CI,LEN   8                 CHK THE LENGTH
         BG       GB6M1             BR IF A BAD GUY
         LCW,R7   OFS               TO CALCULATE IF THE
         CW,R7    LEN                NAME OVERLAPS
         BGE      %+2               BR IF IT DOESN'T
         STS,ABIT GARBTIME          FLAG FOR TSTHGP
         SCS,LEN  -4                ALIGN FOR LC
         LC       LEN
         LM,R6    0,PTR             MOVE THE NAME
         STM,R6   *OFS,PTR           TO ITS NEW HOME
         SCS,LEN  4                 REALIGN
         LI,R6    SRT               SCHEDULED REAL TIME Q
         LW,R7    Y03               FOR * FILE TEST
         B        GB24              ENTER LAST LOOP
*
GB25     CS,PTR   ID,CFU            CHK THE NAME
         BNE      GB61              BR IF NO HIT
GB24     CS,R7    ID,CFU            CHK FOR * FILE
         BE       GB61              BR IF IT'S A *
         AWM,OFS  ID,CFU            NEW ADDR FOR NAME
GB61     AI,CFU   CFUSIZE           NEXT 8 WD BLK
         BDR,XCS  GB25              BR IF THERE IS ANOTHER BLK
         STS,XCS  GARBTIME          RESET TSTHGP FLAG
         B        GB16              TO CHK FOR THE END
*
         PAGE
*  A COMPLETE COLLECTION ON THE NAME & ACCOUNT AREAS HAS BEEN DONE.
GC1      LI,R0    0
         LI,R1    X'FFFF'
         STS,R0   #OFCLSES          RESET SIG CLOSE FLAG
*
GG1      RES      0
         LW,R1    #CS
         SLS,R1   3
         AI,R1    BGRCFU            ADDRESS OF NXT POSSIBLE BLK
         LCH,D3   #ACCTS
         SAS,D3   1
         SW,D3    STRTACCS
         STW,D3   LSTACCT           - LAST ACCT DA
         LW,R2    WANT              WHAT DO WE WANT
         BLZ      GEA               BR IF A CFU BLK
         CW,ABIT  -CFUSIZE,R1       IS FINAL BLK BUSY?
         BANZ     GD1               IT'S BUSY
         AW,D3    STRTNAMS           # OF UNUSED ACCT WDS+2
         SW,D3    EOFNAMS
         AI,D3    LASTCFU+2
*   # OF UNUSED ACCT & NAME WDS IN EXCESS OF 15
         BGEZ     GD1               WE GOT ENUF
         SPACE    3
*  MOVE THE ACCOUNT AREA UP BY 8 WORDS.
         LW,R1    STRTACCS          START OF ACCT AREA
         LH,R4    #ACCTS            # ACCT ENTRIES
         STS,ABIT GARBTIME          FLAG FOR TSTHGP
         MTW,-8   STRTACCS          NEW START OF ACCTS
         LI,R3    CFUSIZE
         AWM,R3   LSTACCT           ADJUST ACCT ENTRY POINTER
         SLS,R1   -1                DBLWD ALIGN
GC4      AI,R1    1                 NXT ACCT
         LD,R2    0,R1              SLIDE THE
         STD,R2   -CFUSIZE,R1        ACCTS
         BDR,R4   GC4               MOVE ANOTHER
         SPACE    3
GD1      LW,D3    LSTACCT           LAST CURRENT ACCT LOC
         LW,R2    WANT              WHAT DO WE NEED
         BGZ      GFA               TO GET A NAME SPACE
         BLZ      GEB               TO GET A CFU BLOCK
         SPACE    3
*  WE NEED AN ACCOUNT SPACE.
         AI,D3    -4  IN CASE 1ST NAME AT ODD LOCATION
         AW,D3    STRTNAMS
         BGEZ     GD5               THERE IS AN EMPTY
         SPACE    3
*  TRY TO FREE UP THE SPACE OCCUPIED BY THE 1ST NAME.
GE1      LI,R3    LASTCFU+19
         SW,R3    EOFNAMS
         LB,R0    *STRTNAMS         TEXTC COUNT
         SLS,R0   -2
         AI,R0    1                 # OF WDS IN NAME
         CW,R3    R0                IS THER ROOM TO MOVE TO END
         BGE      GD12              BR IF THERE IS
         LI,R1    X'FFFF'
         AND,R1   #OFCLSES          SHOULD WE TRY NAME COLLECT
         BNEZ     GB0               GIVE IT A TRY
         SPACE    3
*  CENTRALIZED EXIT WITH FAILURE.
GEC      LI,R0    0                 CAN'T GET A CFU
         STW,R0   J:BASE+9
         B        BI11
         SPACE    3
GD12     CI,R0    8                 CHK THE NAME LENGTH
         BG       GB0               FLUSH THE BAD STUFF OUT
         LI,R3    SRT               CHK 4 SCHEDULED REAL TIME
         LB,SR1   SB:HQ,R3
         BEZ      %+2               BR IF NO REAL TIME
         B        REG   ***LET THE REAL TIME IN***
*  WE CAN FREE UP THE SPACE NOW USED BY THE FIRST NAME.
         LW,PTR   STRTNAMS          1ST NAME IN CFU AREA
         AWM,R0   STRTNAMS          NEW 1ST NAME LOC
         LI,PTR+1 X'FFFF'           NAME IN LO HALFWORD
         LW,XCS   #CS               # OF CFU BLOCKS
         LI,CFU   BGRCFU            1ST CFU BLOCK
GD11     CS,PTR   ID,CFU            CHK THIS NAME
         BNE      GD2               BR IF NO HIT
         CW,ABIT  ACT,CFU           CHK FOR ACTIVE CFU
         BANZ     GD121             BR IF A LIVE ONE
         STW,ABIT ID,CFU            BLITZ THE ID
GD2      AI,CFU   CFUSIZE           NEXT CFU BLOCK
         BDR,XCS  GD11              BR IF THERE IS ONE
*  THE FIRST NAME IS NO LONGER ACTIVE, WE CAN USE IT'S SPACE.
         B        GD1               TO TRY AGAIN
         SPACE    3
GD121    LW,R1    EOFNAMS           NEW SPOT FOR 1ST NAME
         AWM,R0   EOFNAMS           NEW NEXT NAME SPOT
         SCS,R0   -4                ALIGN FOR LC
*  MOVE THE FIRST NAME TO BECOME THE LAST.
         LC       R0                # OF WORDS TO MOVE
         LM,R6    0,PTR             MOVE THE 1ST NAME
         STM,R6   0,R1               TO THE LAST
         SW,R1    PTR               INCREMENT FOR POINTERS
         B        GD32              ENTER LOOP
*
GD33     CS,PTR   ID,CFU            CHK THIS NAME
         BNE      GD31              BR IF NO HIT
GD32     AWM,R1   ID,CFU            ADJUST THE POINTER
GD31     AI,CFU   CFUSIZE           NEXT CFU BLOCK
         BDR,XCS  GD33              BR IF THERE IS ONE
         B        GD1               TO TRY AGAIN
         SPACE    3
*  WE HAVE FOUND THE SPACE FOR THE NEW ACCOUNT
GD5      LH,R3    #ACCTS
         AI,R3    1
         STW,R3   J:BASE+9
         B        BI11              SUCCESSFUL RETURN
         PAGE
*  WE NEED A NAME SPACE.
GFA      RES      0                 KBUF SET IN R2
         AW,D3    STRTNAMS
         SW,D3    NAMLEN
         BDR,D3   GF2               BR IF THERE'S ROOM ENUF
         LI,R0    X'FFFF'           SHOULD WE TRY
         AND,R0   #OFCLSES           ACCOUNT COLLECT
         BNEZ     GA0               GIVE IT A TRY
         B        GE1               TRY TO SHUFFLE NAMES
         SPACE    3
*  WE CAN PUT THE NEW NAME AT THE START OF THE NAME LIST.
GF2      LCW,R3   NAMLEN
         AW,R3    STRTNAMS          NEW 1ST NAME LOC
         STW,R3   STRTNAMS
         B        BI11              PUT NEW NAME IN 1ST SLOT
         SPACE    3
*  PUT THE NEW NAME AT THE END OF THE NAME LIST.
GF4      LW,R3    NAMLEN            NAME LENGTH IN WORDS
         AW,R3    EOFNAMS
         XW,R3    EOFNAMS
         SPACE    3
*  CENTRALIZED EXIT PROCEEDURE.
*  IF J:BASE+9 CONTAINS 0, WE HAVE A FAILURE.
BI11     PULL     8,R6              TIME WAS SAVED
         XW,SR3   *S:CLOCK4         NEW TIME
         SW,SR3   *S:CLOCK4         REAL GARBTIME
         AW,SR3   GARBTIME          TIME UNTIL THIS SHOT
         AND,SR3  MASKS+30          REMOVE FLAG FOR TSTHGP
         STW,SR3  GARBTIME          NEW COLLECTION TIME
         LW,R1    J:BASE+7          CFU POINTER
         B        *SR4              BACK TO OPEN
         PAGE
*  WE NEED A CFU BLOCK.
GEA      RES      0                 NXT POSSIBLE BLK ADDR IN R1
         STW,R1   J:BASE+9          ASSUME WE CAN GET IT
GEB      RES      0
         AW,D3    STRTNAMS           # ACCT WDS AVAIL + 2
         CI,D3    9                 CAN WE GET 'EM
         BG       GE6               BR IF WE CAN
         SW,D3    EOFNAMS
         AI,D3    LASTCFU+10
*   # UNUSED ACCT & NAME WDS IN EXCESS OF 7
         BLEZ     GEC               NOT ENUF
         B        GE1               TRY TO MOVE 1ST NAME
         SPACE    3
*  MOVE THE ACCOUNTS DOWN TO MAKE ROOM FOR A CFU BLOCK.
GE6      LCW,R1   LSTACCT
         LI,R3    CFUSIZE           # OF WDS TO MOVE BY
         STS,ABIT GARBTIME          FLAG FOR TSTHGP
         AWM,R3   STRTACCS          ADJUST POINTER
         SLS,R1   -1                DBLWD ALIGN
         LH,R0    #ACCTS
GE5      LD,D3    0,R1              MOVE THE ACCTS
         STD,D3   CFUSIZE,R1
         AI,R1    -1
         BDR,R0   GE5
         B        BI11              GET OUT
         SPACE    3
*  TO GIVE UP CONTROL FOR SCHEDULED REAL TIME.
REG      LI,6     E:AP              CODE FOR SCHEDULER
         LI,11    REGRTN            RETURN ADDRESS
         B        T:REG             LET THE REAL TIME IN
         SPACE    3
         END

