*COMDECK     COMANAGR - TABLE SPACE MANAGEMENT ROUTINES.
#*        MANAGER - TABLE SPACE MANAGEMENT ROUTINES.
* 
*         R. H. GOODELL.     76/06/17.
* 
*         THIS SYMPL SUBPROGRAM IS ROUGHLY EQUIVALENT TO THE STANDARD 
*         COMMON DECK *COMCMTP* WHICH CONTAINS A COMPASS MANAGED TABLE
*         PACKAGE WRITTEN BY G. R. MANSFIELD.  SEE THE *DDLCG*
*         PREAMBLE FOR A DISCUSSION OF THE DYNAMIC TABLE SPACE
*         MANAGEMENT PHILOSOPHY AND METHODOLOGY FOR THE DDL 
*         CODE GENERATOR. 
* 
*         CONTENTS (XDEF ENTRY POINTS). 
* 
*         PROC   MANAGER     INITIALIZE TABLE MANAGEMENT. 
*         PROC   ALLOC       ALLOCATE TABLE SPACE.
*         PROC   ASU         ACCUMULATE STORAGE USED. 
*         PROC   SDA         SET DYNAMIC AREA BASE ADDRESS. 
# 
  
*CALL     COMDDEF            GENERAL DEFINITIONS. 
  
     DEF  FLMUL  #O"4000"# ;       # FIELD LENGTH MULTIPLE #
     DEF  MIDFL #O"60000"# ;       # TABLE DUMP TRIGGER FL #
     DEF  SLOP   #O"1000"# ;       # MIN TOTAL AVAIL SPACE #
  
  
#*        MANAGED TABLE POINTERS. 
* 
*         DUE TO LANGUAGE RESTRICTIONS IN SYMPL, THE STORAGE  AREA
*         CONTAINING  THE MANAGED (DYNAMIC) TABLE POINTERS MUST BE
*         DECLARED IN TWO DIFFERENT WAYS.  IN THE  CODE  GENERATOR
*         MAIN PROGRAM *DDLCG* IT IS A SERIES OF XDEF BASED ARRAYS
*         AND  LENGTH  ITEMS,  WHILE  IN THE *MANAGER* PACKAGE THE
*         SAME AREA IS AN ARRAY OF 2-WORD ENTRIES.  THE  RESULTING
*         CORRESPONDENCE OF STORAGE LOCATIONS IS AS FOLLOWS.
* 
*               DDLCG                MANAGER              VIA 
*             XDEF NAME      XREF NAME    TABLES ITEM     DEF 
* 
*               NTAB           NTAB           -            -
*               TABLES         TABLES      TABF [0]       BASE
*               FL             FL          TABL [0]        -
*             P<TSUB>            -         TABF [1]        -
*               TSUBL            -         TABL [1]        -
*             P<TCAP>            -         TABF [2]        -
*               TCAPL            -         TABL [2]        -
*               ...              -           ...           -
*             P<TVAR>            -         TABF [N]        -
*               TVARL            -         TABL [N]        -
*             P<TEND>          TEND        TABF [N+1]      -
*               TENDL          TENDL       TABL [N+1]     SU
* 
*         ALL OTHER SUBPROGRAMS DECLARE ONLY THE TABLES THEY NEED,
*         AS XREF BASED ARRAYS AND LENGTH ITEMS.
# 
     XREF BEGIN 
          ITEM NTAB ;                   # NUMBER OF TABLES #
          ARRAY TABLES [0:9] S (2) ;
               BEGIN                    # TABLE POINTER VECTOR #
               ITEM TABA (0,  0, 30) ;       # TABLE [I] NEW FWA #
               ITEM TABB (0, ZL, AL) ;       # TABLE [I] OLD FWA #
               ITEM TABF (0) ;               # TABLE [I] CURRENT FWA #
               ITEM TABL (1) ;               # TABLE [I] LENGTH # 
               END
          ITEM FL ;                     # FIELD LENGTH (= TABL [0]) # 
          ITEM TSUB, TSUBL ;            # REAL FIRST TABLE FWA, LENGTH #
          ITEM TEND, TENDL ;            # DUMMY LAST TABLE FWA, LENGTH #
          END 
     DEF  BASE  #TABF [0]# ;            # FWA TABLE AREA #
     DEF  SU    #TENDL# ;               # STORAGE USED #
  
  
     XREF BEGIN               # OTHER EXTERNALS # 
  
          ITEM CAPS B ;            # TRUE IF CAPSULES ON SCRATCH FILE # 
          ITEM CSCR U ;            # CAPSULE SCRATCH FILE # 
          ITEM DDLMEM ;            # CURRENT FIELD LENGTH IN BITS 0-30 #
          ITEM MAXFL ;             # MAXIMUM FIELD LENGTH ALLOWED # 
          ITEM OLD65 ;             # LWA+1 OF LATEST OVERLAY LOADED # 
          ITEM SUBL ;              # SUB-SCHEMA LENGTH WITHOUT CAPSULES#
          PROC ABORT ;             # ABORT JOB STEP # 
          PROC ABRT1 ;             # ABORT - INSUFF FL MESSAGE #
          PROC MEMORY ;            # REQUEST FIELD LENGTH # 
          PROC MESSAGE ;           # ISSUE MESSAGE TO DAYFILE # 
          PROC MOVEI ;             # MOVE BLOCK OF DATA, INDIRECT # 
          PROC RECALL ;            # WAIT FILE NOT BUSY # 
          PROC REWIND ;            # REWIND FILE #
          PROC WRITEW ;            # WRITE WORDS FROM WORKING BUFFER #
  
          END 
  
  
#         LOCAL DATA. 
# 
          ITEM SDAF B = FALSE ;    # TRUE ONLY WHEN SDA CALLS ALLOC # 
  
  
  
  
#***      MANAGER - INITIALIZE TABLE MANAGEMENT.
  
          PROC MANAGER
****
# 
          BEGIN 
          ITEM I ;
  
#         PRESET ALL TABLE POINTERS.  NOTE - POINTERS FOR TABLE 1 
*         (TSUB) HAVE ALREADY BEEN SET BY THE MAIN PROGRAM. 
# 
          BASE = OLD65 ;
          NTAB = (LOC (TEND) - LOC (TABLES)) / 2 - 1 ;
          FOR  I = 2 THRU NTAB  DO
               BEGIN                    # LEAVE 1 WORD BETWEEN TABLES # 
               TABF [I] = TABF [1] + TABL [1] + I ; 
               TABL [I] = 0 ;           # ZERO EACH TABLE LENGTH #
               END
          FL = B<0,30> DDLMEM ;         # GET CURRENT FIELD LENGTH #
          TEND = FL - 8 ;               # SLOP SPACE ABOVE LAST TABLE # 
          SU = BASE + SUBL + NTAB + 8 ; # INITIALISE STORAGE USED # 
  
          IF  TABF [1] LT OLD65         # IF SUB-SCHEMA CLOBBERED # 
          THEN BEGIN
               MESSAGE (" SUBSCH DIR LOST WHEN CODEGEN LOADED. ::", 0) ;
               ABORT ;
               END
          IF  (TABF [1] LT BASE)  OR  (TABF [NTAB] GE TEND) 
          THEN BEGIN
               TABF [2] = TABF [1] ;    # FORCE RE-ALLOCATION # 
               ALLOC (TABF [1], 0) ;    # TO MOVE TSUB UPWARD # 
               END
          RETURN ;
  
  
  
  
#***      ALLOC - ALLOCATE TABLE SPACE. 
# 
          XDEF PROC ALLOC ; 
          PROC ALLOC (P$TABLE$, (INCR)) ; 
  
          ITEM P$TABLE$ ;          # ARGUMENT IS  P<TXXX> # 
          ITEM INCR I ;            # CHANGE IN TABLE SIZE # 
  
#         *ALLOC* INCREASES OR DECREASES THE AMOUNT OF MEMORY 
*         SPACE ALLOCATED TO THE SPECIFIED TABLE.  THE STATEMENT
*                           ALLOC (P<TXXX>, N)
*         ADDS N (WHICH MAY BE NEGATIVE) TO THE TABLE LENGTH WORD 
*         TXXXL.  ANY OR ALL OF THE TABLES MAY GET MOVED AROUND 
*         IN MEMORY, AND THEIR POINTERS UPDATED, IF *ALLOC* FINDS 
*         THIS TO BE NECESSARY OR APPROPRIATE.  *ALLOC* MAY ALSO
*         INCREASE THE JOB FIELD LENGTH AND/OR DUMP CAPSULES TO 
*         A SCRATCH FILE TO GET MORE SPACE. 
* 
*         *ALLOC* TRIES TO KEEP THE TABLES SPREAD OUT IN THE AREA 
*         OF MEMORY THAT IS RESERVED TO DYNAMIC TABLES, WITH THE
*         UNUSED SPACE DISTRIBUTED BETWEEN THE TABLES IN SUCH A 
*         WAY THAT A LARGER TABLE HAS MORE FREE SPACE ABOVE IT. 
****
# 
          BEGIN 
  
          ITEM AVAIL ;             # TOTAL AVAILABLE SPACE #
          ITEM EXP ;               # FIXED EXPANSION SPACE #
          ITEM I ;                 # TABLE VECTOR INDEX # 
          ITEM K ;                 # CURRENT TABLE INDEX #
          ITEM NEWA ;              # NEW FWA OF TABLE I # 
          ITEM NEWL ;              # NEW LENGTH OF TABLE K #
          ITEM SUM ;               # TOTAL OF ALL TABLE LENGTHS # 
  
          IF  INCR LT 0            # IF DECREASE IN TABLE LENGTH #
          THEN CALL ASU ;          # ACCUMULATE STORAGE USED #
  
          K = (LOC (P$TABLE$) - LOC (TABLES)) / 2 ;      # TABLE INDEX #
          NEWL = TABL [K] + INCR ;
          IF  (TABF [K] + NEWL) GE TABF [K+1] 
          THEN BEGIN
  
#         RE-ALLOCATION NEEDED.  COMPUTE AVAILABLE SPACE. 
# 
               SUM = TABL [1] ; 
               FOR  I = 2 THRU NTAB  DO      # SUM ALL TABLE LENGTHS #
                    SUM = SUM + TABL [I] ;
               AVAIL = TEND - BASE - NTAB - SUM ; 
               IF  AVAIL LT (INCR + SLOP) 
               THEN CALL PTO ;               # PROCESS TABLE OVERFLOW # 
  
#*        RE-ALLOCATE STORAGE.  PROVIDE EXPANSION SPACE ABOVE EACH
*         TABLE AS FOLLOWS. 
*         GUARANTEE ONE FREE WORD ABOVE EACH TABLE. 
*         DIVIDE HALF OF TOTAL AVAILABLE SPACE EQUALLY AMONG ALL
*         TABLES. 
*         DIVIDE THE OTHER HALF PROPORTIONALLY TO THE SIZE OF EACH
*         TABLE.
# 
               AVAIL = AVAIL - INCR ;        # ADJUST FOR CHANGE #
               SUM = SUM + INCR ; 
               TABL [K] = NEWL ;
               EXP = (AVAIL/2) / NTAB + 1 ;  # FIXED SPACE ABOVE EACH # 
               NEWA = BASE ;
               FOR  I = 1 THRU NTAB  DO      # COMPUTE NEW FWA FOR EACH#
                    BEGIN 
                    TABA [I] = NEWA ; 
                    NEWA = NEWA+TABL[I]+EXP+((AVAIL/2)*TABL[I])/SUM ; 
                    END 
               TABL [K] = TABL [K] - INCR ; 
               FOR  I = NTAB STEP -1 UNTIL 1  DO  # MOVE TABLES UP #
                    BEGIN 
                    IF  TABA [I] GT TABB [I]
                    THEN MOVEI (TABL [I], TABB [I], TABA [I]) ; 
                    END 
               FOR  I = 1 THRU NTAB  DO           # MOVE TABLES DOWN #
                    BEGIN 
                    IF  TABA [I] LT TABB [I]
                    THEN MOVEI (TABL [I], TABB [I], TABA [I]) ; 
                    TABF [I] = TABA [I] ; 
                    TABA [I] = 0 ;           # RESET POINTERS # 
                    END 
               END
  
#         INCREMENT TABLE LENGTH. 
# 
          TABL [K] = NEWL ;             # NEW LENGTH OF TABLE # 
          RETURN ;
  
  
  
  
#***      PTO - PROCESS TABLE OVERFLOW. 
# 
          PROC PTO ;
  
#         *PTO* IS CALLED BY *ALLOC* WHEN AVAILABLE MEMORY SPACE
*         IS TOO SMALL.  *PTO* PERFORMS THE FOLLOWING STEPS IN
*         ORDER, STOPPING AS SOON AS SUFFICIENT FREE SPACE HAS
*         BEEN OBTAINED.
* 
*         1.  INCREASE THE JOB FIELD LENGTH UP TO (MIDFL), IF 
*             NOT ALREADY GREATER THAN OR EQUAL TO IT.
* 
*         2.  SPILL COMPLETED CAPSULES (IF ANY) FROM THE END OF 
*             TSUB OUT TO THE SCRATCH FILE *ZZZZZCS* IF THIS HAS
*             NOT ALREADY BEEN DONE.  THIS REDUCES TSUBL TO THE 
*             LENGTH OF THE SUB-SCHEMA DIRECTORY PROPER, AND ADDS 
*             THE SPACE FORMERLY OCCUPIED BY THE CAPSULES TO THE
*             AVAILABLE MEMORY SPACE.  A FLAG IS SET (CAPS) THAT
*             INDICATES TO PASS2/WSS THAT SUBSEQUENT CAPSULES 
*             SHOULD BE WRITTEN DIRECTLY TO THE SCRATCH FILE. 
*             THUS, THE COMPLETED CAPSULES ARE EITHER ALL IN
*             MEMORY OR ALL IN THE SCRATCH FILE.
* 
*         3.  INCREASE THE JOB FIELD LENGTH AS MUCH AS NECESSARY
*             TO GET THE NEEDED SPACE.  ABORT IF THIS WOULD MAKE
*             THE FIELD LENGTH GREATER THAN (MAXFL).
* 
*         THE INTENT OF THIS THREE-PHASE PROCESS IS TO HAVE A 
*         PLATEAU SO THAT ALL TABLES WILL STAY IN MEMORY AS LONG
*         AS THIS IS REASONABLE, BUT WHEN THE FIELD LENGTH HAS
*         GROWN TO (MIDFL) THEN THE PROGRAM WILL RESORT TO USE
*         OF SCRATCH FILES BEFORE COMMENCING TO EAT UP THE ENTIRE 
*         MACHINE BY INCREASING ITS FIELD LENGTH FURTHER. 
* 
*         IN THE ABOVE DISCUSSION, (MIDFL) IS AN INSTALLATION 
*         PARAMETER LOCAL TO *MANAGER*, AND (MAXFL) IS THE VALUE
*         RETURNED BY THE OPERATING SYSTEM AS THE MAXIMUM FIELD 
*         LENGTH ALLOWED FOR THIS JOB.
****
# 
  
               BEGIN
  
               BASED ARRAY DUM ; ;
               ITEM NEED ;
               ITEM NEWFL ; 
  
#         TRY INCREASING FIELD LENGTH UP TO (MIDFL).
# 
               NEED = INCR + SLOP - AVAIL ; 
               NEWFL = ((FL + NEED + FLMUL - 1) / FLMUL) * FLMUL ;
               IF  NEWFL LE MIDFL 
                 AND  NEWFL LE MAXFL         # IF ABLE TO GET ENOUGH #
               THEN BEGIN 
                    MEMORY (NEWFL) ;              # REQUEST NEW FL #
                    AVAIL = AVAIL + NEWFL - FL ;
                    FL = NEWFL ;
                    END 
  
#         TRY SPILLING CAPSULES TO SCRATCH FILE.
# 
               NEED = INCR + SLOP - AVAIL ; 
               IF  NEED GT 0
                 AND  NOT CAPS               # IF NOT ALREADY SPILLED # 
               THEN BEGIN 
                    CAPS = TRUE ; 
                    REWIND (CSCR) ;              # REWIND SCRATCH FILE #
                    RECALL (CSCR) ; 
                    EXP = TABL [1] - SUBL ;       # TOTAL LENGH OF ALL #
                    IF  EXP GT 0                   # CAPSULES STILL IN #
                    THEN BEGIN                      # MEMORY, IF ANY #
                         AVAIL = AVAIL + EXP ;
                         SUM = SUM - EXP ;
                         TABL [1] = SUBL ;         # RESET TSUBL, AND # 
                         P<DUM> = TABF [1] + SUBL ; # WRITE CAPSULES #
                         WRITEW (CSCR, DUM, EXP) ;   # TO SCRATCH FILE #
                         END
                    IF  K EQ 1
                    THEN BEGIN               # IF P$TABLE$ IS P<TSUB> # 
                         IF  NOT SDAF         # DO NOT MAKE IT BIGGER # 
                         THEN INCR = 0 ;       # UNLESS CALLED BY SDA # 
                         NEWL = SUBL + INCR ; 
                    END  END
  
#         TRY INCREASING FIELD LENGTH UP TO (MAXFL).
# 
               NEED = INCR + SLOP - AVAIL ; 
               IF  NEED GT 0
               THEN BEGIN 
                    NEWFL = ((FL + NEED + FLMUL - 1) / FLMUL) * FLMUL ; 
                    IF  NEWFL GT MAXFL
                    THEN BEGIN            # NEWFL = MIN (NEWFL, MAXFL) #
                         NEWFL = MAXFL ;
                         IF  INCR GT (AVAIL + NEWFL - FL) 
                         THEN CALL ABRT1 ;             # *INSUFF FL* #
                         END
                    MEMORY (NEWFL) ;              # REQUEST NEW FL #
                    AVAIL = AVAIL + NEWFL - FL ;
                    FL = NEWFL ;
                    END 
               TEND = FL - 8 ;
               RETURN ; 
  
               END
  
          END                 # OF *ALLOC* #
  
  
  
  
#***      ASU - ACCUMULATE STORAGE USED.
# 
          XDEF PROC ASU ; 
          PROC ASU ;
  
#         *ASU* KEEPS TRACK OF THE MAXIMUM AMOUNT OF STORAGE
*         USED, I.E., THE MINIMUM FIELD LENGTH THAT IS ENOUGH 
*         TO RUN THE JOB SUCCESSFULLY.  *ASU* ADDS UP THE TABLE 
*         LENGTHS, IGNORING WHAT COULD SPILL TO SCRATCH FILES,
*         AND STORES THE LARGER OF THIS TOTAL AND THE PREVIOUS
*         MAXIMUM.
* 
*         *ASU* MUST ALWAYS BE CALLED BEFORE ANY TABLE IS MADE
*         SMALLER.  IN PARTICULAR, TO CLEAR A TABLE OUT YOU CAN 
*         USE      ALLOC (P<TXXX>, - TXXXL)     OR     TXXXL = 0
*         BUT IF YOU CHOOSE THE LATTER, YOU MUST CALL *ASU* FIRST.
****
# 
          BEGIN 
  
          ITEM INUSE ;
  
          INUSE = BASE + NTAB + 8 ;     # SUM BASE OF MANAGED SPACE  #
          FOR  I = 2 THRU NTAB  DO       #    + REQUIRED FREE SPACE  #
               INUSE = INUSE + TABL [I] ; #   + SUM OF TABLE LENGTHS #
          INUSE = INUSE + SUBL ;           #  - WHAT CAN SPILL OUT   #
          IF  INUSE GT SU 
          THEN SU = INUSE ;             # SU = MAX (SU, SUM) #
          RETURN ;
  
          END                 # OF *ASU* #
  
  
  
  
#***      SDA  -  SET DYNAMIC AREA BASE ADDRESS.
# 
          XDEF PROC SDA ; 
          PROC SDA ((NB)) ; 
  
          ITEM NB I ;              # NEW BASE ADDRESS # 
  
#         *SDA* ADJUSTS THE LOWER LIMIT OF THE MEMORY AREA IN 
*         WHICH THE MANAGED TABLES CAN EXIST, I.E., THE SPACE 
*         FROM (BASE) TO (FL).  *SDA* IS CALLED AS EACH SECONDARY 
*         OVERLAY IS LOADED, SO THAT (BASE) IS ALWAYS EQUAL TO
*         THE LWA+1 OF THE CURRENT OVERLAY AND NO MEMORY SPACE
*         IS WASTED.
****
# 
          BEGIN 
  
          ITEM L ;
  
          SDAF = TRUE ; 
          IF  NB LE TSUB                # IF NO NEED TO MOVE 1ST TABLE #
          THEN CALL ASU ;                    # ACCUMULATE STORAGE USED #
          ELSE BEGIN                    # OTHERWISE # 
               L = TSUBL ;                   # SAVE FIRST TABLE LENGTH #
               ALLOC (TSUB, NB - TSUB) ;     # AUGMENT TABLE #
               IF  CAPS                      # IF CAPSULES OVERFLOWED # 
               THEN L = SUBL ;                # RESET TABLE LENGTH #
               CALL ASU ;                    # ACCUMULATE STORAGE USED #
               MOVEI (L, TSUB, NB) ;         # MOVE TABLE TO NEW BASE # 
               TSUB = NB ;                   # SET NEW FWA OF TABLE # 
               TSUBL = L ;                   # RESTORE TRUE LENGTH #
               END
          BASE = NB ;                   # SET NEW BASE ADDRESS #
          SDAF = FALSE ;
          RETURN ;
  
          END                 # OF *SDA* #
  
     END  TERM
