*DECK     ALLOC 
          IDENT  ALLOC
 ALLOC    SECT   (TABLE ALLOCATION.)
 ALLOC    SPACE  4
*         IN FAS/INIT21 
          EXT    DLF
  
*         IN FEC
          EXT    FEC=BY,FEC.RTN,STAGE 
  
*         IN FERRS
          EXT    E.MO2,E.MO4,E.MO5,E.MO6,E.MO7,E.TC1,FILL.,FILL.2 
  
*         IN FTN
          EXT    ABTFTN,COD,CO.SNAP,CP.AFLS,F.LGO,F.OUT,F.PB,F.REF
          EXT    MAX.FL,MSG=,NOM.FL 
  
*         IN IDP
          EXT    PTO
  
*         IN LEX
          EXT    LDB,LEXFLG 
  
*         IN LISTLNK
          EXT    ALC=CNT,MOVES
  
*         IN PEM
          EXT    PDM
  
*         IN PUC
          EXT    BASES,BINIO,FAILSFT,GMC,IDENT,L.TABS,MTD 
          EXT    NAMES,NREXT,N.TABLE,O.TABS,PASS,REFIO,SIZES,THRESH 
          EXT    T=APL,T=BLKS,T=BLST,T=CON,T=DATS,T=DIM,T=ENT,T=EQUS
          EXT    T=FILL,T=FMT,T=GL,T=LINK,T=NLST,T=PAR,T=REF,T=SCR
          EXT    T=STF,T=STMT,T=XFIL,T.PAR,T.REF,T.STF,WOF
  
*         IN UTILITY
          EXT    CIO=,FRA=,MVE=,WTW=
 ADW      SPACE  4,20 
**        ADW -  ADD ONE WORD TO END OF MANAGED TABLE.
* 
*         THE MACRO CALL *ADDWD* SHOULD ALWAYS BE USED. 
* 
*         ENTRY  (X6) = DATUM.
*                (A1) _ ORIGIN WORD OF TABLE. 
* 
*         EXIT   (X1) = ORIGIN OF TABLE.
*                (X2) = NEW LENGTH OF TABLE 
*                (X3) = DATUM.
*                (X6) = DATUM.
*                (A1) _ ORIGIN WORD OF TABLE. 
*                (A2) _ LENGTH WORD OF TABLE. 
*                (A6) _ LWA OF TABLE, WHERE *DATUM* WAS JUST STORED.
*                (B7) = LWA + 1 OF TABLE
* 
*         USES   A1,A2,A3,A6,A7  B7  X0,X1,X2,X3,X6,X7
* 
*         CALLS  ALC
  
  
 ADW      SUBR   =           ...ENTRY/EXIT... 
          SA2    A1+N.TABLE  L(T), CURRENT SIZE 
          =A3    A1+1        F(T+1), ORIGIN OF NEXT 
          =X2    X2+1        L(T)=L(T)+D, NEW SIZE
          SX7    X1+FUDGE    F(T)+K 
          IX0    X3-X7       F(T+1)-(F(T)+K)
          BX7    X2          (X7) = L(T)+D
          IX3    X1+X2       F(T)+L(T)+D
          IX0    X0-X2       F(T+1)-(F(T)+K+L(T)+D) 
          SB7    X3          (B7) = LWA+1 OF TABLE
          MI     X0,ADW10    IF CRASH 
          =A6    B7-1 
          BX3    X6 
          SA7    A2 
          EQ     EXIT.
  
 ADW10    BSS    0
          SX0    1
          SA6    ADWT        SAVE DATUM 
          RJ     ALC
 ADW.ALC  BSSENT 0           USED BY SNAP TO DETERMINE ALC CALLER 
          SA3    ADWT 
          BX6    X3 
          =A6    B7-1 
          EQ     EXIT.       EXIT...
  
 ADWT     BSSENT 4           TEMPORARY SAVE CELLS FOR ADWT AND CALLERS
 ALC      SPACE  4,40 
**        ALC -  TABLE MANAGER AND ALLOCATOR. 
* 
*         ALLOCATOR WILL MOVE TABLES TO ACQUIRE ROOM.  ALSO MAY DUMP
*         PREBINARY OR CROSS-REFERENCES ONTO SCRATCH FILE.
*         A MEMORY REQUEST WILL BE PERFORMED IF NECESSARY.
*         THE MACRO CALL *ALLOC* SHOULD ALWAYS BE USED. 
*         ALLOC WILL DIFFERENTIATE BETWEEN HIGH AND LOW ACTIVITY TABLES.
*         THE HIGH ACTIVITY TABLES WIIL RECIEVE 13/16 OF THE AVAILABLE
*         SPACE.  THREE TABLE VECTORS CORRESPONDING TO THREE COMPILATION
*         PHASES INDICATE WHICH TABLES ARE ACTIVE (SEE PUC).  TV=CUR
*         WILL ALWAYS CONTAIN THE TABLE VECTOR OF THE CURRENT PHASE.
* 
*         STOLEN FROM *COMPASS VER 2.0* 
* 
*         ENTRY  (A1) _ ORIGIN WORD OF TABLE. 
*                (X0) = CHANGE (+ OR -) TO TABLE SIZE.
* 
*         EXIT   (X1) = ORIGIN OF TABLE.
*                (X2) = NEW LENGTH OF TABLE.
*                (A1) _ ORIGIN WORD OF TABLE. 
*                (A2) _ LENGTH WORD OF TABLE. 
*                (B7) = LWA + 1 OF TABLE
* 
*         NOTE SPECIAL DEAL FOR REGISTER RELOCATION --
*                AT CERTAIN TIMES A PARTICULAR REGISTER MAY BE
*                POINTING TO SOME TABLE, WHICH WE ARE ABOUT TO MOVE.
*                TO AVOID THE EMBARASSMENT WHICH MIGHT OTHERWISE OCCUR, 
*                THE MANAGER WILL RELOCATE A REGISTER RELATIVE TO A 
*                DESIGNATED TABLE.  THIS IS INDICATED BY SETTING
*                (ALC.REG) =  24/ 0,  18/ REG,  18/ TABLE 
*                    (REG) = ADDRESS OF CELL WHERE DESIRED REGISTER IS
*                            SAVED BY *ALC*.
*                    (TAB) = ADDRESS OF TABLE ORIGIN WORD.
*                THIS CAN ONLY BE DONE FOR A REGISTER WHICH IS SAVED AND
*                RESTORED BY THE MANAGER. 
* 
*         COMMENTS WILL USE THE FOLLOWING CONVENTIONS - 
* 
*                A = AMOUNT OF AVAILABLE (UNUSED) CORE. 
*                F = FWA OF MANAGABLE STORAGE (O.TABS). 
*                K = NUMBER OF UNUSED WORDS GUARANTEED BETWEEN
*                      TABLES (FUDGE).
*                N = NUMBER OF TABLES TO MANAGE (N.TABLE)-1 
*                NACT = NUMBER OF HIGH ACTIVITY TABLES. 
*                S = SIZE OF MANAGABLE STORAGE (L.TABS).
* 
*                TWO VECTORS OF LENGTH N+1 (0.LE.I.LE.N-1) -- 
*                F(I) = I-TH TABLE ORDINAL (SIZES)
*                L(I) = I-TH TABLE LENGTH (BASES) 
*                F(N) = F+S 
*                L(N) = 0 
*                L = TOTAL LENGTH OF ALL TABLES (SUM L(I))
*                LACT = LENGTH OF ACTIVE TABLES.
*                F(T), L(T) = REQUESTING TABLE ORIGIN AND LENGTH. 
*                D = NUMBER OF WORDS DEMANDED FOR L(T). 
* 
*         USES   A1-A3,A6,A7  B7  X0-X3,X6,X7 
* 
*         KEEPS  A0,A4,A5  B2-B6  X4,X5 
* 
*         CALLS  GMR, MTD, MOVE, PTS
  
  
 ALC      SUBR   =           ...ENTRY/EXIT... 
  
 .T       IFEQ   TEST,ON
          SA2    ALC=CNT
          SX6    X2+B1
          SA6    A2 
.T        ENDIF 
  
          SA2    A1+N.TABLE  L(T), CURRENT SIZE 
          =A3    A1+1        F(T+1), ORIGIN OF NEXT 
          IX2    X0+X2       L(T)=L(T)+D, NEW SIZE
          SX6    X1+FUDGE    F(T)+K 
          IX7    X3-X6       F(T+1)-(F(T)+K)
          BX6    X2          (X6) = L(T)+D
          IX3    X1+X2       F(T)+L(T)+D
          SA6    A2          UPDATE L(T)
          IX7    X7-X2       F(T+1)-(F(T)+K+L(T)+D) 
          SB7    X3          (B7) = LWA+1 OF TABLE
  
  
**               TABLES HAVE CRASHED WHEN --
*         F(T) + L(T) + D + K .GT. F(T+1) 
  
 .TEST    IFEQ   TEST,ON,1   IF TEST MODE 
          MI     X2,"BLOWUP" IF L(T) .LT. 0 
          PL     X7,EXIT.    IF NO CRASH, EXIT... 
  
  
**        WE HAVE A CRASH AND MUST REALLOCATE -- PREPARE TO DO SO.
*                SAVE REGISTERS.
  
          IX6    X2-X0       L(T)=L(T)-D (BACK AGAIN) 
          BX7    X5 
          SA6    A2          RESTORE ORIGINAL SIZE, TEMPORARILY 
          LX6    X4 
*                            (ALCA) 
          SA7    ALCA+8      +8 = (X5)
          =A6    A7-1        +7 = (X4)
          SX7    A5 
          SX6    A4 
          =A7    A6-1        +6 = (A5)
          =A6    A7-1        +5 = (A4)
          SX7    B6-B0
          SX6    B5-B0
          =A7    A6-1        +4 = (B6)
          =A6    A7-1        +3 = (B5)
          SX7    B4-B0
          SX6    B3-B0
          =A7    A6-1        +2 = (B4)
          =A6    A7-1        +1 = (B3)
          SX7    B2-B0
          SB2    BASES
          SB2    A1-B2
          =A7    A6-1        +0 = (B2)
  
**        SAVE THE BASE ADDRESS OF THE TABLE DESIGNATED BY (ALC.REG) FOR
*                THE *RELATIVE-REGISTER* FEATURE. 
  
          SA2    ALC.REG
          SA1    X2          FETCH OLD BASE 
          BX6    X1 
          =A6    A2+1 
  
 .TEST    IFEQ   TEST,ON,1   IF TEST MODE 
          CALL   PTS         PRINT TABLE STATISTICS 
  
  
**        COMPUTE --
*                (L) = SPACE CURRENTLY OCCUPIED BY TABLES.
*                    = SIGMA(0.LT. I .LT. N, L(I)) + D
*                (LACT) =LENGTH OF HIGH ACTIVITY TABLES(+ D,IF T ACTIVE)
*                (A) = ALLOCATABLE SPACE CURRENTLY UNNEEDED.
*                    = S - N*K - (L + D) - 168
*                      168 IS ADDITIONAL SLOP ALLOCATED FOR TB
  
 ALC10    SA2    =XTV=CUR    TV */TABLE VECTOR,=1 IF ACTIVE 
          SX3    B1 
          MX7    0
          LX3    B2,X3       (X3) = TV MASK FOR BIT POSITION T
          BX1    X2*X3
          ZR     X1,ALC14    IF T NOT ACTIVE
          BX7    X0          LACT = D 
  
 ALC14    LX3    X0          L = D
          SB5    59 
          SB7    N.TABLE-1   I=N,NUMBER OF TABLES 
          SB4    B5-B7
          LX2    B4,X2       LEFT SHIFT 59-N
  
 ALC20    SA1    SIZES+B7    = L(I) 
          SB7    B7-B1       I = I - 1
          IX3    X3+X1       L = L + L(I) 
          PL     X2,ALC22    IF I NOT ACTIVE
          IX7    X7+X1       LACT = LACT + L(I) 
  
 ALC22    LX2    1
          PL     B7,ALC20    LOOP FOR ALL TABLES
  
          SA2    L.TABS      = S
          SB3    X7          (B3) = LACT
          SX7    X3+N.TABLE*FUDGE-FUDGE+84+84  +2 STATEMENTS OF TB SLOP 
          IX6    X2-X7       (X6) = A = S - N*K - (L+D) - 168 
          SB4    X3          (B4) = L 
  
*         RESERVE SPACE FOR MINIMUM ALLOCATION OF T.PAR . 
  
          MX7    0
          SB5    SIZES
          SA2    T=PAR
          SA3    =XALC.PAR
          IX2    X2-X3
          SB5    A2-B5       (B5) = INDEX FOR PAR 
          PL     X2,ALC26    IF T=PAR GT ALCPAR 
          BX7    -X2
  
 ALC26    SA2    THRESH 
          IX2    X2+X7       RESERVED FOR T.PAR MIN 
          SA7    =SALCB 
          IX1    X6-X2       SUBTRACT THRESHOLD AMOUNT
          PL     X1,ALC30    IF ENOUGH ROOM FOR TABLE 
  
          RJ     GMR         GET MORE ROOM
          EQ     ALC10       CHECK IF ENOUGH NOW
  
*                ADJUST L,LACT,AND A FOR T.PAR ADJUSTMENT 
  
 ALC30    SA2    =XTV=CUR 
          SX1    B1 
          SB4    B4+X7       L = L + P
          LX1    B5,X1
          IX6    X6-X7       A = A - P
          BX3    X1*X2
          ZR     X3,ALC32    IF PAR NOT ACTIVE
          SB3    B3+X7       LACT = LACT + P
  
*         PARTITION AVAILABLE SPACE BETWEEN ACTIVE AND INACTIVE TABLES. 
*                AA = A * 13/16    */AVAILABLE SPACE FOR ACTIVE TABLES
*                AI = A * 3/16     */AVAILABLE SPACE FOR INACTIVE TABS
  
 ALC32    BX3    X6 
          AX3    3
          AX1    B1,X3
          IX1    X1+X3       (X1) = AI = 3/16 * A 
          IX6    X6-X1       (X6) = AA = 13/16 * A
  
*         SLOP SPACE ALLOCATED TO A TABLE IS EQUALLY DEPENDENT ON TWO 
*         FACTORS, D1 AND D2.  FOR A GIVEN PERCENTAGE OF AVAILABLE
*         MEMORY AM, D1 IS A FUNCTION OF THE TOTAL NUMBER OF TABLES THAT
*         SHARE AM.  WHILE D2 IS A FUNCTION OF THE RELATIVE LENGTHS OF
*         OF THE TABLES THAT SHARE AM.  THEREFORE HALF OF AM IS EQUALLY 
*         SHARED BETWEEN ALL TABLES ACCORDING TO D1, AND  THE OTHER HALF
*         OF AM IS SHARED ACCORDING TO THE RELATIVE LENGTHS OF THE
*         TABLES BY D2, THE LARGER RECIEVING THE MOST OF AM.
  
*         CALCULATE D1 AND D2 FOR ACTIVE TABLES.
*         IF LACT = 0        D1 = AA * 1/NAT
*                            D2 = 0 
*         OTHERWISE          D1 = AA * 1/2 * 1/NAT
*                            D2 = AA * 1/2 * 1/LACT 
  
          CX3    X2          = NAT
          ZR     B3,ALC33    IF LACT = 0
          AX6    1
          IX7    X6/X3
          SX5    B3 
          SA7    ALCD1+1     D1 = AA * 1/2 * 1/NAT
          PX5    X5 
          NX5    X5 
          FX7    X6/X5
          SA7    ALCD2+1     D2 = AA * 1/2 * 1/LACT 
          EQ     ALC36
  
 ALC33    IX7    X6/X3
          MX6    0
          SA7    ALCD1+1     D1 = AA * 1/NAT
          PX6    X6 
          SA6    ALCD2+1     D2 = 0 
  
*         CALCULATE D1 AND D2 FOR INACTIVE TABLES.
*         IF L - LACT = 0    D1 = AI * 1/(N-NAT)
*                            D2 = 0 
*         OTHERWISE          D1 = AI * 1/2 * 1/(N-NAT)
*                            D2 = AI * 1/2 * 1/(L-LACT) 
  
 ALC36    SX7    N.TABLE-1
          CX3    X2 
          SX5    B4-B3       = L - LACT 
          IX3    X7-X3       N - NAT
          ZR     X5,ALC37    IF L - LACT = 0
          AX1    1
          IX7    X1/X3
          PX5    X5 
          SA7    ALCD1       D1 = AI * 1/2 * 1/(N-NAT)
          NX5    X5 
          FX7    X1/X5
          SA7    ALCD2       D2 = AI * 1/2 * 1/(L-LACT) 
          EQ     ALC38
  
 ALC37    MX6    0
          IX7    X1/X3
          PX6    X6 
          SA7    ALCD1       D1 = AI * 1/(N-NAT)
          SA6    ALCD2       D2 = 0 
  
**               PACK ALL TABLES DOWN TO BOTTOM OF TABLE SPACE
  
 ALC38    SB6    X0          (B6) = D, DEMANDED CHANGE
          SA2    O.TABS 
          BX0    X2 
          RJ     MTD         MOVE TABLES DOWN TO LOW CORE 
          SA3    B2+SIZES    (X3) = L(T), REQUESTING TABLE SIZE 
          SX6    X3+B6       L(T)=L(T)+D
          SA6    A3          UPDATE L(T)
          SA1    T=PAR
          SA2    ALCB 
          IX6    X1+X2
          SA6    A1          ALLOCATE MIN FOR T.PAR 
          SA1    O.TABS 
          SA2    L.TABS 
          IX5    X1+X2       (X5) = F+S, LWA+1 OF CORE
          SB3    N.TABLE-1
  
 .TEST    IFEQ   TEST,ON,1   IF TEST MODE 
          ZR     B4,"BLOWUP" IF NO LENGTH 
  
  
**        REALLOCATE AND MOVE TABLE (I) TO ITS NEW POSITION.
*                --  N .GT. I .GT. 0   -- 
*                F(I) = F(I+1) - L(I) - D1 - D2 * L(I) - FUDGE
  
          SA3    =XTV=CUR 
          SB5    61 
          SB4    B5-B3
          LX0    B4,X3       SHIFT 60-N+1 
  
  
 ALC40    SB3    B3-B1       DECREMENT TABLE POINTER
          SA2    B3+BASES    (X2) = F(I),  TABLE ORIGIN 
          SA1    A2+N.TABLE  (X1) = L(I)
          SX7    B1 
          BX6    X0*X7       = 1 IF ACTIVE, = 0 IF INACTIVE 
          SA3    ALCD2+X6    = D2 
          PX1    X1 
          SA4    ALCD1+X6 
          NX1    X1 
          FX7    X3*X1       = D2 * L(I)
          LX0    1           SHIFT VECTOR FOR NEXT ITERATION
          UX7    B4,X7
          LX7    B4,X7
          IX6    X7+X4       = D1 + D2 * L(I) 
          =X6    X6+FUDGE    = K, AMOUNT OF SLOP ABOVE THIS TABLE 
          IX6    X5-X6       = F(I+1) - (K + (A*L(I)/(L+D)/2) + (A/2/N) 
          UX1    B4,X1
          LX1    B4,X1
          IX7    X6-X1       F(I) = (X6) - L(I) 
          BX3    X7 
          SA7    A2          SET NEW ORIGIN 
          LX5    X7 
          ZR     X1,ALC50    IF EMPTY TABLE 
          MOVE   X1,X2,X3 
 ALC50    NE     B3,B1,ALC40 IF MORE TABLES TO ALLOCATE 
  
  
**        SET THE LOWEST TABLE TO THE BEGINNING OF TABLE SPACE, TO
*                RECLAIM THE SPACE LOST THRU TRUNCATION --
*                F(0) = F = (LOCORE)
  
          SA3    T=PAR
          SA2    ALCB 
          IX6    X3-X2       DEALLOCATE T.PAR FUDGE 
          SA6    A3 
          SA3    O.TABS 
          SA2    BASES       FETCH FWA
          SA1    SIZES       FETCH SIZE 
          LX6    X3 
          BX4    X3-X2
          SA6    A2 
          ZR     X4,ALC60    IF LOWEST TABLE NOT MOVED
          MOVE   X1,X2,X3 
  
  
**        RESTORE THE BASE ADDRESS OF THE TABLE DESIGNATED BY (ALC.REG) 
  
 ALC60    SA2    ALC.REG
          =A1    A2+1        = OLD ORIGIN 
          SA3    X2          = NEW ORIGIN 
          AX2    18 
          IX6    X3-X1       = DISPLACEMENT 
          SA2    X2          = OLD REGISTER VALUE 
          IX6    X2+X6
          SA6    A2          STORE NEW REGISTER VALUE 
  
 .TEST    IFEQ   TEST,ON
          SA1    CO.SNAP
          LX1    1RU
          PL     X1,ALC61    IF SNAP=U NOT SELECTED 
          SA1    B2+NAMES 
          MX6    42 
          BX6    X6*X1
          SA6    FILL.
          TRIV   E.TC1       ISSUE CRASH MESSAGE
  
 ALC61    BSS    0
 .TEST    ENDIF 
  
          SA1    B2+BASES    RECLAIM F(T), TABLE ORIGIN WORD
  
**        WE PROMISED TO PRESERVE MANY REGISTERS.  IT IS TIME TO RESTORE
*                THEM.
  
*                            (ALCA) 
  
          SA5    ALCA        +0 = (B2)
          SB2    X5 
          =A4    A5+1        +1 = (B3)
          SB3    X4 
          =A3    A4+1        +2 = (B4)
          SB4    X3 
          =A2    A3+1        +3 = (B5)
          SB5    X2 
          =A5    A2+1        +4 = (B6)
          SB6    X5 
  
          =A4    A5+1        +5 = (A4)
          =A3    A4+1        +6 = (A5)
          =A2    A3+1        +7 = (X4)
          SA4    X4 
          SA5    X3 
          =A3    A2+1        +8 = (X5)
          BX4    X2 
          LX5    X3 
  
          SA2    A1+N.TABLE  RECLAIM L(T), TABLE LENGTH WORD
          IX6    X1+X2       F(T)+L(T)
          SB7    X6          (B7) = LWA + 1 OF TABLE
          EQ     EXIT.       EXIT...
  
*                            SAVE CELLS DURING TABLE MOVES -- 
 ALCA     BSS    1           (B2) 
          BSS    1           (B3) 
 ALC=B4   BSS    1           (B4) 
 ALC=B5   BSS    1           (B5) 
          BSS    1           (B6) 
          BSS    1           (A4) 
 ALC=A5   BSS    1           (A5) 
          BSS    1           (X4) 
          BSS    1           (X5) 
  
 ALC=00   EQU    ALCA-1      FAKE, USED TO NO-OP RELATIVE REGISTER
  
 ALC.REG  VFD    24/0,18/ALC=00,18/BASES
          ENTRY  ALC.REG
          BSS    1           SAVE CELL FOR ORIGIN OF RELATIVE TABLE 
  
 ALC.00   VFD    24/0,18/ALC=00,18/BASES
          ENTRY  ALC.00 
 ALC.STF  VFD    24/0,18/ALC=B4,18/T.STF
          ENTRY  ALC.STF
 ALC.CAI  VFD    24/0,18/ALC=B4,18/T.PAR
          ENTRY  ALC.CAI
 ALCD1    BSS    2           CELL FOR D1 (ACTIVE AND INACTIVE)
  
 ALCD2    BSS    2           CELL FOR D2 (ACTIVE AND INACTIVE)
 GMR      SPACE  4,8
**        GMR - GET MORE ROOM.
* 
*         CORE OVERFLOW -- IT BECOMES NECESSARY (OR DESIRABLE) TO SPILL 
*         TO DISK OR ASK FOR MORE CORE.  IF FIELD LENGTH IS GREATER 
*         THAN NOMINAL FIELD LENGTH WE WILL SPILL TO DISK.  IF NOT
*         OR IF WE ALREADY SPILLED WE GET MORE CORE.
* 
*         ENTRY  (X1) = -(AMOUNT OF CORE NEEDED) INCLUDING THRESHOLD
* 
*         KEEPS  B2, X0 
* 
*         CALLS  DLF, GMC, NOTE, OPEN, READ, REWIND, WRITER, WRITEW 
  
  
 GMR      SUBR   ...ENTRY/EXIT... 
          SX6    B2          SAVE ENTRY CALL VALUES 
          BX7    X0 
          SA6    GMRA        REQUESTING TABLE ORIGIN WORD ORDINAL 
          =A7    A6+1        CHANGE TO TABLE SIZE 
          BX6    X1 
          =A6    A7+1        -(AMOUNT OF CORE REQUIRED) INCLUDES THRESH 
  
*         IF WE ARE IN END PROCESSING (ASSEMBLY PHASE) TRY DUMPING
*         THE LINK AND FILL TABLES. 
  
          SA1    PASS 
          SA2    T=LINK 
          =B2    X1-PASS=FAS
          SA3    T=FILL 
          NZ     B2,GMR20    IF NOT IN ASSEMBLY PHASE 
  
          SA1    NREXT
          IX0    X2+X3
          IX7    X0-X1
          SA3    T=XFIL 
          IX7    X7+X3
          SB7    X7-2 
          LE     B7,GMR20    IF NO ROOM TO BUY
  
 .TEST    IFEQ   TEST,ON     IF TEST MODE 
          SA1    CO.SNAP
          LX1    1RT
          PL     X1,GMR10    IF NO TABLE SNAP REQUESTED 
          TRIV   E.MO7       LINK AND FILL DUMPED 
 .TEST    ENDIF 
  
 GMR10    CALL   DLF         DUMP LINK AND FILL 
          EQ     GMR80       TRY AGAIN... 
  
  
**        NO HELP ON LINK/FILL.  TRY TO OVERFLOW PREBINARY. 
*                IF IN MAP PROCESSING, WE ARE AT THE END OF OUR ROPE. 
  
 GMR20    SA4    NOM.FL 
          SA3    CP.AFLS     TOTAL FIELD LENGTH 
          SX6    INC.LTN     FIELD LENGTH INCREMENT WHEN FL .LT. NOMINAL
          IX2    X4-X3
          PL     X2,GMR30    IF FL .LT. NOMINAL 
          SX6    INC.GTN     FIELD LENGTH INCREMENT WHEN FL .GT. NOMINAL
  
 GMR30    =B7    PASS=MAP-PASS=FAS
          EQ     B7,B2,GMR70 IF IN REF MAP PASS, GET MORE CORE
          SA2    T=REF
          SA1    GMRA+2      (X1) = - (AMOUNT NEEDED) 
          IX2    X2+X1
          MI     X2,GMR70    IF NO ROOM TO BUY
  
          SA1    REFIO
          MI     X1,GMR70    IF REFS ALREADY SPILLED
          MX7    -1 
          SA7    A1          INDICATE (T.REF) ON DISK 
          INATAB REF,(DECL,EXU,CUR)      DEACTIVATE REF 
  
 .RM      IFEQ   CP#RM,7,1   IF 7RM I/O 
          OPEN   F.REF
  
 GMR60    SA3    T=REF
          SA1    T.REF
          SHRINK A3 
          WRITEW F.REF,X1,X3
  
 .TEST    IFEQ   TEST,ON,1   IF TEST MODE 
          TRIV   E.MO5       CROSS REFERENCE GOES TO DISK 
  
          EQ     GMR80       TRY AGAIN... 
  
  
**        WE NEED MORE CORE.
  
 GMR70    RJ     GMC         GET MORE CORE
          ZR     B7,GMR90    IF REQUEST FAILED
  
          SA1    O.TABS      BEGINNING OF TABLES
          SA6    =XT.END
          IX6    X6-X1
          SA6    L.TABS      AMOUNT OF CORE TO BE MANAGED 
          AX6    FLSLOP 
          SX6    X6+FLSLUP2 
          SA6    THRESH      GIVE ALLOC SOME ELBOW ROOM 
  
  
**        SOMETHING WAS SUCCESSFULLY DUMPED --
*                RETRIEVE ENTRY VALUES AND TRY AGAIN. 
  
 GMR80    SA3    GMRA+1      RESTORE TABLE SIZE 
          =A2    A3-1        AND ORDINAL
          BX0    X3 
          SB2    X2 
          EQ     EXIT.       EXIT...
  
  
**        IT WAS ALL TO NO AVAIL.  REPORT FAILURE AND ABORT.
  
 GMR90    SA1    GMRA+2      -(AMOUNT NEEDED) 
          SA2    THRESH 
          IX1    X2+X1
          MI     X1,GMR92    IF NOT THRESHOLD ALARM 
  
 .TEST    IFEQ   TEST,ON,1   IF TEST MODE 
          CALL   PTA         PRINT THRESHOLD ALARM
  
          MX6    0
          SA6    THRESH      ALLOW USE OF THRESH AREA 
          EQ     GMR80
  
 GMR92    SA2    FAILSFT
          NZ     X2,GMR94    IF ALREADY HAD OVERFLOW
          SA1    PASS 
          NZ     X1,GMR93    IF NOT FRONT END PROCESSING
          ERRNZ  PASS=FE
          SA1    LEXFLG 
          HX1    LF.HDR 
          PL     X1,GMR93    IF NOT HEADER DELAY
          SA1    T=STMT 
          ZR     X1,GMR93    IF NOTHING TO TRASH
          CALL   LDB         LIST THE DEFFERED BUFFER 
          SHRINK T=STMT,0 
          EQ     GMR80
  
 GMR93    BX6    0
          =X7    X2+1 
          SHRINK T=STF,X6 
          SA7    A2          SET FAILSOFT FLAG
          SHRINK T=DIM,X6 
          SHRINK T=SCR,X6 
          SHRINK T=CON,X6 
          SHRINK T=BLST,X6
          SHRINK T=EQUS,X6
          SHRINK T=FMT,X6 
          SHRINK T=PAR,X6 
          SHRINK T=NLST,X6
          SHRINK T=APL,X6 
          SHRINK T=GL,X6
          SHRINK T=DATS,X6
          SHRINK T=REF,X6 
          =X7    FEC=BY 
          SHRINK T=BLKS,X6
          SHRINK T=ENT,X6 
          SA7    STAGE       BYPASS REST OF PROGRAM 
          FATAL  E.MO2
          SA1    PASS 
          SX1    X1-PASS=END
          MI     X1,FEC.RTN  IF NOT IN END OR MAP PROCESSING
  
  
**        NOT EVEN ENOUGH ROOM TO SKIP TO AN *END* CARD --
*                DAYFILE MESSAGE AND ABORT JOB
  
 GMR94    SA1    IDENT       ROUTINE NAME 0L FORMAT 
          BX6    X1 
          SA6    GMRC 
          PLINE  GMRB,3,2 
          MESSAGE GMRB,,RCL 
          WRITER F.OUT
          WRITER F.LGO
          EQ     ABTFTN      EXIT TO ABORT JOBSTEP... 
  
 GMRA     DATA   0,0         TEMPORARY STORAGE FOR OVERFLOW 
          CON    0           SAVE CORE REQUIRED 
 GMRB     DIS    2, TABLE OVERFLOW IN 
 GMRC     CON    0           ROUTINE NAME 0L FORMAT 
 PTA      SPACE  4,10 
 .TEST    IFEQ   TEST,ON     IF TEST MODE 
**        PTA - PRINT THRESHOLD ALARM.
* 
*         CALLED WHEN ONLY SPACE ABOVE THRESHOLD IS AVAILABLE.
* 
*         ENTRY  (THRESH) = CORE LEFT 
*                (MAX.FL) = FL NOW IN USE 
* 
*         USES   ALL
  
  
 PTA      SUBR   =           ...ENTRY/EXIT... 
          SA1    THRESH 
          CALL   COD         CONVERT OCTAL DIGITS 
          BX6    X4 
          SA6    FILL.
          SA1    MAX.FL 
          AX1    30 
          CALL   COD         CONVERT OCTAL DIGITS 
          BX6    X4 
          SA6    FILL.2 
          TRIV   E.MO6       THRESHOLD REACHED
          EQ     EXIT.       EXIT...
 PTS      SPACE  4,8
**        PTS -  PRINT TABLE STATISTICS.
* 
*         ENTRY  (B2) = CURRENT TABLE ORDINAL 
*                (X0) = INCREMENT TO TABLE
* 
*         KEEPS  A0, B2, X0 
  
  
 PTS      SUBR   =           ** ENTRY/EXIT ** 
          BX6    X0 
          SA6    PTSA        SAVE X0
          SX6    B2 
          =A6    A6+1        SAVE B2
          SX6    A0 
          =A6    A6+1        SAVE A0
          SA3    MOVES
          SA2    CO.SNAP
          LX2    1RT
          SX6    X3+B1       COUNT TABLE CRASHES
          SA6    A3 
          PL     X2,EXIT.    IF SNAP NOT DESIRED
          SA2    ALC
          AX2    30 
          SB7    ADW.ALC     SEE IF CALLED BY ADW 
          SB7    -B7
          SB7    X2+B7
          NZ     B7,PTS2     IF NOT CALLED FROM ADDWORD 
          PLINE  PTSB,PTSBL 
          SA2    ADW
          AX2    30 
 PTS2     SX1    X2 
          SB7    PTS3        RETURN ADDRESS 
          EQ     FRA=        FIND RELATIVE ADDRESS
 PTS3     SA6    PTSC1
          =A7    A6+1 
          PLINE  PTSC,PTSCL 
  
          SA1    PTSA+1      (X1) = TABLE ORDINAL 
          SB5    X1 
          CALL   COD         CONVERT OCTAL DIGITS 
          SA6    PTSE1       TABLE NUMBER 
          SA1    PTSA        (X1) = INCREMENT TO TABLE SIZE 
          RJ     COD         CONVERT INCREMENT
          SA6    PTSE2
          SA1    B5+SIZES 
          RJ     COD         CONVERT PREVIOUS SIZE
          SA6    PTSE3
          PLINE  PTSE,PTSEL 
          CALL   PTO         PRINT TABLE ORIGINS
          SA2    PTSA        (X2) = INCREMENT 
          IX1    X0+X2       TOTAL TABLE SPACE USED 
          RJ     COD         CONVERT NECESSARY STORAGE
          SA6    PTSF1
          SA1    L.TABS 
          RJ     COD
          SA6    PTSF2
          PLINE  PTSF,PTSFL 
          SA1    PTSA 
          BX0    X1          RESTORE X0 
          =A2    A1+1 
          SB2    X2          RESTORE B2 
          =A1    A2+1 
          SA0    X1          RESTORE A0 
          EQ     EXIT.       EXIT...
  
 PTSA     BSS    3           X0, B2, A0 
  
 PTSB     DATA   H/          CALLED FROM *ADDWD*./
 PTSBL    EQU    *-PTSB 
  
 PTSC     DATA   H/          CALLED FROM /
 PTSC1    DATA   0,0         *NNNNNN IN ROUTINENAME*
 PTSCL    EQU    *-PTSC 
  
 PTSE     DIS    2,  TABLE NUMBER 
 PTSE1    DATA   0           TABLE ORDINAL
          DIS    1, ADDING
 PTSE2    DATA   0           INCREMENT TO SIZE
          DIS    1, TO PREV 
 PTSE3    DATA   0           ORIGINAL TABLE LENGTH
 PTSEL    EQU    *-PTSE 
  
 PTSF     DIS    2,  NOW USING
 PTSF1    DATA   0           TOTAL USED, INCLUDING INCREMENT
          DIS    1, OUT OF
 PTSF2    DATA   0           SIZE OF TABLE AREA 
 PTSFL    EQU    *-PTSF 
 .TEST    ENDIF 
  
  
          LIST   D
          END 
