Retro1.org codex

*DECK     SSTTMR
USETEXT TEXTSS
      PROC SSTTMR;
# TITLE - TABLE MANAGER ROUTINES.                                      #
 
      BEGIN  # SSTTMR # 
# 
**    SSTTMR - TABLE MANAGER ROUTINES.
* 
*     R. H. GOODELL.     76/06/17.    WRITTEN FOR USE WITH *DDLCG*. 
*     R. H. GOODELL.     80/02/15.    ADAPTED FOR USE WITH *DDLVAX*.
*     S. H. FISCHER      81/09/03.    ADAPTED FOR USE WITH NETWORKS.
*     F.    HOU.         81/07/27     ADD ENLARGE AND REMOVE SPACE. 
* 
*     THIS SYMPL SUBPROGRAM IS ROUGHLY EQUIVALENT TO THE STANDARD 
*     COMMON DECK *COMCMTP* WHICH CONTAINS A COMPASS MANAGED TABLE
*     PACKAGE WRITTEN BY G. R. MANSFIELD. 
* 
*     PROC SSTTMR 
* 
*     ENTRY        NONE.
* 
*     EXIT         NONE.
* 
*     NOTE - 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    MAIN
*         PROGRAM  MODULE  IT IS A SERIES OF BASED ARRAYS AND 
*         LENGTH ITEMS, BUT IN THE *SSTTMR* MODULE THE SAME  AREA 
*         IS  AN  ARRAY  OF TWO-WORD ENTRIES.  THIS RESULTS IN THE
*         FOLLOWING CORRESPONDENCE OF STORAGE LOCATIONS.
* 
*              MAIN                  SSTTMR              VIA
*               NAME            TABLES ITEM     DEF 
* 
*               TABLES           TABF [0]       BASE
*               FL               TABL [0]       FL
*               P<XXX>           TABF [1]        -
*                 XXXL           TABL [1]        -
*                                TABF [2]        -
*                 .              TABL [2]        -
*                 .                ...           -
*                 .              TABF [N]        -
*                                TABL [N]        -
*               P<TEND>          TABF [N+1]      -
*                 TENDL          TABL [N+1]     SU
* 
# 
 
# 
****  PROC SSTTMR - XREF LIST.
# 
      XREF
        BEGIN 
        PROC ABORT;          # ABORT JOB                               #
        PROC MESSAGE;        # ISSUE MESSAGE TO DAYFILE                #
        PROC MOVEI;          # MOVE BLOCK OF DATA, INDIRECT            #
        PROC RECALL;         # RETURN CONTROL WHEN COMPLETE            #
        PROC SSTRCM;         # REQUEST FIELD LENGTH                    #
        END 
# 
****
# 
 
 
# 
****  PROC SSTTMR - XDEF LIST.
# 
      XDEF
        BEGIN 
        PROC SSTASU;         # ACCUMULATE STORAGE USED                 #
        PROC SSTATS;         # ALLOCATE TABLE SPACE                    #
        PROC SSTDFL;         # DECREASE FIELD LENGTH                   #
        PROC SSTETS;         # ENLARGE TABLE SPACE                     #
        PROC SSTITM;         # INITIALIZE TABLE MANAGER                #
        PROC SSTRTS;         # REMOVE TABLE SPACE                      #
        PROC SSTSDA;         # SET DYNAMIC AREA BASE ADDRESS           #
        END 
# 
****
# 
 
 
      DEF BASE  #TABF [0]# ;           # FWA TABLE AREA # 
      DEF FL    #TABL [0]# ;           # FIELD LENGTH # 
      DEF FLMUL # O"4000" #;           # FIELD LENGTH MULTIPLE         #
      DEF SLOP  # O"1000" #;           # MINIMUM TOTAL AVAIL SPACE     #
      DEF SU    #TABL [NTAB+1] #;      # STORAGE USED # 
 
 
# 
*         LOCAL DATA. 
# 
      ITEM AVAIL;            # TOTAL AVAIL SPACE                       #
      ITEM EXP;              # FIXED EXPANSION SPACE                   #
      ITEM FRSTTBL;          # ADDRESS OF FIRST TABLE POINTER          #
      ITEM I;                # TABLE VECTOR INDEX                      #
      ITEM INCR;             # CHANGE IN TABLE SIZE                    #
      ITEM K;                # CURRENT TABLE INDEX                     #
      ITEM LASTTBL;          # ADDRESS OF LAST TABLE POINTER           #
      ITEM MAXFL;            # MAXIMUM FIELD LENGTH ALLOWED            #
      ITEM MEMWORD;          # WORD FOR PTO CM FL REQUESTS             #
      ITEM NEWA;             # NEW FWA OF TABLE                        #
      ITEM NEWL;             # NEW LENGTH OF TABLE K                   #
      ITEM NTAB;             # NUMBER OF TABLES                        #
      ITEM OVL;              # NONZERO FOR IMMEDIATE MEMORY REQUEST    #
      ITEM OVLBASE;          # BASE FOR LOADING OVERLAYS               #
      ITEM OVLFLRQ B = FALSE;# TRUE WHEN OVERLAY REQ ACTIVE            #
      ITEM SUM;              # TOTAL OF ALL TABLE LENGTHS              #
 
# 
*     THIS BASED ARRAY POINTS TO THE MEMORY REQUEST WORD. 
# 
      BASED ARRAY MREQ[0:0] S(1); 
        BEGIN 
        ITEM MREQ$FL  I(00,00,30);     # REQUEST AND RETURN CMFL       #
        ITEM MREQ$C   B(00,59,01);     # COMPLETION BIT                #
        END 
 
 
# 
*     THIS BASED ARRAY POINTS TO THE TABLE POINTERS TO BE MAINTAINED. 
# 
      BASED ARRAY TABLES [00:00] S(2);
        BEGIN                # TABLE POINTER VECTOR                    #
        ITEM TABA      U(00,00,30);    # NEW FWA                       #
        ITEM TABB      U(00,42,18);    # OLD FWA                       #
        ITEM TABF      I(00,00,60);    # CURRENT FWA                   #
        ITEM TABL      I(01,00,60);    # LENGTH ALLOCATED TO TABLE     #
        END 
      CONTROL EJECT;
      $BEGIN
      PROC CVT(TBL$PNTR); 
# TITLE - CHECK VALIDITY OF TABLE POINTER.                             #
 
      BEGIN   # CVT # 
# 
**    CVT - CHECK VALIDITY OF TABLE POINTER.
* 
*     D.K. ENDO    82/06/01 
* 
*     THIS PROCEDURE CHECKS IF THE POINTER FOR THE MANAGED TABLE IS 
*     VALID.
* 
*     PROC CVT(TBL$PNTR)
* 
*     ENTRY        1. TBL$PNTR - TABLE POINTER TO BE VALIDATED. 
* 
*     EXIT         1. NONE, IF POINTER IS O.K.
*                  2. DAYFILE MESSAGE AND ABORT, IF INVALID.
* 
# 
 
      ITEM TBL$PNTR;         # TABLE POINTER TO BE CHECKED             #
      ITEM TBL$LOC;          # TABLE POINTER LOCATION                  #
 
 
# 
*     THIS ARRAY DEFINES THE -NOT A TABLE POINTER- MESSAGE TEXT SENT
*     WHEN THE POINTER IS NOT WITHIN THE RANGE OF MANAGED TBL POINTERS
# 
      ARRAY NP$TXT [00:00] S(4);
        BEGIN 
        ITEM NP$MSG1    C(00,00,20) = ["ILLEGAL TABLE POINTE"]; 
        ITEM NP$MSG2    C(02,00,10) = ["R - SSTTMR"]; 
        ITEM NP$ZBYT    U(03,00,60) = [0];
        END 
 
 
# 
*     THIS ARRAY DEFINES THE -ERRONEOUS POINTER VALUE- MESSAGE TEXT SENT
*     WHEN THE TABLE POINTER DOES NOT POINT INTO THE MANAGED TABLE AREA.
# 
      ARRAY EPV$TXT [00:00] S(4); 
        BEGIN 
        ITEM EPV$MSG1   C(00,00,20) =["ERRONEOUS TABLE POIN"];
        ITEM EPV$MSG2   C(02,00,18) = ["TER VALUE - SSTTMR"]; 
        ITEM EPV$ZBYT   U(03,48,12) = [0];
        END 
 
 
# 
*                            CVT CODE BEGINS HERE 
* 
* 
*     IF THE TABLE POINTER IS NOT A MANAGED TABLE POINTER, THEN SEND AN 
*     ERROR MESSAGE INDICATING SO AND ABORT.
# 
      TBL$LOC = LOC(TBL$PNTR);
      IF TBL$LOC LS FRSTTBL OR
         TBL$LOC GR LASTTBL 
      THEN
        BEGIN 
        MESSAGE(NP$TXT,0);
        ABORT;
        END 
 
 
# 
*     IF POINTER NOT POINTING INTO THE MANAGED TABLE AREA, THEN 
*     SEND A MESSAGE INDICATING SO AND ABORT. 
# 
      IF TBL$PNTR LS BASE 
      THEN
        BEGIN 
        MESSAGE(EPV$TXT,0); 
        ABORT;
        END 
 
 
      RETURN;                # **** RETURN ****                        #
      END # CVT # 
      $END
      CONTROL EJECT;
      PROC PTO(AVAIL,INCR); 
# TITLE - PROCESS TABLE OVERFLOW.                                      #
 
      BEGIN  # PTO #
# 
**    PTO - PROCESS TABLE OVERFLOW. 
* 
*     R. H. GOODELL      76/06/17 
*     S. H. FISCHER      82/06/01      ADD CHECK FOR MEM REQUEST IN 
*                                        PROGRESS 
* 
*     THIS PROCEDURE IS CALLED BY *SSTATS* WHEN AVAIL MEMORY SPACE IS 
*     TOO SMALL.
* 
*     PROC PTO(AVAIL,INCR)
* 
*     ENTRY              1. AVAIL = AMOUNT OF SPACE CURRENTLY AVAILABLE 
*                        2. INCR  = AMOUNT OF SPACE NEEDED. 
* 
*     EXIT               1. MORE SPACE FOR TABLE EXPANSION. 
* 
# 
 
      ITEM AVAIL;            # AMOUNT OF AVAILABLE SPACE LEFT          #
      ITEM INCR;             # AMOUNT OF CP WORDS TO INCREASE/DECREASE #
      ITEM NEED;             # AMOUNT OF SPACE NEEDED                  #
      ITEM NEWFL;            # FIELD LENGTH AFTER MEM REQ IS COMPLETE  #
 
# 
*                            PTO CODE BEGINS HERE 
* 
* 
*     IF A MEMORY REQUEST IS ALREADY IN PROGRESS, WAIT UNTIL IT IS
*     COMPLETE, SAVE THE NEW FIELD LENGTH VALUE, AND CALCULATE THE
*     NEW AMOUNT OF AVAILABLE SPACE.
# 
      IF OVLFLRQ
      THEN                   # OVL CM REQ IN PROGRESS                  #
        BEGIN 
        IF NOT MREQ$C[0]
        THEN
          BEGIN 
          RECALL( MREQ[0] );
          END 
 
        NEWFL = MREQ$FL[0]; 
        AVAIL = AVAIL + NEWFL - FL; 
        FL = NEWFL; 
        TABF [NTAB+1] = FL - 8 ;
        OVLFLRQ = FALSE;
        END 
 
# 
*     CALCULATE THE AMOUNT OF SPACE NEEDED TO INCREASE THE TABLE. 
*     IF MORE SPACE IS NEEDED THEN REQUEST FOR IT.
# 
      NEED = INCR + SLOP - AVAIL ;
 
      IF  NEED GR 0 
      THEN
        BEGIN 
        OVL = 1;
        RFL(NEED,AVAIL,OVL,INCR); 
        END 
 
 
      RETURN;                # **** RETURN ****                        #
 
      END # PTO # 
      CONTROL EJECT;
      PROC RAS(K,AVAIL,INCR,SUM,BASE,NEWL); 
# TITLE - RE-ALLOCATE STORAGE.                                         #
 
      BEGIN  # RAS #
# 
**    RAS - RE-ALLOCATE STORAGE.
* 
*     S. H. FISCHER.         82/05/17.
* 
*     *RAS* IS CALLED WHEN ALL TABLES MUST BE MOVED TO ACCOMODATE THE 
*     EXPANSION OF ONE TABLE OR TO COMPACT THE TABLES TO ALLOW FOR
*     FIELD LENGTH REDUCTION. 
* 
*     PROC RAS(K,AVAIL,INCR,SUM,BASE,NEWL)
* 
*     ENTRY:  
*       AVAIL = AVAILABLE FREE MEMORY.
*       K = TABLE INDEX FOR TABLE TO GROW.
*       INCR = AMOUNT TABLE MUST GROW.
*       NEWL = NEW LENGTH OF TABLE K ( INCLUDED INCR ). 
*       BASE = POINTER TO BEGINNING OF MANAGED TABLES.
*       SUM = SUMMATION OF ALL TABLE LENGTHS. 
* 
*     EXIT: 
*       TABLES MOVED AROUND IN MEMORY.
* 
*     NOTES:  
*       EXPANSION SPACE ABOVE EACH TABLE IS AS FOLLOWS. 
*       GUARANTEE ONE FREE WORD ABOVE EACH TABLE. 
*       DIVIDE ONE HALF OF TOTAL AVAILABLE SPACE EQUALLY AMONG ALL
*       TABLES. 
*       DIVIDE THE OTHER HALF PROPORTIONALLY TO THE SIZE OF EACH TABLE. 
* 
# 
 
      ITEM K;                # INDEX TO TABLE POINTER                  #
      ITEM AVAIL;            # AMOUNT OF AVAILABLE SPACE               #
      ITEM INCR;             # AMOUNT OF CP WORDS TO INCREASE/DECREASE #
      ITEM SUM;              # TOTAL AMOUNT OF TABLE SPACE ALLOCATED   #
      ITEM BASE;             # POINTS TO THE BEGINNING OF MANAGED TBLS #
      ITEM NEWL;             # NEW LENGTH OF THE TABLE TO BE CHANGED   #
      ITEM NEWA;             # NEW ADDRESS OF TABLE                    #
 
# 
*                            RAS CODE BEGINS HERE 
# 
 
      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 STEP 1 UNTIL NTAB 
      DO
        BEGIN                # COMPUTE NEW FWA FOR EACH TABLE          #
        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     # MOVE TABLES UP                #
      DO
        BEGIN 
        IF TABA[I] GR TABB[I] 
        THEN
          BEGIN 
          MOVEI( TABL[I], TABB[I], TABA[I] ); 
          END 
        END 
 
      FOR I = 1 STEP 1 UNTIL NTAB      # MOVE TABLES DOWN              #
      DO
        BEGIN 
        IF TABA[I] LS TABB[I] 
        THEN
          BEGIN 
          MOVEI( TABL[I], TABB[I], TABA[I] ); 
          END 
        TABF[I] = TABA[I];
        TABA[I] = 0;         # RESET POINTERS                          #
        END 
 
      RETURN;                # **** RETURN ****                        #
 
      END # RAS # 
      CONTROL EJECT;
      PROC RFL(NEED,AVAIL,OVL,INCR);
# TITLE - REQUEST FIELD LENGTH.                                        #
 
      BEGIN  # RFL #
# 
**    RFL - REQUEST FIELD LENGTH. 
* 
*     S. H. FISCHER.         82/05/11.
* 
*     *RFL* IS CALLED TO REQUEST ADJUSTMENT IN THE CENTRAL
*     MEMORY FIELD LENGTH FOR THE PROGRAM.
* 
*     PROC RFL(NEED,AVAIL,OVL,INCR) 
* 
*     ENTRY:  
*       NEED = FIELD LENGTH INCREASE NEEDED.
*       AVAIL = AMOUNT OF MEMORY AVAILABLE FOR TABLE EXPANSION. 
*       OVL = ZERO IF MEMORY CAN BE WAITED FOR. 
*       INCR = AMOUNT OF SPACE TO ADD TO TABLE. 
* 
*     EXIT: 
*       IF OVL = NONZERO, AVAIL, FL UPDATED.
*                = ZERO, AVAIL, FL UPDATED IF MEMORY REQUEST
*                WAS SATISFIED IMMEDIATELY. 
*                OTHERWISE THE MEMORY REQUEST IS STILL PENDING. 
* 
* 
# 
 
 
      ITEM NEED;             # AMOUNT OF TOTAL SPACE NEEDED            #
      ITEM AVAIL;            # AMOUNT OF AVAILABLE SPACE               #
      ITEM OVL;              # NONZERO IF IMMEDIATE MEMORY REQUEST     #
      ITEM INCR;             # AMOUNT OF CP WORDS TO INCREASE/DECREASE #
      ITEM NEWFL;            # CALCULATED NEW FIELD LENGTH             #
 
 
# 
*     THIS ARRAY DEFINES THE MESSAGE SENT WHEN NO MORE FIELD LENGTH 
*     CAN BE ALLOCATED TO THIS JOB. 
# 
      ARRAY NOSPACE [00:00] S(4); 
        BEGIN 
        ITEM NS$MSG1   C(00,00,20) = ["  INSUFFICIENT CM SP"];
        ITEM NS$MSG2   C(02,00,17) = ["ACE, JOB ABORTED."]; 
        ITEM NS$ZBYT   U(03,42,18) = [ 0 ]; 
        END 
# 
*                            RFL CODE BEGINS HERE 
* 
* 
*     CALCULATE THE NEW FIELD LENGTH REQUIRED.  IF THE NEW FIELD
*     LENGTH REQUIRED IS LARGER THAN THE MAXIMUM FIELD LENGTH ALLOWED 
*     BY THE SYSTEM, THEN SET THE NEW FIELD LENGTH VALUE TO THE 
*     MAXIMUM ALLOWED, IF THAT STILL IS NOT ENOUGH ROOM, THEN SEND
*     A DAYFILE MESSAGE AND ABORT.
# 
      NEWFL = ((FL + NEED + FLMUL -1) / FLMUL) * FLMUL; 
 
      IF NEWFL GR MAXFL 
      THEN
        BEGIN 
        NEWFL = MAXFL;
        IF INCR GR (AVAIL + NEWFL - FL )
        THEN
          BEGIN 
          MESSAGE(NOSPACE, 0);
          ABORT;
          END 
        END 
 
# 
*     MAKE A MEMORY REQUEST WITH THE CALCULATED NEW FIELD LENGTH.  IF 
*     THE REQUEST IS COMPLETE, THEN SAVE THE NEW FIELD LENGTH AND 
*     THE AMOUNT OF SPACE AVAILABLE.
# 
      $BEGIN                 # INCREMENT COUNT FOR STATISTICS          #
      SVT$VAL[SVL"RCM"] = SVT$VAL[SVL"RCM"] + 1;
      $END
      SSTRCM( NEWFL, OVL, MREQ[0] );
 
      IF MREQ$C[0]
      THEN
        BEGIN 
        NEWFL = MREQ$FL[0]; 
        AVAIL = AVAIL + NEWFL - FL; 
        FL = NEWFL; 
        TABF [NTAB+1] = FL - 8 ;
        END 
 
      RETURN;                # **** RETURN ****                        #
 
      END # RFL # 
      CONTROL EJECT;
      PROC SSTASU;
# TITLE - ACCUMULATE STORAGE USED.                                     #
 
      BEGIN  # SSTASU # 
# 
**    SSTASU - ACCUMULATE STORAGE USED. 
* 
*     R. H. GOODELL      76/06/17 
* 
*     *ASU* KEEPS TRACK OF THE MAXIMUM AMOUNT OF STORAGE USED,
*     I.E. - THE MINIMUM FIELD LENGTH THAT IS ENOUGH TO RUN THE 
*     JOB SUCCESSFULLY. 
* 
*     PROC SSTASU 
* 
*     ENTRY         1. NONE 
* 
*     EXIT          1. NONE 
* 
*     NOTE: 
* 
*         *ASU* MUST ALWAYS BE CALLED BEFORE ANY TABLE IS MADE
*         SMALLER.  IN PARTICULAR, TO CLEAR A TABLE OUT YOU CAN 
*         USE      SSTATS (P<TXXX>, - TXXXL)     OR     TXXXL = 0 
*         BUT IF YOU CHOOSE THE LATTER, YOU MUST CALL *ASU* FIRST.
* 
# 
 
      ITEM INUSE;            # CALCULATED AMOUNT OF MEMORY IN USE      #
 
# 
*                            SSTASU CODE BEGINS HERE
# 
      INUSE = BASE + NTAB + 8 ;        # SUM BASE OF MANAGED SPACE  # 
 
      FOR  I = 1 STEP 1 UNTIL NTAB
      DO
        BEGIN 
        INUSE = INUSE + TABL [I] ;     #   + SUM OF TABLE LENGTHS # 
        END 
 
      IF  INUSE GR SU 
      THEN
        BEGIN 
        SU = INUSE ;                   # SU = MAX (SU, SUM) # 
        END 
 
      RETURN;                # **** RETURN ****                        #
 
      END # SSTASU #
      CONTROL EJECT;
      PROC SSTATS(P$TABLE$,(INCR)); 
# TITLE - ALLOCATE TABLE SPACE.                                        #
 
      BEGIN  # SSTATS # 
# 
**    SSTATS - ALLOCATE TABLE SPACE.
* 
*     R. H. GOODELL      76/06/17 
* 
*     *SSTATS* INCREASESE OR DECREASES THE AMOUNT OF MEMORY SPACE 
*     ALLOCATED TO THE SPECIFIED TABLE. 
* 
*     PROC SSTATS(P$TABLE$,(INCR))
* 
*     ENTRY         1. P$TABLE$ = TABLE POINTER (P<XXX>)
*                   2. INCR = AMOUNT TO INCREASE/DECREASE TABLE LENGTH. 
* 
*     EXIT          1. TABLE INCREASED/DECREASED. 
* 
# 
 
      ITEM P$TABLE$;         # TABLE POINTER                           #
      ITEM INCR;             # AMOUNT TO INCREASE/DECREASE TABLE LENGTH#
 
# 
*                            SSTATS CODE BEGINS HERE
* 
* 
*     CHECK THE TABLE POINTER FOR VALIDITY. 
# 
 
      $BEGIN
      CVT(P$TABLE$);
      $END
 
 
# 
*     IF TABLE IS TO BE DECREASED, THEN ACCUMULATE STORAGE USED.
# 
      IF  INCR LS 0 
      THEN
        BEGIN 
        SSTASU; 
        END 
 
# 
*     CALCULATE THE TABLE INDEX.  CALCULATE AND SAVE THE NEW TABLE
*     LENGTH.  IF TABLE INCREASE CAUSES IT TO OVERLAP THE NEXT TABLE, 
*     THEN CALCULATE THE TOTAL AVAILABLE SPACE, AND IF IT IS LESS 
*     THAN *SLOP*, THEN GET MORE MEMORY, FINALLY SHIFT THE TABLES 
*     AROUND TO ACCOMODATE THE NEW TABLE LENGTH.
# 
      K = (LOC (P$TABLE$) - LOC (TABLES)) / 2 ; 
 
      NEWL = TABL [K] + INCR ;
 
      IF  (TABF [K] + NEWL) GQ TABF [K+1] 
      THEN
        BEGIN 
        SUM = TABL [1] ;
        FOR  I = 2 STEP 1 UNTIL NTAB
        DO
          BEGIN 
          SUM = SUM + TABL [I] ;
          END 
 
        AVAIL = TABF [NTAB+1] - BASE - NTAB - SUM ; 
        IF  AVAIL LS (INCR + SLOP)
        THEN
          BEGIN 
          PTO(AVAIL, INCR); 
          END 
 
        $BEGIN               # INCREMENT COUNT FOR STATISTICS          #
        SVT$VAL[SVL"RAS1"] = SVT$VAL[SVL"RAS1"] + 1;
        $END
        RAS(K,AVAIL,INCR,SUM,BASE,NEWL);
        END 
# 
*     STORE THE NEW TABLE LENGTH. 
# 
 
      TABL [K] = NEWL ; 
 
      RETURN;                # **** RETURN ****                        #
 
 
      END # SSTATS #
      CONTROL EJECT;
      PROC SSTDFL;
# TITLE SSTDFL - DECREASE FIELD LENGTH.                                #
 
      BEGIN # SSTDFL #
# 
**    SSTDFL - DECREASE FIELD LENGTH. 
* 
*     S. H. FISCHER.         82/05/13.
* 
*     THIS PROCEDURE WILL REMOVE THE OVERLAY AREA, MOVE TABLES DOWM 
*     WITH ONLY THE MINIMUM FREE SPACE AVAILABLE AND THEN REDUCE
*     THE PROGRAMS FIELD LENGTH.
* 
*     PROC SSTDFL 
* 
*     ENTRY:  
*       THE OVERLAY AREA SHOULD BE ABLE TO BE REMOVED.
* 
*     EXIT: 
*       THE FIELD LENGTH OF THE PROGRAM REDUCED IF POSSIBLE.
* 
# 
 
 
      ITEM NEED;             # AMOUNT OF FIELD LENGTH NEEDED           #
 
# 
*                            SSTDFL CODE BEGIN HERE 
* 
* 
*     SELECT ANY TABLE (ITS LENGTH IS NOT CHANGED) AND SET THE INCRE- 
*     MENT TO ZERO, SAVE THE LENGTH, AND SET THE AMOUNT OF AVAILABLE
*     MEMORY TO SLOP. 
# 
      INCR = 0; 
      K = 1;                 # SELECTED FIRST TABLE                    #
      NEWL = TABL[K]; 
      AVAIL = SLOP; 
# 
*     CALCULATE TOTAL TABLE SPACE USED. 
# 
 
      SUM = TABL[1];
      FOR I = 2 STEP 1 UNTIL NTAB 
      DO
        BEGIN 
        SUM = SUM + TABL[I];
        END 
# 
*     CALCULATE THE AMOUNT OF SPACE NOT BEING USED.  IF IT IS GREATER 
*     THAN *SLOP* THEN SQUEEZE OUT THE UNNECESSARY SPACE. 
# 
 
      NEED = FL - (BASE + SUM); 
      IF NEED GR AVAIL
      THEN
        BEGIN 
        $BEGIN               # INCREMENT COUNT FOR STATISTICS          #
        SVT$VAL[SVL"RAS2"] = SVT$VAL[SVL"RAS2"] + 1;
        $END
        RAS(K,AVAIL,INCR,SUM,BASE,NEWL);
        END 
# 
*     CALCULATE THE TOTAL FIELD LENGTH NEEDED WITH THE TOTAL AVAIL- 
*     ABLE SPACE SET TO *SLOP*.  IF A FIELD LENGTH ADJUSTMENT IS
*     NEEDED, THEN DO IT. 
# 
 
      NEED = BASE + SUM + AVAIL - FL; 
 
      IF NEED NQ 0
      THEN
        BEGIN 
        RFL(NEED, AVAIL, OVL, INCR);
        END 
 
      RETURN;                # **** RETURN ****                        #
 
      END # SSTDFL #
      CONTROL EJECT;
      PROC SSTETS (P$TABLE$,(P),(N)) ;
# TITLE SSTETS - ENLARGE TABLE SPACE. # 
 
      BEGIN  # SSTETS # 
# 
**    SSTETS - ENLARGE TABLE SPACE. 
* 
*     FLORENCE HOU           81/08/21 
* 
*     THIS PROCEDURE ENLARGES THE SPECIFIED TABLE WITH THE AMOUNT OF
*     MEMORY SPACE *N*. 
* 
*     PROC SSTETS(P<TXXX>,P,N)
* 
*     ENTRY     P<TXXX> = TABLE POINTER.
*               P       = POSITION WITHIN TABLE TO ENLARGE TABLE. 
*               N       = NUMBER OF WORDS TO ADD. 
* 
*     EXIT      TABLE IS ENLARGED.
* 
*     NOTES     NONE. 
* 
*     METHOD
* 
*     SSTETS ADDS N TO THE TABLE LENGTH WORD TXXXL. 
*     ANY OR ALL OF THE TABLES MAY GET MOVED AROUND IN MEMORY,
*     AND THEIR POINTERS UPDATES, IF *SSTETS* FINDS THIS TO BE
*     NECESSARY OR APPROPRIATE. *SSTETS* MAY ALSO INCREASE THE
*     JOB FIELD LENGTH TO GET MORE SPACE. 
* 
# 
 
      ITEM P$TABLE$ ;              # ARGUMENT IS P<TXXX>               #
      ITEM P          I;           # POSITION WITHIN TABLE             #
      ITEM N          I;           # NUMBER OF WORDS TO ADD            #
 
 
      ITEM I          I;           # LOOP VARIABLE                     #
      ITEM K          I;           # CURRENT TABLE INDEX               #
      ITEM COUNT      I;           # COUNT OF WORDS TO MOVE            #
      ITEM FROM       I;           # FIRST WORD OF THE *FROM* BLOCK    #
      ITEM TO         I;           # FIRST WORD OF THE *TO* BLOCK      #
 
      BASED ARRAY DUMMY[0:0] S(1);  # DUMMY BASED ARRAY                #
        BEGIN 
        ITEM DUMMYY   U(00,00,60);
        END 
 
 
# 
*                            SSTETS CODE BEGINS HERE
# 
 
      $BEGIN                 # INCREMENT COUNT FOR STATISTICS          #
      SVT$VAL[SVL"ETS"] = SVT$VAL[SVL"ETS"] + 1;
 
      CVT(P$TABLE$);         # VALIDATE TABLE POINTER                  #
      $END
 
 
      K=(LOC(P$TABLE$)-LOC(TABLES)) / 2 ;        # TABLE INDEX         #
 
      $BEGIN
      IF ((N LQ 0) OR (P GR TABL[K])) 
      THEN
        BEGIN 
        ABORT;
        END 
      $END
 
 
      COUNT = TABL[K]-P ;   # COUNT THE NUM OF WORDS TO MOVE #
      SSTATS (P$TABLE$,N) ;  # ALLOCATE *N* TABLE SPACE                #
      FROM = TABF[K]+P ;     # FIRST WORD OF FROM BLOCK                #
      TO = TABF[K]+P+N ;     # FIRST WORD OF *TO* BLOCK                #
 
      IF (COUNT NQ 0) 
      THEN
        BEGIN 
        MOVEI (COUNT,FROM,TO);  # MOVE *COUNT* WORDS                   #
        END 
 
      FOR I=FROM STEP 1 UNTIL TO-1
      DO
        BEGIN 
        P<DUMMY>=I; 
        DUMMYY[0]=0;         # ZERO THE ENLARGED SPACE                 #
        END 
 
      RETURN ;
 
      END # SSTETS #
      CONTROL EJECT;
      PROC SSTITM( PTABLES, TEND ,LOADBASE ); 
# TITLE - INITIALIZE TABLE MANAGER.                                    #
 
      BEGIN # SSTITM #
# 
**    SSTITM - INITIALIZE TABLE MANAGER.
* 
*     R. H. GOODELL    76/06/17 
*     D. K. ENDO       82/06/01 
* 
*     THIS PROCEDURE INITIALIZES THE TABLE MANAGER AND THE TABLE
*     POINTERS. 
* 
*     PROC SSTITM(PTABLES, TEND, LOADBASE)
* 
*     ENTRY            1. PTABLES = FIRST WORD OF TABLE POINTERS. 
*                      2. TEND = LAST TABLE POINTER (DUMMY ENTRY).
*                      3. LOADBASE = POINTER TO WHERE OVERLAYS ARE
*                                        LOADED.
* 
*     EXIT             1. TABLE MANAGER INITIALIZED.
*                      2. TABLE POINTERS INITIALIZED. 
* 
# 
 
      ITEM PTABLES;          # FIRST WORD OF TABLE POINTERS            #
      ITEM TEND;             # LAST TABLE POINTER (DUMMY ENTRY)        #
      ITEM LOADBASE;         # POINTER TO WHERE OVERLAYS ARE LOADED    #
      ITEM I;                # LOOP INDUCTION VARIABLE                 #
 
# 
*                            SSTITM CODE BEGINS HERE
* 
* 
*     SAVE THE ADDRESS OF THE FIRST AND LAST TABLE POINTERS.
*     SAVE THE LOAD BASE VALUE. 
# 
 
      FRSTTBL = LOC(PTABLES); 
      LASTTBL = LOC(TEND);
 
      OVLBASE = LOADBASE; 
 
 
# 
*     POINT THE MANAGER-S TABLES BASED ARRAY TO THE TABLE POINTERS. 
*     CALCULATE THE NUMBER OF TABLES DEFINED. 
*     PRESET ALL TABLE POINTERS.  NOTE - (BASE) HAS ALREADY 
*     BEEN SET, BY MAIN.
# 
 
      P<TABLES> = LOC(PTABLES) ;
      NTAB = (LOC (TEND) - LOC (TABLES)) / 2 - 1 ;
      FOR  I = 1 STEP 1 UNTIL NTAB
      DO
        BEGIN 
        TABF [I] = BASE + I - 1 ; 
        TABL [I] = 0 ;
        END 
# 
*     GET THE CURRENT FIELD LENGTH AND STORE IT.
# 
 
      P<MREQ> = LOC(MEMWORD); 
      SSTRCM( 0, TRUE, MREQ );
      FL = MREQ$FL[0];
# 
*     GET THE MAXIMUM FIELD LENGTH ALLOWED AND SAVE IT. 
# 
 
      SSTRCM( -1, TRUE, MREQ ); 
      MAXFL = MREQ$FL[0]; 
# 
*     CALCULATE AND STORE THE SPACE ABOVE THE LAST TABLE. 
*     INITIALIZE THE STORAGE USED.
# 
 
      TABF [NTAB+1] = FL - 8 ;
      SU = TABF [NTAB] + 8 ;
 
      RETURN;                # **** RETURN ****                        #
 
      END # SSTITM #
      CONTROL EJECT;
      PROC SSTRTS (P$TABLE$,(P),(N)) ;
# TITLE SSTRTS - REMOVE TABLE SPACE. #
 
      BEGIN  # SSTRTS # 
# 
**    SSTRTS - REMOVE TABLE SPACE.
* 
*     FLORENCE HOU           81/08/21 
* 
*     THIS PROCEDURE REMOVES THE AMOUNT OF MEMORY SPACE ALLOCATED 
*     TO THE SPECIFIED TABLE. 
* 
*     PROC SSTRTS(P<TXXX>,P,N)
* 
*     ENTRY     P<TXXX> = TABLE POINTER.
*               P       = POSITION WITHIN TABLE TO REMOVE WORDS.
*               N       = NUMBER OF WORDS TO REMOVE.
* 
*     EXIT      TABLE SPACE IS REMOVED. 
* 
*     NOTES     NONE. 
* 
*     METHOD
*     SSTRTS SUBTRACTS N TO THE TABLE LENGTH WORD TXXXL.
*     NONE OF THE TABLES GET MOVED AROUND IN MEMORY, AND
*     THEIR POINTERS NOT CHANGED. 
* 
# 
 
      ITEM P$TABLE$ ;         # ARGUMENT IS P<TXXX>                    #
      ITEM P       I;         # POSITION WITHIN TABLE                  #
      ITEM N       I;         # NUMBER OF WORDS TO REMOVE              #
      ITEM K       I;         # CURRENT TABLE INDEX                    #
      ITEM COUNT   I;         # COUNT OF WORDS TO MOVE                 #
      ITEM FROM    I;         # FIRST WORD OF THE *FROM* BLOCK         #
      ITEM TO      I;         # FIRST WORD OF THE *TO* BLOCK           #
 
 
 
# 
*                            SSTRTS CODE BEGINS HERE
# 
 
      $BEGIN                 # INCREMENT COUNT FOR STATISTICS          #
      SVT$VAL[SVL"RTS"] = SVT$VAL[SVL"RTS"] + 1;
 
      CVT(P$TABLE$);         # VALIDATE TABLE POINTER                  #
      $END
 
 
      K=(LOC(P$TABLE$)-LOC(TABLES)) / 2 ;      # TABLE INDEX           #
 
      $BEGIN
      IF((N LQ 0) OR (P GR TABL[K]))
      THEN
        BEGIN 
        ABORT;
        END 
      $END
 
      COUNT = TABL[K]-P-N;   # COUNT THE NUM OF WORDS TO MOVE          #
      FROM = TABF[K]+P+N;    # FIRST WORD OF FROM BLOCK                #
      TO = TABF[K] + P ;     # FIRST WORD OF *TO* BLOCK                #
 
      IF (COUNT NQ 0) 
      THEN
        BEGIN 
        MOVEI(COUNT,FROM,TO);  # MOVE *COUNT* WORDS                    #
        END 
 
      SSTASU ;               # ACCUMULATE STORAGE USED                 #
 
      TABL[K]=TABL[K] - N;   # NEW LENGTH OF TABLE                     #
 
      RETURN;                # **** RETURN ****                        #
 
      END # SSTRTS #
      CONTROL EJECT;
      PROC SSTSDA ((NB),MEMSTAT,DONE) ; 
# TITLE - SET DYNAMIC AREA BASE.                                       #
 
      BEGIN # SSTRTS #
# 
**    SSTSDA - SET DYNAMIC AREA BASE ADDRESS. 
* 
*     R. H. GOODELL    76/06/17 
*     S. H. FISCHER    82/06/01 
* 
*     THIS PROCEDURE ADJUSTS THE LOWER LIMIT OF THE MEMORY AREA IN
*     WHICH THE MANAGED TABLES CAN EXIST, I.E. - THE SPACE FROM 
*     (BASE) TO (FL).  *SSTSDA* IS CALLED AS EACH OVERLAY IS LOADED 
*     SO THAT (BASE) IS ALWAYS EQUAL TO THE LWA+1 OF THE CURRENT
*     OVERLAY AND NO MEMORY SPACE IS WASTED.
* 
*     PROC SSTSDA((NB),MEMSTAT,DONE)
* 
*     ENTRY            1. NB = NEW BASE ADDRESS.
*                      2. MEMSTAT = STATUS WORD FOR OVERLAY MEM REQ.
* 
*     EXIT             1. DONE = RETURN STATUS TO MOVE IS DONE. 
* 
# 
 
      ITEM NB;               # NEW BASE ADDRESS                        #
      ITEM MEMSTAT;          # STATUS WORD FOR OVERLAY MEM REQ         #
      ITEM DONE  B;          # RETURN STATUS TO MOVE IS DONE           #
      ITEM L;                # FIRST TABLE LENGTH                      #
      ITEM NEED;             # AMOUNT OF FIELD LENGTH NEEDED           #
 
# 
*                            SSTSDA CODE BEGINS HERE
* 
* 
*     CLEAR THE DONE FLAG.
*     CALCULATE THE TOTAL AMOUNT OF TABLE SPACE CURRENTLY ALLOCATED.
# 
 
      $BEGIN                 # INCREMENT COUNT FOR STATISTICS          #
      SVT$VAL[SVL"SDA"] = SVT$VAL[SVL"SDA"] + 1;
      $END
 
 
      DONE = FALSE; 
      SUM = TABL[1];
      FOR I = 2 STEP 1 UNTIL NTAB 
      DO
        BEGIN 
        SUM = SUM + TABL[I];
        END 
# 
*     CALCULATE THE AMOUNT OF MEMORY AVAILABLE.  IF THERE IS NOT
*     ENOUGH FIELD LENGTH TO MOVE THE TABLES TO NEW BASE ADDRESS, 
*     THEN CALCULATE THE SPACE NEEDED AND MAKE A MEMORY REQUEST.
*     IF THE REQUEST IS NOT COMPLETE, THEN RETURN.  REPOINT BASED ARRAY 
*     TO TABLE MANAGER-S MEMORY REQUEST STATUS WORD AND CLEAR MEM REQ 
*     FLAG. 
# 
 
      AVAIL = TABF[NTAB+1] - OVLBASE - NTAB - SUM;
 
      IF AVAIL LS ( NB - OVLBASE + SLOP ) 
      THEN
        BEGIN 
        OVL = 0;
        INCR = 0; 
        P<MREQ> = LOC(MEMSTAT); 
        NEED = (NB - OVLBASE + SLOP) - AVAIL; 
        OVLFLRQ = TRUE; 
        RFL(NEED, AVAIL, OVL, INCR);
        IF NOT MREQ$C[0]
        THEN
          BEGIN 
          RETURN; 
          END 
        P<MREQ> = LOC(MEMWORD); 
        OVLFLRQ = FALSE;
        END 
# 
*     IF THE TABLES NEED TO BE MOVED UP, THEN CALCULATE THE NEW AMOUNT
*     OF AVAILABLE SPACE AND MOVE THE TABLES. 
# 
 
 
      IF  NB GR TABF [1]
      THEN                        # MUST RELOCATE TABLES    # 
        BEGIN 
        I = 1;                     # TABLE INDEX, ANY TABLE WILL DO#
        L = TABL [1] ;             # FIRST TABLE LENGTH            #
        INCR = 0;                  # NO TABLE SIZE CHG INVOLVED    #
        AVAIL = TABF[NTAB+1] - NB - NTAB - SUM;  # ADJ FOR NEW BASE  #
 
        $BEGIN               # INCREMENT COUNT FOR STATISTICS          #
        SVT$VAL[SVL"RAS3"] = SVT$VAL[SVL"RAS3"] + 1;
        $END
        RAS (I, AVAIL, INCR, SUM, NB, L);        # MOVE TABLES       #
        END 
# 
*     STORE THE NEW BASE ADDRESS, CALCULATE ACCUMULATE STORAGE USED 
*     AND SET THE DONE STATUS.
# 
 
      BASE = NB ;                   # SET NEW BASE ADDRESS #
      SSTASU;                          # ACCUMULATE STORAGE USED       #
      DONE = TRUE;
 
      RETURN;                # **** RETURN ****                        #
 
      END # SSTSDA #
 
      END # SSTTMR #
      TERM