*DECK VIRTUAL 
USETEXT CCTTEXT 
USETEXT DNTEXT
          FUNC VIRTUAL ((TABLENBR), (TABLEENTRY));
 #                                                                     #
 #     VIRTUAL - HANDLES THE TABLES WITH A VIRTUAL MEMORY METHOD       #
 #                                                                     #
 #        GIVEN - TABLE NUMBER IN TABLENBR,                            #
 #                TABLE ENTRY IN TABLEENTRY                            #
 #                                                                     #
 #                CALLED AS FUNCTION    XXX = VIRTUAL (TBL, ENTRY)     #
 #                    TBL IS EITHER TABLETYPE"XXX$" OR XXX$            #
 #                                                                     #
 #        RETURNS INDEX INTO PORTION OF TABLE IN CORE                  #
 #            PERFORMS NEEDED CMM CALLS AND INPUT-OUTPUT FOR TABLES    #
 #                                                                     #
          BEGIN 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        DEBUGGING OPTIONS 
 *
 *        TO SET CHANGE THE DEF TO 1
 *
 *        DEBUGCMMCALL - PRINTS OUT ALL CMM CALLS AND OVERFLOW CONDITS
 *
 #
          DEF DEBUGCMMCALL #0#; 
 #
 *        DEBUGCALLS - WRITES ALL CALLS TO VIRTUAL ON FILE VIRTTRC
 *            THE FORMAT IS (RT=Z, BT=C)
 *                COL 1-10, CALL NAME - VIRTUAL, TMFIXSZ, TMRECL, TMREOP
 *                    TMRTNTB 
 *                COL 11-20, TABLE NAME 
 *                COL 21-30, ORDINAL (VIRTUAL ONLY) 
 *                COL 31-40, "READ" F READ, "WRTE" F WRTE, "RD-WR"
 *                    IF BOTH, BLANK IF NO I-O. 
 *
 #
          DEF DEBUGCALLS #0#; 
 #
 *
 *
 *
 *        ARRAY USED BY DEBUGCALLS
 #
          CONTROL IFNQ DEBUGCALLS,0;
          ARRAY DEBUGCALLA [0:0] S(4);
              BEGIN 
               ITEM DEBUGFILLER    C(0,0,1) = [" "];
              ITEM DEBUGCNAME      C(0,6,9);
              ITEM DEBUGCTNAME     C(1,0,10); 
              ITEM DEBUGCORD       C(2,0,10); 
              ITEM DEBUGCSTATUS    C(3,0,10) = [" "]; 
              END 
          CONTROL FI; 
 #
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          CONTROL NOLIST; 
*CALL ASMSEQ
  
*CALL AUXT1 
*CALL AWRT
*CALL CTEXT 
          CONTROL NOLIST; 
          CONTROL LIST; 
*CALL DNT 
*CALL ETEXT 
*CALL FDLT
*CALL FDRDT1
*CALL FNAT1 
*CALL GTEXT1
*CALL INT1
*CALL LAT1
*CALL LDSET 
*CALL LPOOL 
*CALL LISTOBJ 
*CALL NAMET 
*CALL PAT1
*CALL PLT1
*CALL PNAT1 
*CALL PNT 
  
*CALL RALINE
  
*CALL RCT 
*CALL RWT1
*CALL DBSAT 
*CALL SEGPTR
*CALL SPBT1 
*CALL WORKTABS
*CALL TABLEDF 
*CALL TABLETYP
          CONTROL LIST; 
          XREF
              BEGIN 
              PROC ABORT; 
              FUNC CMI$ALV; 
              PROC CMI$CSV; 
              PROC CMI$FRV; 
              PROC CMI$GLV; 
              PROC CMI$SLV; 
              FUNC CMM$AGR; 
              FUNC CMM$ALV I; 
              PROC CMM$DOE; 
              PROC CMM$GLV; 
              FUNC CMM$POE; 
              ITEM DBCALLF; 
              FUNC DEC C(10); 
              PROC ECSREAD; 
              ITEM ECSUSED I; 
              PROC ECSWRITE;
              PROC GETWA; 
              PROC OUTPUT;
              FUNC INDREF;
              PROC PRINTVAL;
              PROC PRINTOCT;
              PROC PUTSQ; 
              PROC PUTWA; 
              ITEM ZRPARAM; 
              END 
  
          XDEF
              BEGIN 
              PROC TMFIXSZ; 
              PROC TMREOP;
              PROC TMRECL;
              PROC TMRTNTB; 
              PROC TMSETRO; 
              PROC TMSPLIT; 
              END 
          XDEF ITEM PHDEBUG U = 0;  #TEMPORARY FOR NOW - USED BY PP#
          XDEF ITEM BLKGID U;      #CONTAINS BLOCK ID FOR CMM#
          ITEM BASECORE I;
          ITEM CURRPTAB I;  # CURRENT PAGE TABLE INDEX #
          ITEM ECSAVAIL I;
          ITEM ECSSPACE I = 0;
          ITEM ENTRYSIZE U; 
          ITEM FILENBR U; 
          ITEM FIRSTWA U; 
          ITEM LASTWA I;
          ITEM OVERFLOWED B;       #SET IF OVERFLOW ROUTINE FOR EXTEND# 
          ITEM OVERFLOWREAD B=FALSE;   #SET IF READING FROM OVERFLOW# 
          ITEM READFLAG B = FALSE;
          ITEM SPLITTINGFLG B = FALSE;
          ITEM PAGETASGD B = FALSE; 
          ITEM TABLEENTRY U;
          ITEM TABLENBR S:TABLETYPE;
          ITEM TEMP1 I; 
          ITEM TEMP2 I; 
          BASED ARRAY ZRFILL [1:10000] S(1);
              ITEM ZRFILLITEM U(0,0,60);
  
          DEF PAGETINC #10#;  # AMOUNT TO INCREMENT PAGE TABLE #
          CONTROL INERT;
          CONTROL DISJOINT; 
          BASED ARRAY PAGETABLE [1:1] S(2); 
              BEGIN 
              ITEM PTOFFSET     I(0,00,18);  #ENTRY OFFSET TO THIS PAGE#
              ITEM PTFENTRY     U(0,18,18);  #FIRST IN CORE ENTRY#
              ITEM PTNEXTENT    U(0,36,06);  #PTR TO NEXT ENTRY#
              ITEM PTLENTRY     I(0,42,18);  #LAST IN CORE ENTRY# 
              ITEM PTLEN        I(1,00,18);  #LENGTH OF PAGE# 
              ITEM PTASGD       B(1,18,01);  #ASSIGNED FLAG#
              ITEM PTSPLITPT    U(1,24,18);  #POINT WHERE SPLIT#
              ITEM PTFETHISSEC  I(1,42,18);  #FIRST ENTRY IN SEC# 
              END 
          CONTROL EJECT;
 #     NAMES OF TABLES PROCESSED BY VIRTUAL - USED FOR DEBUG ONLY      #
          $BEGIN
          ARRAY TABNAMES [1:NBRTABLES] S(1);
              ITEM TABLENAME C(0,0,10)  =[
                  "AUX",
                  "AWRT", 
                  "NAMET",
                  "UNUSED", 
                  "UNUSED", 
                  "OBJLIST",
                  "CTEXT",
                  "UNUSED", 
                  "DNAT", 
                  "DNT",
                  "ETEXT",
                  "FDLT", 
                  "FDRDT",
                  "FNAT", 
                  "GTEXT",
                  "INT",
                  "LAT",
                  "LDSET",
                  "LPOOL",
                  "PAT",
                  "PLT",
                  "PLTST",
                  "PNAT", 
                  "PNT",
                  "RCT",
                  "RWT",
                  "SAT",
                  "SEGPTR", 
                  "SPBT", 
                  "ASMSEQ", 
                  "WORK1",
                  "WORK2",
                  "WORK3",
                  "WORK4",
                  "WORK5",
                  ];
  
 #     USED FOR COUNTING WHICH CASES ARE USED IN VIRTUAL MAIN LOOP     #
          ITEM CASECOUNT1 I=0;
          ITEM CASECOUNT2 I=0;
          ITEM CASECOUNT3 I=0;
          ITEM CASECOUNT4 I=0;
          ITEM CASECOUNT5 I=0;
          $END
          CONTROL EJECT;
          PROC ADDENTRY;
 #        ADDENTRY ADDS AN ENTRY TO THE END OF THE TABLE               #
 #                                                                     #
 #        DOES  -  ADDS A NEW ENTRY TO THE END OF THE TABLE            #
 #                 IF THE TABLE OVERFLOWS, IT EITHER EXTENDS IT        #
 #                 OR DUMPS IT TO THE PROPER FILE                      #
 #                 THE PROPER POINTERS ARE SET UP IN ANY CASE          #
 #                                                                     #
          BEGIN 
  
          $BEGIN
          IF TTABFIXED [TABLENBR] 
          THEN
              BEGIN 
              PRINTERRORS ("FIXED TABLE REFERENCED PAST END         "); 
              ABORT;
              END 
          IF TABLEENTRY GR TTABLASTENT [TABLENBR] + 100 
          THEN
              BEGIN 
              PRINTERRORS ("NEW ENTRY GR PREVIOUS LAST ENTRY + 100"); 
              OUTPUT (2, "LAST ENT =", DEC (TTABLASTENT [TABLENBR])); 
              END 
          $END
          IF NOT TTABASGD [TABLENBR]
          THEN
              BEGIN 
              INITTABLE;     # NOT YET ASSIGNED - INITIALIZE IT # 
              IF TABLEENTRY LQ TTABLVENT [TABLENBR] 
              THEN
              GOTO ADDENTEX;  #ENTRY WILL FIT IN ALLOCATED SPACE #
              END 
          IF TTABHLDSPLIT [TABLENBR] NQ 0 
          AND TABLEENTRY GQ TTABHLDSPLIT [TABLENBR] 
          THEN
              BEGIN 
              TTABLASTENT [TABLENBR] = TTABLVENT [TABLENBR];
              SPLITTAB;  # HIT A SPLIT POINT - SPLIT TABLE #
              END 
          ELSE
              BEGIN 
              IF TTABINC [TABLENBR] EQ 0
              THEN
                  ADDTOFILE;  # ENTRY ADDED TO FILE # 
              ELSE
                  ADDTOCORE;  # EXPAND CORE AND ADD # 
              END 
 ADDENTEX:  
          RETURN; 
          END 
          CONTROL EJECT;
          PROC ADDTOCORE; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        ADDTOCORE - EXPAND CORE AND ADD ENTRY TO CORE 
 *
 *        CHANGES TTABFCENT AND TTABLCENT AND TTABCALLOC
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM INC I; 
  
          TEMP1 = TTABINC [TABLENBR]; 
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          INC = (((TABLEENTRY - TTABLVENT [TABLENBR]) * ENTRYSIZE 
              + TEMP1 - 1) / TEMP1) * TEMP1;   # AMOUNT TO GROW # 
          CONTROL IFNQ DEBUGCMMCALL,0;
          PRINTCMMCALL ("EXTEND", INC); 
          CONTROL FI; 
          OVERFLOWED = FALSE; 
          CMI$GLV (TTABBASE [TABLENBR], INC);  #GROW TABLE# 
          IF OVERFLOWED 
          THEN
              BEGIN  # TABLE OVERFLOWED CMM AND WAS PICKED TO REDUCE #
              ADDTOFILE;  # NOW HAS TO BE ADDED TO FILE # 
              RETURN; 
              END 
          $BEGIN
          TTABNBRINC [TABLENBR] = TTABNBRINC [TABLENBR] + 1;
          $END
          TEMP2 = TTABCALLOC [TABLENBR];
          TTABCALLOC [TABLENBR] = TEMP2 + INC;
          P<ZRFILL> = INDREF(TTABBASE [TABLENBR]) + TEMP2;
          FOR TEMP1 = 1 STEP 1 UNTIL INC DO  # ZERO OUT NEW AREA #
              ZRFILLITEM [TEMP1] = 0; 
          SETLIMS (0, TEMP2 + INC); 
          TTABLVENT [TABLENBR] = TTABLCENT [TABLENBR];
          RETURN; 
          END 
          CONTROL EJECT;
          PROC ADDTOFILE; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        ADDTOFILE - EXTEND THE FILE AND ADD ENTRY TO END OF IT
 *
 *        CHANGES VARIOUS POINTERS
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM ADDSIZEWDS I;
          ITEM ADDSIZEENTS I; 
  
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          IF NOT SPLITTINGFLG 
          THEN
              WRITETAB (TRUE);  # WRITE LAST SECTION IF NOT SPLITTING # 
 #     WRITETAB OR SPLITTAB WILL SET CURRPTAB AND BASECORE #
          P<ZRFILL> = BASECORE; 
          IF TTABSPLIT [TABLENBR] 
          THEN
              BEGIN  # TABLE IS SPLIT OR SPLITTAB IS CALLING ADDTOFILE# 
              ADDSIZEWDS = PTLEN [CURRPTAB];
              ADDSIZEENTS = ADDSIZEWDS / ENTRYSIZE; 
              PTFENTRY [CURRPTAB] = TTABLVENT [TABLENBR] + 1; 
              PTLENTRY [CURRPTAB] = PTFENTRY [CURRPTAB] + ADDSIZEENTS - 
                  1;
              END 
          ELSE
              BEGIN  # TABLE NOT SPLIT #
              ADDSIZEWDS = TTABCALLOC [TABLENBR]; 
              ADDSIZEENTS = ADDSIZEWDS / ENTRYSIZE; 
              TTABFCENT [TABLENBR] = TTABLVENT [TABLENBR] + 1;
              TTABLCENT [TABLENBR] = TTABFCENT [TABLENBR] + ADDSIZEENTS 
                  - 1;
              END 
          FOR TEMP1 = 1 STEP 1 UNTIL ADDSIZEWDS DO
              ZRFILLITEM [TEMP1] = 0;  # ZERO OUT CORE AREA # 
          TTABLVENT [TABLENBR] = TTABLVENT [TABLENBR] + ADDSIZEENTS;
          FOR TEMP1 = TEMP1 WHILE TABLEENTRY GR TTABLVENT [TABLENBR] DO 
              BEGIN  # WRITE MORE ZEROED SECTIONS IF NEEDED # 
              WRITETAB (TRUE);
              TTABLVENT [TABLENBR] = TTABLVENT [TABLENBR] + ADDSIZEENTS;
              IF TTABSPLIT [TABLENBR] 
              THEN
                  BEGIN 
                  PTFENTRY [CURRPTAB] = PTFENTRY [CURRPTAB] + 
                      ADDSIZEENTS;
                  PTLENTRY [CURRPTAB] = PTLENTRY [CURRPTAB] + 
                      ADDSIZEENTS;
                  END 
              ELSE
                  BEGIN 
                  TTABFCENT [TABLENBR] = TTABFCENT [TABLENBR] + 
                      ADDSIZEENTS;
                  TTABLCENT [TABLENBR] = TTABLCENT [TABLENBR] + 
                      ADDSIZEENTS;
                  END 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          FUNC ASSIGNFILE I;
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*         FUNC - ASSIGNFILE 
* 
*         DOES - ASSIGNS A SCRATCH FILE TO A TABLE
* 
*         INPUTS - TABLE NUMBER IN TABLENBR 
* 
*         RETURNS - FILE NUMBER 
*         ALSO SETS TTABFILENBR TO SAME AND TTABBASEWA TO BASE
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
          ITEM BASELEN I; 
          ITEM BASEWA I;
          ITEM IND1 I;
          ITEM IND2 I;
          XREF ITEM NEXTFILE I;   # NEXT FILE AVAIL FOR ASSIGNMENT #
          XREF ITEM SCFLLST I;   # MAX NUMBER OF FILES #
          ITEM THISFILE I;
  
 #
 *     FIND A FILE WHICH HAS ALL TABLES ASSIGNED TO IT FIXED IN LENGTH
*      AND THEN FIND THE LAST SEGMENT OF THE FILE 
# 
          FOR IND1 = 1 STEP 1 UNTIL NBRTABLES 
          DO
              BEGIN 
              IF TTABFILENBR [IND1] EQ 0
              THEN
                  TEST IND1;   # SKIP IF NO FILE ASSIGNED # 
              IF TTABFIXED [IND1] 
              THEN
                  BEGIN  # A CANDIDATE - SEE IF ALL FIXED AND FIND LAST#
                  THISFILE = TTABFILENBR [IND1];
                  BASEWA = - 1; 
                  FOR IND2 = 1 STEP 1 UNTIL NBRTABLES 
                  DO
                      BEGIN 
                      IF TTABFILENBR [IND2] EQ THISFILE 
                      THEN
                          BEGIN 
                          IF NOT TTABFIXED [IND2] 
                          THEN
                              TEST IND1;  # ALL TABS NOT FIXED YET #
                          IF BASEWA LS TTABBASEWA [IND2]
                          THEN
                              BEGIN 
                              BASEWA = TTABBASEWA [IND2]; 
                              BASELEN = TTABHIGHWA [IND2];
                              END 
                          END 
                      END 
 #     A FILE WHICH SATISFIED ALL CRITERIA WAS FOUND  # 
                  TTABBASEWA [TABLENBR] = BASEWA + BASELEN - 1; 
                  TTABFILENBR [TABLENBR] = THISFILE;
                  ASSIGNFILE = THISFILE;
                  RETURN;   # ALL OK - GO BACK# 
                  END 
              END 
 #     CANDIDATE FILE NOT FOUND - ASSIGN A NEW ONE #
          $BEGIN
          IF NEXTFILE GR SCFLLST
          THEN
              BEGIN 
              PRINTERRORS ("MAX NUMBER OF SCRATCH FILES EXCEEDED"); 
              ABORT;
              END 
          $END
          TTABFILENBR [TABLENBR] = NEXTFILE;
          TTABBASEWA [TABLENBR] = 0;
          ASSIGNFILE = NEXTFILE;
          NEXTFILE = NEXTFILE + 1;
          RETURN; 
          END 
          CONTROL EJECT;
          $BEGIN
          XDEF PROC CLOSVTR;
          PROC CLOSVTR; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        CLOSVTR - CLOSES VIRTUAL TRACE FILE IF OPTION SELECTED
 *
 *        CALLED FROM COBOL5
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          CONTROL IFNQ DEBUGCALLS,0;
          PUTSQ(DBCALLF,0,0);    # WRITE END OF RECORD - FLUSH BUFFER # 
          CONTROL FI; 
          RETURN; 
          END 
          $END
          CONTROL EJECT;
          FUNC FINDPTENT (ENTNBR) I;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        FINDPTENT - FUNCTION WHICH RETURNS PAGE TABLE ORDINAL FOR PARM
 *
 *        INPUT - ENTNBR HAS TABLE ENTRY TO FIND PAGE FOR 
 *            TABLENBR = TABLE NUMBER 
 *
 *        OUTPUTS - 
 *            RETURN (AS FUNCTION) IS PAGE TABLE ORDINAL
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM ENTNBR I;
  
          FINDPTENT = 0;
          FOR TEMP1 = TTABFPTENT [TABLENBR] WHILE TEMP1 NQ 0 DO 
              BEGIN 
              IF ENTNBR GQ PTFETHISSEC [TEMP1]
              THEN
                  BEGIN  # IN THIS SECTION OR LATER ONE # 
                  FINDPTENT = TEMP1;
                  TEMP1 = PTNEXTENT [TEMP1];
                  END 
              ELSE
                  TEMP1 = 0;  # TERMINATE LOOP - LAST WAS PAGE NEEDED # 
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC INITTABLE; 
 #        INITTABLE - INITIALIZE TABLE                                 #
 #                                                                     #
 #        CALLS CMM TO ALLOCATE SPACE FOR TABLE                        #
 #        SETS ARRAY POINTERS                                          #
 #                                                                     #
          BEGIN 
          XREF FUNC ECSINIT I;
          XREF ITEM GROUP1FLAG;   #SET TO 1 IF GROUP 1 BLOCKS#
          ITEM ADDR U;
          ITEM BLKSIZE U; 
          ITEM FIRSTPASS B = TRUE;
          ITEM POINTERWD  U;
 #                                                                     #
  
          IF FIRSTPASS
          THEN
              BEGIN 
              FIRSTPASS = FALSE;
 #     DEFINE OVERFLOW ROUTINE AND TRIGGER OF ABOUT 95 PERCENT         #
              TEMP1 = CMM$POE (OVERFLOW, O"17177460000000000000", 0); 
              ECSSPACE = ECSINIT;   # INITIALIZE ECS IF PRESENT # 
              ECSAVAIL = ECSSPACE;
              END 
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          BLKSIZE = TTABINITSZ [TABLENBR];
          POINTERWD = TTABBASE [TABLENBR];
          TTABALLINCOR [TABLENBR] = TRUE; 
 #     ALLOCATE SPACE FOR TABLE                                        #
          IF TTABINC [TABLENBR] EQ 0
          THEN
              BEGIN 
              IF TTABNBRSPLTS [TABLENBR] NQ 0 
              THEN  # THIS TABLE WILL BE SPLIT LATER #
                  TEMP1 = 1;   # WILL GROW AT LWA # 
              ELSE
                  TEMP1 = 0;   # SET NO GROW #
              END 
          ELSE
              BEGIN 
              TEMP1 = 3;   #TABLE CAN GROW OR SHRINK AT LWA#
              END 
          CONTROL IFNQ DEBUGCMMCALL, 0; 
          PRINTCMMCALL ("ALLOCATE", BLKSIZE); 
          CONTROL FI; 
          IF TTABGROUP1 [TABLENBR]
          THEN
              BEGIN 
 #     THE GROUP 1 BLOCKS (RESIDE BETWEEN DABA AND HHA) ARE RELEASED
 *     BETWEEN EVERY OVERLAY - REASSIGN IF NECESSARY                   #
  
              IF GROUP1FLAG EQ 0
              THEN
                  BEGIN 
                  GROUP1FLAG = CMM$AGR (1);  #ASSIGN ID FOR THIS OVLAY# 
                  END 
              TEMP2 = GROUP1FLAG;  #SET FOR GROUP 1 BLOCKS# 
              END 
          ELSE
              TEMP2 = BLKGID;      #SET FOR REGULAR BLOCKS# 
          ADDR = CMI$ALV (BLKSIZE, 1, TEMP1, TEMP2, POINTERWD, 0);
          TTABASGD [TABLENBR] = TRUE; 
          TTABCALLOC [TABLENBR] = BLKSIZE;
          SETLIMS (0, BLKSIZE); 
          IF NOT TTABREOPEN [TABLENBR]
          THEN
              BEGIN  # NOT BEING REOPENED - SET LIMITS #
              TTABLASTENT [TABLENBR] = 0;  # WAS -1 # 
              TTABLVENT [TABLENBR] = TTABLCENT [TABLENBR];
              P<ZRFILL> = INDREF (TTABBASE [TABLENBR]); 
              FOR TEMP1 = 1 STEP 1 UNTIL BLKSIZE DO 
                  ZRFILLITEM [TEMP1] = 0;  # ZERO OUT NEW TABLE SPACE # 
              END 
          ELSE
              BEGIN  # REOPENING A TABLE #
              IF TTABLASTENT [TABLENBR] GR TTABLCENT [TABLENBR] 
              THEN
                  TTABALLINCOR [TABLENBR] = FALSE;  # WONT ALL FIT #
              END 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC OVERFLOW;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        NAME - OVERFLOW 
 *
 *        DOES - IS PASSED CONTROL WHEN CMM HAS HIT MAX FIELD LENGTH
 *                THE ROUTINE FINDS THE LOWEST PRIORITY TABLE AND 
*                 RELEASES ALL EXCEPT 1 PRU.
 *                THE TABLE IS CHANGED TO NO GROW (FIXED).
 *                IF ENOUGH SPACE IS STILL NOT AVAILABLE, REPEAT. 
 *
 *                THIS ROUTINE MUST CALL WRITETAB AND SETLIMS, SO CARE
 *                MUST BE TAKEN SINCE THEY CHANGE SOME THINGS 
 *
   * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  # 
  
          BEGIN 
          ITEM LOWESTPRI; 
          ITEM MINSZ I; 
          ITEM OVFBASE I; 
          ITEM OVFSAVETN I; 
          ITEM OVFSAVETE I; 
          ITEM OVFTEMP I; 
          ITEM OVFLINDEX I; 
          ITEM OVFLSIZE  I; 
          ITEM SAVERO  B; 
  
          XREF PROC OVFLO;
          OVFLO;    #INDICATE OVERFLOW ON TRACE FILE IF ACTIVE# 
          CONTROL IFNQ DEBUGCMMCALL, 0; 
          OUTPUT (2, "********* ", "OVERFLOW"); 
          CONTROL FI; 
          OVFSAVETN = TABLENBR;   #SAVE TABLE NUMBER# 
          OVFSAVETE = TABLEENTRY; 
 OVFLTRYAGAIN:  
          LOWESTPRI = 1000; 
              FOR OVFLINDEX = 1 STEP 1 UNTIL NBRTABLES DO 
                  BEGIN  #FIND LOWEST PRIORITY TABLE# 
               #   THE TABLE NUST BE ASSIGNED, MUST BE AN IN-CORE TABLE#
                  IF TTABPRINBR [OVFLINDEX] LS LOWESTPRI
                  AND NOT TTABRELD [OVFLINDEX]
                  AND TTABASGD [OVFLINDEX]
                  AND (TTABINC [OVFLINDEX] NQ 0 OR
                      (TTABSPLIT [OVFLINDEX] AND TTABLENB [OVFLINDEX] 
                          GR TTABINITSZ [OVFLINDEX]) OR 
                      (NOT TTABSPLIT [OVFLINDEX] AND TTABCALLOC 
                          [OVFLINDEX] GR TTABINITSZ [OVFLINDEX])) 
                  THEN
                      BEGIN 
                      LOWESTPRI = TTABPRINBR [OVFLINDEX]; 
                      TABLENBR = OVFLINDEX; 
                      END 
                  END 
              $BEGIN
              IF LOWESTPRI EQ 1000
              THEN
                  BEGIN  #ERROR - NO MORE ROOM  # 
                  PRINTERRORS ("CANNOT RELEASE SPACE IN OVL ACTION ");
                  END 
              $END
          IF LOWESTPRI EQ 1000
          THEN
              BEGIN   #NOTHING CAN BE RELEASED - PROBABLY WILL BOMB#
              GOTO OVERFLOWEX;   #RETURN# 
              END 
          TTABINC [TABLENBR] = 0; 
          TTABALLINCOR [TABLENBR] = FALSE;
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          IF TABLENBR EQ OVFSAVETN
          THEN
              OVERFLOWED = TRUE;   #OVERFLOW ON TABLE BEING EXTENDED# 
          SAVERO = TTABREADONLY [TABLENBR]; 
          TTABREADONLY [TABLENBR] = FALSE;   #NO READ ONLY - DUMP TABLE#
          WRITEALLTAB;   #FLUSH OUT TABLE#
          TTABREADONLY [TABLENBR] = SAVERO;   #RESTORE READ ONLY FLAG#
              MINSZ = TTABINITSZ [TABLENBR];  # MIN SPACE FOR TABLE # 
 #     COMPUTE AMOUNT OF SPACE TO RETURN TO SYSTEM                     #
              IF TTABSPLIT [TABLENBR] 
              THEN
                  BEGIN 
                  OVFLSIZE = TTABLENB [TABLENBR] - MINSZ; 
                  TEMP2 = MINSZ / ENTRYSIZE;  # OFFSET TO FIRST PAGE #
                  FOR TEMP1 = TTABFPTENT [TABLENBR] WHILE TEMP1 NQ 0 DO 
                      BEGIN   # SET OFFSETS IN EACH PAGE TABLE #
                      PTOFFSET [TEMP1] = TEMP2; 
                      TEMP2 = TEMP2 + PTLENTRY [TEMP1] - PTFENTRY 
                          [TEMP1] + 1;
                      TEMP1 = PTNEXTENT [TEMP1];
                      END 
                  TTABLENB [TABLENBR] = MINSZ;   # NEW BASE SIZE #
                  END 
              ELSE
                  OVFLSIZE = TTABCALLOC [TABLENBR] - MINSZ; 
              IF OVFLSIZE GR 0
              THEN
                  BEGIN 
                  OVFBASE = TTABBASE [TABLENBR];
                  IF TTABFIXED [TABLENBR] 
                  OR TTABSPLIT [TABLENBR] 
                  THEN
 #     TABLE FIXED - CHANGE TO ALLOW SHRINKING AT END # 
                      CMI$CSV(TTABBASE[TABLENBR], 2, -1, -1, -1); 
                  CONTROL IFNQ DEBUGCMMCALL, 0; 
                  PRINTCMMCALL ("CMMSLV", OVFLSIZE);
                  CONTROL FI; 
                  CMI$SLV (OVFBASE, OVFLSIZE);   #SHRINK TABLE# 
                  IF TTABNBRSPLTS [TABLENBR]  EQ 0
                  THEN  # NO SPLITS EXPECTED - SET TO FIXED (NO GROW) # 
                      CMI$CSV (OVFBASE, 0, -1, -1, -1); 
                  TTABCALLOC [TABLENBR] = TTABCALLOC [TABLENBR] - 
                      OVFLSIZE;  #FIX TOTAL CORE ALLOCATED# 
                  SETLIMS (0, MINSZ);   #RESET POINTERS#
                  IF TTABSPLIT [TABLENBR] 
                  THEN
                      BEGIN 
 #        READ PAGES INTO CORRECT PLACES #
                      OVERFLOWREAD = TRUE;
                      FOR OVFTEMP = TTABFPTENT [TABLENBR] WHILE 
                        OVFTEMP NQ 0 DO 
                          BEGIN 
                          TABLEENTRY = PTFETHISSEC [OVFTEMP]; 
                          READTAB;   # READ TABLE INTO PAGE # 
                          OVFTEMP = PTNEXTENT [OVFTEMP];
                          END 
                      OVERFLOWREAD = FALSE; 
                      END 
                  END 
          IF OVFLSIZE LQ 0
          THEN
              GOTO OVFLTRYAGAIN;   #NOTHING TO RELEASE - TRY AGAIN# 
 OVERFLOWEX:  
          TABLENBR = OVFSAVETN;   #RESTORE SAVED ITEMS# 
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          TABLEENTRY = OVFSAVETE; 
          RETURN; 
          END 
          CONTROL EJECT;
          CONTROL IFNQ DEBUGCALLS,0;
          PROC PRINTCALLS (CALLER); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        DEBUGCALLS - PRINTS CALLS TO VIRTUAL IF DEBUGCALLS IS NON 0 
 *
 *        PASSED ONE PARAMETER - CALLER - WHICH IS NAME OF CALLER 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM CALLER C(10);
          ITEM WSAADDR I; 
          ARRAY OVMSG [0:0] S(2); 
              BEGIN 
              ITEM FILLERX C(0,0,10) = [" NEW OV = "];
              ITEM LASTOVERLAY C(1,0,10) = ["          "];
              END 
  
          IF  RA$OVERLAY NQ LASTOVERLAY 
          THEN
              BEGIN   # OVERLAY HAS CHANGED - PRINT NEW ONE # 
              LASTOVERLAY = RA$OVERLAY; 
              WSAADDR = LOC(OVMSG); 
              PUTSQ(DBCALLF,WSAADDR,20);
              END 
          DEBUGCNAME = CALLER;
          DEBUGCTNAME = TABLENAME [TABLENBR]; 
          DEBUGCORD = DEC(TABLEENTRY);
          WSAADDR = LOC(DEBUGCALLA);
          PUTSQ(DBCALLF,WSAADDR,40);
          DEBUGCSTATUS = "          ";
          RETURN; 
          END 
          CONTROL FI; 
          CONTROL EJECT;
          CONTROL IFNQ DEBUGCMMCALL, 0; 
          PROC PRINTCMMCALL (PCMMCL, PCMMCQ); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PRINTCMMCALL - PRINT OUT CMM CALLS
 *
 *        CALLED WITH CMM CALL NAME AND QUANTITY
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM PCMMCL C(10);
          ITEM PCMMCQ I;
  
          OUTPUT (7, "********* ", PCMMCL, TABLENAME [TABLENBR],
              "  BY  ", DEC(PCMMCQ), "LAST ENT =",
              DEC (TTABLASTENT [TABLENBR]));
          RETURN; 
          END 
          CONTROL FI; 
          CONTROL EJECT;
          $BEGIN
          PROC PRINTERRORS (ERRORMESSAGE);
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PRINTERRORS - PRINTS VIRTUAL ERROR MESSAGES 
 *
 *        INPUT IS MESSAGE TEXT - 40 CHARACTERS 
 *
 *        PREFIXES MESSAGE WITH VIRTUAL - 
 *        PRINTS TABLE NAME, ENTRY NUMBER, AND LINE (FROM RA+3) 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM ERRORMESSAGE C(40);
          BASED ARRAY ERRMSWDS [0:3] S(1);
              ITEM ERRMSWORD  U(0,0,60);
          P<ERRMSWDS> = LOC (ERRORMESSAGE); 
          OUTPUT (5, "VIRTUAL - ", ERRMSWORD [0], ERRMSWORD [1],
              ERRMSWORD [2], ERRMSWORD [3]);
          OUTPUT (6, " TABLE = ", TABLENAME [TABLENBR], 
                     ", ENTRY = ", DEC (TABLEENTRY),
                      ",  LINE = ", DEC(B<30,30>RA$LINE));
          RETURN; 
          END 
          $END
          CONTROL EJECT;
          PROC READTAB; 
 #        READTAB - READS A TABLE INTO CORE                            #
 #               RESETS PROPER POINTERS                                #
          BEGIN 
          ITEM ECSSIZE I; 
          ITEM MSFWA I; 
          ITEM READBASE I;
          ITEM SIZE I;
  
          $BEGIN
          IF TTABFILENBR [TABLENBR] EQ 0
          AND NOT TTABONECS [TABLENBR]
          THEN
              BEGIN 
              PRINTERRORS ("READ ON TABLE WITH NO FILE ASSIGNED");
              ABORT;
              END 
          $END
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          CURRPTAB = 0; 
          READBASE = 0; 
          IF TTABSPLIT [TABLENBR] 
          THEN
              BEGIN  # SPLIT TABLE #
              SIZE = TTABLENB [TABLENBR]; 
              FOR TEMP1 = TTABFPTENT [TABLENBR]  WHILE
                TEMP1 NQ 0 DO 
                  BEGIN   # FIND PAGE TABLE FOR THIS ENTRY #
                  IF TABLEENTRY GQ PTFETHISSEC [TEMP1]
                  THEN
                      BEGIN  # IN THIS ONE OR LATER ONE # 
                      READBASE = READBASE + SIZE; 
                      SIZE = PTLEN [TEMP1]; 
                      CURRPTAB = TEMP1; 
                      TEMP1 = PTNEXTENT [TEMP1];
                      END 
                  ELSE
                      TEMP1 = 0;  # TERMINATE LOOP - LAST WAS PAGE #
                  END 
              END 
          ELSE
              BEGIN   # NOT SPLIT # 
              SIZE = TTABCALLOC [TABLENBR];  #OVERALL SIZE# 
              END 
          IF NOT OVERFLOWREAD 
          AND NOT TTABREADONLY [TABLENBR] 
          AND NOT SPLITTINGFLG
          THEN
              BEGIN  # MUST FLUSH OUT CURRENT PAGE #
              READFLAG = TRUE;
              WRITETAB (FALSE); 
              READFLAG = FALSE; 
              END 
 #     THE FIRST WORD ADDRESS MUST BE A PRU BAOUNDARY + 1 # 
          FIRSTWA = ((TABLEENTRY * ENTRYSIZE) / 64) * 64 + 1; #PRU BOUN#
          LASTWA = FIRSTWA + SIZE;
          IF TTABSPLIT [TABLENBR] 
          THEN
              BEGIN  # SPLIT - SEE IF READ OVERLAPS END OF PAGE # 
              IF CURRPTAB NQ 0
              THEN
                  TEMP1 = PTNEXTENT [CURRPTAB]; 
              ELSE
                  TEMP1 = TTABFPTENT [TABLENBR];
              IF TEMP1 NQ 0 
              THEN
                  BEGIN 
                  TEMP2 = PTFETHISSEC [TEMP1];
                  IF PTFENTRY [TEMP1] LQ TEMP2
                  THEN  # NEXT PAGE MAY HAVE A PIECE OF THIS ONE #
                      TEMP2 = PTFENTRY [TEMP1] * ENTRYSIZE + 1; 
              ELSE
                  #  ALLOW NEW PAGE TO GO UP TO 64 WORDS INTO NEXT SEC #
                  TEMP2 = (((TEMP2 * ENTRYSIZE) + 64) / 64) * 64 + 1; 
                  IF LASTWA GR TEMP2
                  THEN
                      BEGIN  # DOES OVERFLOW PAGE - ADJUST POINTERS # 
                      FIRSTWA = FIRSTWA - (LASTWA - TEMP2); 
                      LASTWA = FIRSTWA + SIZE;
                      END 
                  END 
              END 
          BASECORE = READBASE + INDREF (TTABBASE[TABLENBR]);
          IF LASTWA GR TTABHIGHWA [TABLENBR]
          THEN
              BEGIN  # EXTENDS PAST END OF FILE - ADJUST TO READ TO END#
              LASTWA = TTABHIGHWA [TABLENBR]; 
              FIRSTWA = LASTWA - SIZE;
              END 
          MSFWA = FIRSTWA;
          IF TTABONECS [TABLENBR] 
          AND FIRSTWA  LS TTABECSLWA [TABLENBR] 
          THEN
              BEGIN  # ENTRY ON ECS - READ ECS PAGE # 
              TEMP1 = TTABECSLWA [TABLENBR] + 1;
              ECSSIZE = SIZE; 
              IF LASTWA GR TEMP1
              THEN
                  BEGIN # PAGE EXTENDS OVER ECS END - CHANGE READ # 
                  ECSSIZE = ECSSIZE - (LASTWA - TEMP1);  # AMT ON ECS # 
                  END 
              ECSREAD (BASECORE, ECSSIZE, FIRSTWA - 1 + TTABECSBASE 
                [TABLENBR]);
              $BEGIN
              TTABECSACC [TABLENBR] = TTABECSACC [TABLENBR] + 1;
              $END
              IF SIZE EQ ECSSIZE
              THEN
                  GOTO READEXIT;  # ALL ON ECS - NO MS READ # 
              ELSE
                  BEGIN # EXTENDED PAST ECS - READ PART FROM MS # 
                  BASECORE = BASECORE + ECSSIZE;
                  MSFWA = FIRSTWA + ECSSIZE;
                  SIZE = SIZE - ECSSIZE;
                  END 
              END 
          FILENBR = TTABFILENBR [TABLENBR]; 
          GETWA (SCRFADDR [FILENBR], BASECORE,
            SIZE, MSFWA + TTABBASEWA [TABLENBR], ZRPARAM);
          $BEGIN
          TTABFILEACC [TABLENBR] = TTABFILEACC [TABLENBR] + 1;
          $END
 READEXIT:  
          TEMP1 = (FIRSTWA - 1) / ENTRYSIZE;  # FIRST ENTRY#
          TEMP2 = (LASTWA - 1) / ENTRYSIZE - 1;  # LAST ENT # 
          IF CURRPTAB NQ 0
          THEN
              BEGIN 
              PTFENTRY [CURRPTAB] = TEMP1;
              PTLENTRY [CURRPTAB] = TEMP2;
              END 
          ELSE
              BEGIN 
              TTABFCENT [TABLENBR] = TEMP1; 
              TTABLCENT [TABLENBR] = TEMP2; 
              END 
          CONTROL IFNQ DEBUGCALLS,0;
          IF DEBUGCSTATUS EQ "WRITE"
          THEN
              DEBUGCSTATUS = "RD-WR";   # WAS WRITE - SET AS READ -WR # 
          ELSE
              DEBUGCSTATUS = "READ";
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC SETLIMS (FWA, LWAP1);
 #        SETLIMS - SET TABLE LIMITS                                   #
 #                                                                     #
 #        DOES   - SETS TTABLCENT AND TTABFCENT                        #
 #                                                                     #
 #        GIVEN  - FIRST WORD NUMBER IN FWA, LAST PLUS 1 IN LWAP1      #
 #                                                                     #
          BEGIN 
          ITEM ENTNBR I;
          ITEM ENTSIZE I; 
          ITEM FWA U; 
          ITEM LASTENT I; 
          ITEM LWAP1 U; 
  
          ENTSIZE = TTABENTSIZE [TABLENBR]; 
          ENTNBR = FWA / ENTSIZE;  #ENTRY NBR OF FIRST# 
          LASTENT = (LWAP1 - ENTSIZE) / ENTSIZE;
          TTABFCENT [TABLENBR] = ENTNBR;
          TTABLCENT [TABLENBR] = LASTENT; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC SPLITTAB;
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC SPLITTAB - SPLITS A TABLE INTO TWO PARTS WITH CORE FOR 
 *            EACH PART AND POINTERS FOR EACH PART. 
 *
 *        INPUTS
 *            TABLENBR - NUMBER OF TABLE
 *            ENTRYSIZE - SIZE OF TABLE ENTRY 
 *
 *        IT IS EXPECTED THAT THIS ROUTINE IS CALLED FROM ADDENTRY ONLY 
 *
 *        OUTPUTS - SETS MANY TTAB FIELDS AND OTHERS
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM ENTSINPRU I; 
          ITEM NEWBASE I; 
          ITEM NEWLOWER I;
          ITEM NEWPTAB I; 
          ITEM OFFSET I;
          ITEM OLDBASE I; 
          ITEM PAGETLENGTH I = 0; 
          ITEM PREVPTAB I;
          ITEM SPACEX I;
  
          WRITETAB (TRUE);  # FLUSH THE LAST PAGE OF THE TABLE #
          NEWPTAB = 0;
          PREVPTAB = 0; 
          FOR TEMP1 = 1 STEP 1 UNTIL PAGETLENGTH DO 
              BEGIN  # FIND AN UNUSED PAGE TABLE ENTRY #
              IF NOT PTASGD [TEMP1] 
              THEN
                  BEGIN 
                  NEWPTAB = TEMP1;  # FOUND ONE # 
                  TEMP1 = PAGETLENGTH + 1;  # TERMINATE LOOP #
                  END 
              END 
          IF NEWPTAB EQ 0 
          THEN
              BEGIN   # NO ENTRIES - EXTEND TABLE # 
              IF PAGETASGD
              THEN
                  BEGIN  # MUST EXTEND - IS ASSIGNED #
                  CMM$GLV(PAGETABLE, PAGETINC); 
                  NEWPTAB = PAGETLENGTH + 1;
                  PAGETLENGTH = PAGETLENGTH + (PAGETINC / 2); 
                  END 
              ELSE
                  BEGIN  # NOT ASSIGNED, ASSIGN IT #
                  TEMP1 = CMM$ALV (PAGETINC, 1, 3, BLKGID, P<PAGETABLE>,
                      0); 
                  NEWPTAB = 1;
                  PAGETASGD = TRUE; 
                  PAGETLENGTH = PAGETINC / 2; 
                  END 
              FOR TEMP1 = NEWPTAB STEP 1 UNTIL PAGETLENGTH DO 
                  PTASGD [TEMP1] = FALSE; 
              END 
       #  COMPUTE AMOUNT TO GROW TABLE FOR NEW PAGE # 
          IF TTABINC [TABLENBR] EQ 0
          THEN
              SPACEX = TTABINITSZ [TABLENBR]; 
          ELSE
              SPACEX = TTABINC [TABLENBR];
          CONTROL IFNQ DEBUGCMMCALL,0;
          PRINTCMMCALL ("EXTEND-S", SPACEX);
          CONTROL FI; 
          CMI$GLV (TTABBASE [TABLENBR], SPACEX);  # GET NEW SPACE # 
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          IF TTABSPLIT [TABLENBR] 
          THEN
              BEGIN  # ALREADY SPLIT ONCE - FIND LAST PAGE TBL ENTRY #
              PREVPTAB = FINDPTENT(999999); 
              OFFSET = PTOFFSET [PREVPTAB] + (PTLEN [PREVPTAB] /
                ENTRYSIZE); 
              PTNEXTENT [PREVPTAB] = NEWPTAB; 
              END 
          ELSE
              BEGIN   #GROWING TABLE - ALL IN CORE# 
              TTABLENB [TABLENBR] = TTABCALLOC [TABLENBR];
              OFFSET = TTABCALLOC [TABLENBR] / ENTRYSIZE; 
              TTABFPTENT [TABLENBR] = NEWPTAB;
              IF TTABINC [TABLENBR] NQ 0
              THEN
                  BEGIN   # GRWOING TABLE - ADJUST TO NON -GROW # 
                  TTABLCENT [TABLENBR] = OFFSET - 1;
                  TTABINC [TABLENBR] = 0;  # SET NO GROW ANY MORE # 
                  END 
              END 
          TTABCALLOC [TABLENBR] = TTABCALLOC [TABLENBR] + SPACEX; 
          IF TTABNBRSPLTS [TABLENBR] EQ 0 
          THEN  #  NO MORE SPLITS EXPECTED - SET NO GROW #
              CMI$CSV (TTABBASE[TABLENBR], 0, -1, -1, -1);
          PTLEN [NEWPTAB] = SPACEX; 
          PTOFFSET [NEWPTAB] = OFFSET;
          PTASGD [NEWPTAB] = TRUE;
          PTNEXTENT [NEWPTAB] = 0;
          TTABSPLIT [TABLENBR] = TRUE;
          TTABHLDSPLIT [TABLENBR] = 0;
          NEWBASE = OFFSET * ENTRYSIZE;  # POINT TO START OF NEW PAGE # 
          SPLITTINGFLG = TRUE;
          CURRPTAB = NEWPTAB;   # SET FOR FURTHER PROCESSING #
          IF TTABLASTENT [TABLENBR] LS TTABLVENT [TABLENBR] 
          THEN
              BEGIN  # IMMEDIATE SPLIT #
              TEMP1 = TTABLASTENT [TABLENBR] + 1; 
              ENTSINPRU = 64 / ENTRYSIZE; 
              NEWLOWER = ((TEMP1 * ENTRYSIZE) / 64) * ENTSINPRU;
              TABLEENTRY = NEWLOWER;
              PTFETHISSEC [NEWPTAB] = TEMP1;
              #  SET PTFENTRY IN CASE READ NEEDED IN FOLLOWING CODE # 
              PTFENTRY [NEWPTAB] = NEWLOWER + ENTSINPRU;
              IF PREVPTAB NQ 0
              THEN
                  BEGIN  # WAS SPLIT BEFORE # 
                  IF NEWLOWER LS PTFENTRY [PREVPTAB]
                  OR NEWLOWER GR PTLENTRY [PREVPTAB]
                  THEN  # THE PIECE TO MOVE NOT IN CORE - READ IT # 
                      READTAB;
                  OLDBASE = PTOFFSET [PREVPTAB] + NEWLOWER -
                    PTFENTRY [PREVPTAB];  # LOCATE THIS SEC IN CORE # 
                  END 
              ELSE
                  BEGIN   # NOT SPLIT BEFORE - FINAGLE BASE PART #
                  IF NEWLOWER LS TTABFCENT [TABLENBR] 
                  OR NEWLOWER GR TTABLCENT [TABLENBR] 
                  THEN
                      READTAB;   # SAME AS ABOVE - READ TO GET SEC #
                  OLDBASE = NEWLOWER - TTABFCENT [TABLENBR];
                  END 
              PTFENTRY [NEWPTAB] = NEWLOWER;  # SET BOUNDS OF NEW PAGE #
              PTLENTRY [NEWPTAB] = NEWLOWER + (SPACEX / ENTRYSIZE) - 1; 
              OLDBASE = OLDBASE * ENTRYSIZE;  # CONVERT TO WORDS #
              P<ZRFILL> = INDREF(TTABBASE[TABLENBR]);  # POINT TO TABLE#
              FOR TEMP1 = 1 STEP 1 UNTIL 64 DO
                  BEGIN  # MOVE SECTION TO NEW AREA # 
                  ZRFILLITEM [NEWBASE + TEMP1] = ZRFILLITEM 
                    [OLDBASE + TEMP1];
                  END 
              NEWBASE = NEWBASE + 64; 
              FOR TEMP1 = 1 STEP 1 UNTIL SPACEX - 64 DO 
                  ZRFILLITEM [NEWBASE + TEMP1] = 0;  # ZERO OUT REST #
              TABLEENTRY = NEWLOWER - 1;
              READTAB;  # RESET PREVIOUS SECTION #
              END 
          ELSE
              BEGIN  # WAS HELD SPLIT AT NATURAL BOUNDARY # 
              PTFETHISSEC [NEWPTAB] = TTABLVENT [TABLENBR] + 1; 
              BASECORE = INDREF (TTABBASE [TABLENBR]) + (OFFSET * 
                ENTRYSIZE); 
              ADDTOFILE;   # CLEAR OUT NEW ENTRIES #
              END 
          TTABLVENT [TABLENBR] = PTLENTRY [NEWPTAB];
          SPLITTINGFLG = FALSE; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC TMFIXSZ ((TABNBR));
 #        TMFIXSZ - FIXES THE SIZE OF A TABLE                          #
 #               CALLS CMM TO RELEASE UNUSED SPACE                     #
  
          BEGIN 
          ITEM TABNBR U;
          TABLENBR = TABNBR;
          IF TTABFIXED[TABLENBR]
          THEN
              RETURN;   # IGNORE IF ALREADYFIXED #
          TTABFIXED [TABLENBR] = TRUE;
          IF NOT TTABASGD [TABLENBR]
          THEN
              RETURN;   # NEVER ASSIGNED - DO NOTHING # 
          IF TTABFILENBR [TABLENBR] NQ 0
          OR TTABONECS [TABLENBR] 
          THEN
 #     IF SOME DATA IS ON A FILE, DUMP OUT THE REST     # 
              WRITEALLTAB;   #DUMP OUT ALL OF THE TABLE#
          ELSE
              IF TTABINC [TABLENBR] EQ 0
              THEN     # NOT WRITTEN YET SO CAN CHANGE TO IN-CORE#
                  BEGIN 
                  #  CHANGE BLOCK TO SHRINK AT END - IT WAS FIXED # 
                  CMI$CSV(TTABBASE[TABLENBR], 2, -1, -1, -1); 
                  TTABINC [TABLENBR] = 64;   #SET AS NOT DISK#
                  TTABALLINCOR [TABLENBR] = TRUE; 
                  END 
          IF TTABINC [TABLENBR] NQ 0
          THEN
 #     TABLE IS NOT A DISK ONE - CALL CMM TO FIX SIZE AT ACTUAL LENGTH #
 #     AND CALL CMM TO CHANGE SPECS TO NO-GROWTH TABLE.                #
              BEGIN 
              TEMP1 = TTABLCENT [TABLENBR] - TTABLASTENT [TABLENBR];
              ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
              TEMP1 = ((TEMP1 * ENTRYSIZE) / 64) * 64;
              IF TEMP1 NQ 0 
              THEN
                  BEGIN 
                  CONTROL IFNQ DEBUGCMMCALL, 0; 
                  PRINTCMMCALL ("CMMSLV", TEMP1); 
                  CONTROL FI; 
                  CMI$SLV (TTABBASE [TABLENBR], TEMP1);  #RTN UNUSED SP#
 #     DECREMENT AMOUNT OF CORE ALLOCATED BY QUANTITY REDUCED          #
                  TTABCALLOC [TABLENBR] = TTABCALLOC [TABLENBR] - TEMP1;
                  IF TTABCALLOC [TABLENBR] LS TTABINITSZ [TABLENBR] 
                  THEN
                      TTABINITSZ [TABLENBR] = TTABCALLOC [TABLENBR];
                  END 
              CMI$CSV (TTABBASE [TABLENBR], 0, -1, -1, -1);  #SET NO GR#
              TTABINC [TABLENBR] = 0; 
              END 
          CONTROL IFNQ DEBUGCALLS,0;
          TABLEENTRY = TTABLASTENT [TABLENBR];
          PRINTCALLS("TMFIXSZ");     # PRINT OUT VIRTUAL TRACE INFO # 
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC TMRECL ((TABNBR)); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME - TMRECL - TABLE MANAGER RE-CLOSE TABLE                 #
 #                                                                     #
 #        DOES - RE CLOSES A TABLE WHICH WAS RE OPENED BY TMREOP       #
 #                                                                     #
 #        CALLED BY TMRECL (TABLENUMBER)                               #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM TABNBR I;
          TABLENBR = TABNBR;
          IF NOT TTABRELD [TABLENBR]
          OR NOT TTABASGD [TABLENBR]
          THEN
              RETURN;  #TABLE NEVER RELEASED IN FIRST PLACE - IGNORE# 
          $BEGIN
          IF NOT TTABREOPEN [TABLENBR]
          THEN
              BEGIN   #TABLE NEVER RE-OPENED - IS ERROR#
              PRINTERRORS ("RE-CLOSE ON TABLE NOT RE-OPENED    ");
              RETURN; 
              END 
          $END
          CONTROL IFNQ DEBUGCMMCALL, 0; 
          PRINTCMMCALL ("FREE", TTABCALLOC [TABLENBR]); 
          CONTROL FI; 
          CMI$FRV (TTABBASE [TABLENBR]);  #FREE THE SPACE#
          TTABREOPEN [TABLENBR] = FALSE;
          CONTROL IFNQ DEBUGCALLS,0;
          PRINTCALLS("TMRECL");     # PRINT VIRTUAL TRACE INFO #
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC TMREOP ((TABNBR)); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
 #                                                                     #
 #        NAME - TMREOP - TABLE MANAGER RE-OPEN ROUTINE                #
 #                                                                     #
 #        DOES - RE OPENS A TABLE WHICH HAS BEEN RELEASED.             #
 #               THE TABLE CAN BE READ ONLY, IT CANNOT BE CHANGED      #
 #               THIS ROUTINE IS DESIGNED TO BE USED BY TABLE DUMP     #
 #               ROUTINES.                                             #
 #                                                                     #
 #        CALLED BY  TMREOP (TABLENUMBER)                              #
 #                                                                     #
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM TABNBR I;
  
          TABLENBR = TABNBR;
          IF NOT TTABRELD [TABLENBR]
          OR NOT TTABASGD [TABLENBR]
          THEN
              RETURN;  #DO NOTHING IF ALREADY OPEN - NOT RELEASED#
          TTABREOPEN [TABLENBR] = TRUE; 
          TTABGROUP1 [TABLENBR] = TRUE;  # SET AS GROUP ID 1# 
          TTABSPLIT [TABLENBR] = FALSE; 
          TTABREADONLY [TABLENBR] = TRUE; 
          TTABHLDSPLIT [TABLENBR] = 0;
          TTABINC [TABLENBR] = 0; 
          INITTABLE;
          TABLEENTRY = 0; 
          READTAB;
          CONTROL IFNQ DEBUGCALLS,0;
          PRINTCALLS("TMREOP");     # PRINT VIRTUAL TRACE INFO #
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC TMRTNTB ((TABNBR));
 #        TMRTNTB - RETURNS TABLE SPACE TO CMM - TABLE IS NO LONGER    #
 #            USED                                                     #
          BEGIN 
          ITEM BASEECS; 
          ITEM COREWDS I; 
          ITEM CURRADDR I;
          ITEM LWECS I; 
          ITEM TABNBR U;
          ITEM WORKTABLE B; 
  
          TABLENBR = TABNBR;
          TTABALLINCOR [TABLENBR] = FALSE;   # SET NOT ALL IN CORE #
          $BEGIN
          IF TTABRELD [TABLENBR]
          THEN
              BEGIN  #TABLE HAS ALREADY BEEN RETURNED - ERROR#
              PRINTERRORS ("REFERENCED TO RETURNED (RELEASED) TABLE");
              RETURN; 
              END 
          $END
          IF TABLENBR GQ TABLETYPE "WORK1$" 
          THEN
              BEGIN 
 #     FOR WORK TABLES RESET SO THEY CAN BE USED AGAIN                 #
              WORKTABLE = TRUE; 
              TTABLASTENT [TABLENBR] = -1;
          TTABLVENT [TABLENBR] = -1;
              TTABLCENT [TABLENBR] = -1;
              TTABRELD [TABLENBR] = FALSE;
              TTABINC [TABLENBR] = 64;   # RESET IN CASE CLEARED #
              TTABFIXED [TABLENBR] = FALSE; 
              TTABGROUP1 [TABLENBR] = TRUE; 
              TTABFILENBR [TABLENBR] = 0; 
              END 
          ELSE
              BEGIN 
              WORKTABLE = FALSE;
              TTABRELD [TABLENBR] = TRUE; 
              END 
          IF NOT TTABASGD [TABLENBR]
          THEN
              BEGIN  #NEVER ASSIGNED - SET AS FIXED AND IGNORE# 
              IF NOT WORKTABLE
              THEN
                  TTABFIXED [TABLENBR] = TRUE;
              RETURN; 
              END 
          IF NOT WORKTABLE
          THEN
              BEGIN 
              IF TTABSAVEIT [TABLENBR]
              OR TTABFILENBR [TABLENBR] NQ 0
              OR TTABONECS [TABLENBR] 
              THEN
                  BEGIN 
 #     IF THE TABLE IS TO BE SAVED OR IS ON A FILE WE MUST PUT ALL OF IT
*         ON A FILE # 
                  WRITEALLTAB;
                  IF TTABONECS [TABLENBR] 
                  THEN
                      BEGIN  # ECS RESIDENT - MAY HAVE TO COPY #
                      TTABONECS [TABLENBR] = FALSE; 
                      IF TTABSAVEIT [TABLENBR]
                      THEN
                          BEGIN  # TABLE HAS TO BE COPIED TO MS # 
                          BASECORE = INDREF(TTABBASE[TABLENBR]);
                          BASEECS = TTABECSBASE [TABLENBR]; 
                          COREWDS = TTABCALLOC [TABLENBR];
                          LWECS = TTABECSLWA [TABLENBR];
                          FOR CURRADDR = 0 WHILE CURRADDR LS LWECS DO 
                              BEGIN 
                              TEMP1 = LWECS - CURRADDR; 
                              IF TEMP1 LS COREWDS 
                              THEN
                                  COREWDS = TEMP1;  # LAST PIECE #
                              ECSREAD (BASECORE, COREWDS, CURRADDR +
                                BASEECS); 
                              WRITEFILE (BASECORE, COREWDS, CURRADDR +
                                1); 
                              CURRADDR = CURRADDR + COREWDS;
                              END 
                          END 
                      ECSAVAIL = ECSSPACE;  # GIVE BACK SPACE # 
                      END 
                  END 
          IF TTABSPLIT [TABLENBR] 
          THEN
              BEGIN  # TABLE SPLIT - RELEASE PAGE TABLE ENTRIES # 
              TEMP1 = TTABFPTENT [TABLENBR];
              TTABFPTENT [TABLENBR] = 0;
              FOR TEMP1 = TEMP1 WHILE TEMP1 NQ 0 DO 
                  BEGIN 
                  PTASGD [TEMP1] = FALSE; 
                  TEMP1 = PTNEXTENT [TEMP1];
                  END 
              END 
              TTABFIXOVL [TABLENBR] = 0;   # NO NEED TO FIX LATER # 
              TTABFIXED [TABLENBR] = TRUE;
              TTABROOVL [TABLENBR] = 0;   # NO NEED TO SET READ ONLY #
              TTABREADONLY [TABLENBR] = TRUE; # SINCE WE DO IT HERE # 
              END 
          ELSE
              TTABASGD [TABLENBR] = FALSE;  #CLEAR FOR RE-USE#
          CONTROL IFNQ DEBUGCMMCALL, 0; 
          PRINTCMMCALL ("FREE", TTABCALLOC [TABLENBR]); 
          CONTROL FI; 
          TTABSPLIT [TABLENBR] = FALSE; 
          TTABLENB [TABLENBR] = 0;
          $BEGIN
          TTABCALLOC [TABLENBR] = 0;
          $END
          CMI$FRV (TTABBASE [TABLENBR]);  #FREE THE SPACE#
          CONTROL IFNQ DEBUGCALLS,0;
          PRINTCALLS("TMRTNTB");    # PRINT VIRTUAL TRACE INFO #
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC TMSETRO ((TABNBR));
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC TMSETRO - SETS TABLE AS READ ONLY
 *
 *INPUT - TABLE NUMBER
 *
 *CHANGES - SEE WRITETAB AND TTABREADONLY 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM TABNBR I;
  
          TABLENBR = TABNBR;
          IF TTABASGD [TABLENBR]
          AND (TTABFILENBR [TABLENBR] NQ 0
          OR TTABSAVEIT [TABLENBR]
          OR TTABONECS [TABLENBR] 
            ) 
 #     IF TABLE TO BE SAVED OR SOME ON A FILE, ALL MUST GO ON A FILE #
          THEN
              WRITEALLTAB;   #FLUSH OUT STUFF IS ASSIGNED#
          TTABREADONLY [TABLENBR] = TRUE; 
          CONTROL IFNQ DEBUGCALLS,0;
          TABLEENTRY = TTABLASTENT [TABLENBR];
          PRINTCALLS("TMSETRO");    # PRINT VIRTUAL TRACE INFO #
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
          PROC TMSPLIT ((TABNBR));
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC TMSPLIT - SETS TTABFESSEC TO NEXT PRU TO CAUSE SPLITTING 
 *            OF TABLE WHEN ADDENTRY GETS UP TO THAT POINT. 
 *
 *        INPUT - TABLE NUMBER
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM SIZE I;
          ITEM TABNBR;
  
          TABLENBR = TABNBR;
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          TEMP1 = ENTRYSIZE * (TTABLASTENT [TABLENBR] + 1); 
          TEMP2 = ((TEMP1 / 64) * 64) / ENTRYSIZE;
          $BEGIN
          IF TTABNBRSPLTS [TABLENBR] EQ 0 
          THEN
              BEGIN  # NO COUNT OF NUMBER OF SPLITS EXPECTED - ERROR #
              PRINTERRORS ("SPLIT CALLED BUT TTABNBRSPLTS 0");
              ABORT;
              END 
          $END
          TTABNBRSPLTS [TABLENBR] = TTABNBRSPLTS [TABLENBR] - 1;
          IF NOT TTABASGD [TABLENBR]
          THEN
              RETURN;   # NO ACTION IF TABLE NOT ASSIGNED # 
          IF TTABSPLIT [TABLENBR] 
          THEN
              BEGIN  # PREVIOUSLY SPLIT - SEE IF ALL USED # 
              CURRPTAB = FINDPTENT (999999);  # FIND LAST PAGE T ENTRY# 
              TEMP1 = PTFETHISSEC [CURRPTAB]; 
              SIZE = PTLEN [CURRPTAB];
              END 
          ELSE
              BEGIN   # NO SPLIT BEFORE - USE BASE SECTION #
              TEMP1 = 0;
              SIZE = TTABCALLOC [CURRPTAB]; 
              END 
          SIZE = SIZE / ENTRYSIZE;
          IF TTABALLINCOR [TABLENBR]
          OR TEMP2 - SIZE LS TEMP1
          THEN
              BEGIN  # HOLD SPLIT FOR NATURAL BOUNDARY #
              TTABHLDSPLIT [TABLENBR] = TEMP2 + (64 / ENTRYSIZE); 
              END 
          ELSE
              BEGIN  # SHOULD SPLIT TABLE NOW # 
              SPLITTAB; 
              END 
          CONTROL IFNQ DEBUGCALLS,0;
          TABLEENTRY = TTABLASTENT [TABLENBR];
          PRINTCALLS("TMSPLIT");    # PRINT VIRTUAL TRACE INFO #
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
          $BEGIN
          XDEF PROC TMSTATS;
          PROC TMSTATS; 
 #                                                                     #
 #        TMSTATS - DISPLAYS TABLE MANAGER STASTICS                    #
 #                                                                     #
          BEGIN 
          XREF FUNC OCT C(40);
          XREF FUNC CMM$GSS;
          XREF ITEM OVCOUNT;
          ITEM FIELDL C(40);
          ITEM INDEX1 I;
          ITEM YESNO1  C(10); 
          ITEM YESNO2  C(10); 
          ITEM YESNO3  C(10); 
          BASED ARRAY CMMSTATS [0:0] S(6);
              BEGIN 
              ITEM CMMMAXFL I(1,0,60);
              END 
 #     BEGIN DUMP PROCEDURE                                            #
  
          IF NOT CCTDBTBSTATS [0] 
          THEN
              RETURN;  #NO STATS IF NOT TURNED ON#
  
          OUTPUT (03, " ", "TABLE", "STATS"); 
          OUTPUT (12
              ,   "NAME"
              ,   "LAST ENT"
              ,   "NBR REFS"
              ,   "NBR I-O" 
              ,   "ECS R/W" 
              ,   "NBR INC" 
              ,   "FIXED" 
              ,   "RELEASED"
              ,   "SPLIT" 
              ,   "FILE NBR"
              ,   "WDS ALLOC" 
              ,   "ECS ALLOC" 
              );
          TEMP1 = 0;
          FOR INDEX1 = 1 STEP 1 UNTIL NBRTABLES DO
              BEGIN 
              IF TTABFIXED [INDEX1] 
              THEN
                  YESNO1 = "YES"; 
              ELSE
                  YESNO1 = "NO";
              IF TTABRELD [INDEX1]
              THEN
                  YESNO2 = "YES"; 
              ELSE
                  YESNO2 = "NO";
              IF TTABSPLIT [INDEX1] 
              THEN
                  YESNO3 = "YES"; 
              ELSE
                  YESNO3 = "NO";
              TEMP1 = TEMP1 + TTABCALLOC [INDEX1];
              TEMP2 = TTABECSLWA [INDEX1];
              OUTPUT (12
                  , TABLENAME [INDEX1]
                  , DEC (TTABLASTENT  [INDEX1]) 
                  , DEC (TTABNBRREF   [INDEX1]) 
                  , DEC (TTABFILEACC  [INDEX1]) 
                  , DEC (TTABECSACC [INDEX1]) 
                  , DEC (TTABNBRINC   [INDEX1]) 
                  , YESNO1
                  , YESNO2
                  , YESNO3
                  , DEC (TTABFILENBR  [INDEX1]) 
                  , OCT (TTABCALLOC [INDEX1], 14, 6)
                  , OCT (TEMP2, 14, 6)
                  );
              END 
          P<CMMSTATS> = CMM$GSS;   #GET STATS#
          FIELDL = OCT(CMMMAXFL, 14, 6);
          OUTPUT (08, 
            "FL = ", FIELDL,
            "ECS = ", OCT (ECSUSED, 14, 6), 
            "TS TOT = ", OCT (TEMP1, 14, 6),
            "OVERLAYS =", DEC (OVCOUNT)); 
 #     PRINT COUNTS OF VIRTUAL EXIT CASES  #
          OUTPUT (10
              , "CASE 1 = ", DEC(CASECOUNT1)
              , "CASE 2 = ", DEC(CASECOUNT2)
              , "CASE 3 = ", DEC(CASECOUNT3)
              , "CASE 4 = ", DEC(CASECOUNT4)
              , "CASE 5 = ", DEC(CASECOUNT5)
              );
          RETURN; 
          END 
          $END
          CONTROL EJECT;
          PROC WRITEALLTAB; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC WRITEALLTAB - WRITES ALL OF A TABLE TO MASS STORAGE
 *
 *        INPUTS - TABLENBR HAS TABLE 
 *
 *CHANGES - SAME STUFF AS WRITETAB PLUS TABLEENTRY
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM NXTPTAB I; 
  
          IF TTABSPLIT [TABLENBR] 
          THEN
              BEGIN  # TABLE SPLIT #
              TABLEENTRY = 1; 
              WRITETAB (FALSE);  #WRITE OUT BASE ENTRY #
              FOR NXTPTAB = TTABFPTENT [TABLENBR] WHILE NXTPTAB NQ 0 DO 
                  BEGIN 
                  TABLEENTRY = PTFENTRY [NXTPTAB];
                  WRITETAB (FALSE);  # WRITE OUT EACH PAGE #
                  NXTPTAB = PTNEXTENT [NXTPTAB];
                  END 
              END 
          ELSE
              WRITETAB (TRUE);  # NOT SPLIT - WRITE ONLY SECTION #
          RETURN; 
          END 
          CONTROL EJECT;
          PROC WRITEFILE ((WFBASE), (WFWDS), (WFFWA)) ; 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        WRITEFILE - WRITES A FILE 
 *
 *        DOES - PICKS UP THE FILE NUMBER - CALLS ASSINFILE IF NONE 
 *               WRITES THE FILE BASED ON THE INPUT PARAMS
 *               BUMPS ACCESS COUNT IF DEBUG SYSTEM 
 *
 *        INPUTS
 *               WFBASE - BASE ADDRESS OF CORE
 *               WFWDS - NUMBER OF WORDS TO WRITE 
 *               WFFWA - FIRST WORD ADDRESS ON MS 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
          BEGIN 
          ITEM WFBASE I;
          ITEM WFWDS I; 
          ITEM WFFWA I; 
  
          TEMP1 = WFFWA + WFWDS;
          IF TEMP1 GR TTABHIGHWA [TABLENBR] 
          THEN
              TTABHIGHWA [TABLENBR] = TEMP1;  # NEW HIGH WA # 
          FILENBR = TTABFILENBR [TABLENBR]; 
          IF FILENBR EQ 0 
          THEN
              FILENBR = ASSIGNFILE;  # NO FILE, ASSIGN ONE #
          PUTWA (SCRFADDR [FILENBR], WFBASE, WFWDS, WFFWA + 
            TTABBASEWA [TABLENBR]); 
          $BEGIN
          TTABFILEACC [TABLENBR] = TTABFILEACC [TABLENBR] + 1;
          $END
          END 
          CONTROL EJECT;
          PROC WRITETAB (LASTPART); 
 # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *
 *        PROC WRITETAB - WRITES TABLE TO MASS STORAGE
 *
 *        INPUT - BOOLEAN FLAG
 *                    FALSE - WRITE PORTION DEFINED BY TABLEENTRY 
 *                    TRUE - WRITE LAST PAGE IF SPLIT OR REGULAR PAGE 
 *                           IF NOT SPLIT.
 *                TABLEENTRY - SEE FLAG 
 *                TABLENBR - NUMBER OF TABLE
 *
 *        RETURNS 
 *                ENTRYSIZE - SIZE OF ENTRY 
 *                FIRSTWA - FIRST WORD ADDRESS WRITTEN
 *                ENDWA - LAST WORD ADDRESS WRITTEN 
 *                FILENBR - FILE NUMBER 
 *                TTABHIGHWA - SET TO LAST WA WRITTEN 
 *                CURRPTAB - PAGE TABLE ENTRY WRITTEN IF SPLIT
 *                BASECORE - CORE ADDRESS OF PART WRITTEN 
 *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * #
  
          BEGIN 
          ITEM ALLOCFWA I;
          ITEM ALLOCWDS I;
          ITEM ENDWA I; 
          ITEM LASTPART B;
          ITEM LENTECS I; 
          ITEM NEWECSWDS I; 
          ITEM WDSFORECS I;  # WORDS TO WRITE ON ECS (OR WRITTEN THERE #
          ITEM WDSFORMS  I;  # WORDS TO BE WRITTEN ON MASS STORAGE #
          ITEM NBRWDS     I;       # NBR OF WDS TO WRITE ROUNDED TO PRU#
  
          ENTRYSIZE = TTABENTSIZE [TABLENBR]; 
          TTABALLINCOR [TABLENBR] = FALSE;  # NO LONGER ALL IN CORE#
          IF NOT READFLAG 
          AND TTABSPLIT [TABLENBR]
          THEN
              BEGIN  # NOT FLUSH FOR READ AND TABLE SPLIT - FIND PAGE # 
              IF LASTPART 
              THEN
                  CURRPTAB = FINDPTENT (999999);  # FIND LAST PT ENTRY #
              ELSE
                  BEGIN 
                  CURRPTAB = 0; 
                  FOR TEMP1 = TTABFPTENT [TABLENBR] WHILE TEMP1 NQ 0 DO 
                      BEGIN 
                      IF TABLEENTRY LS PTFENTRY [TEMP1] 
                      THEN
                          TEMP1 = 0;   # FOUND PAGE # 
                      ELSE
                          BEGIN 
                          CURRPTAB = TEMP1; 
                          TEMP1 = PTNEXTENT [TEMP1];
                          END 
                      END 
                  END 
              END 
          ELSE
              BEGIN 
              IF NOT READFLAG 
              THEN
                  CURRPTAB = 0;  # NOT FLUSH FOR READ AND NOT SPLIT # 
              END 
          IF CURRPTAB EQ 0
          THEN
              BEGIN  # BASE PART TO BE WRITTEN #
              BASECORE = 0; 
              FIRSTWA = TTABFCENT [TABLENBR]; 
              IF TTABSPLIT [TABLENBR] 
              THEN
                  NBRWDS = TTABLENB [TABLENBR]; 
              ELSE
                  NBRWDS = TTABCALLOC [TABLENBR]; 
              END 
          ELSE
              BEGIN 
              BASECORE = PTOFFSET [CURRPTAB] * ENTRYSIZE; 
              FIRSTWA = PTFENTRY [CURRPTAB];
              NBRWDS = PTLEN [CURRPTAB];
              END 
          FIRSTWA = FIRSTWA * ENTRYSIZE + 1;
          LASTWA = FIRSTWA + NBRWDS;
          BASECORE = INDREF (TTABBASE [TABLENBR]) + BASECORE; 
          WDSFORMS = NBRWDS;
          WDSFORECS = 0;
          IF TTABREADONLY [TABLENBR]
          THEN
              RETURN;  # NO WRITE IF READ ONLY - JUST SET POINTERS #
          IF TTABECSCAND [TABLENBR] 
          THEN
              BEGIN   # CANDIDATE FOR ECS - SEE IF FITS # 
              IF ECSAVAIL NQ 0
              THEN
                  TTABONECS [TABLENBR] = TRUE;  # IS - SET ON ECS # 
              TTABECSCAND [TABLENBR] = FALSE; 
              $BEGIN
              IF FIRSTWA NQ 1 
              THEN
                  BEGIN # ERROR - FIRSTWA MUST BE 1 FIRST TIME HERE # 
                  PRINTERRORS ("ECS ASGD AND FWA NOT 1"); 
                  ABORT;
                  END 
              $END
              END 
          IF TTABONECS [TABLENBR] 
          THEN
              BEGIN 
 #     TABLE IS ON ECS OR IS CANDIDATE FOR IT - WRITE ON ECS IF CAN # 
              LENTECS = TTABECSLWA [TABLENBR];
              IF LASTWA - 1 GR LENTECS
              THEN
                  BEGIN  # EXTENDS PAST CURRENT LAST ECS SPACE #
                  NEWECSWDS = LASTWA - 1 - LENTECS;  # EXTRA WDS #
                  WDSFORECS = LENTECS - (FIRSTWA - 1);  # PART IN ECS # 
                  IF NEWECSWDS GR ECSAVAIL
                  AND ECSAVAIL NQ 0 
                  THEN
                      BEGIN  # OVERFLOWED ECS AVAILABLE # 
                      NEWECSWDS = ECSAVAIL; 
                      WDSFORECS = WDSFORECS + ECSAVAIL; 
                      WDSFORMS = WDSFORMS - WDSFORECS;
                      END 
                  ELSE
                      BEGIN 
                      IF ECSAVAIL NQ 0
                      THEN
                          BEGIN  # CAN FIT IN CURRENT ECS AVAIL # 
                          WDSFORECS = NBRWDS; 
                          WDSFORMS = 0; 
                          END 
                      ELSE
                          BEGIN  # PART IN ECS, PART IN MS #
                          IF WDSFORECS LS 0 
                          THEN
                              WDSFORECS = 0;  # PAST ECS SPACE #
                          ELSE
                              WDSFORMS = WDSFORMS - WDSFORECS;
                          END 
                      END 
                  IF ECSAVAIL NQ 0
                  THEN
                      BEGIN 
                      ECSAVAIL = ECSAVAIL - NEWECSWDS;  # AMT LEFT #
                      TEMP1 = ECSSPACE - ECSAVAIL;
                      IF TEMP1 GR ECSUSED 
                      THEN
                          ECSUSED = TEMP1;  # MAX OF ECS USED # 
                      TTABECSLWA [TABLENBR] = LENTECS + NEWECSWDS;
                      END 
                  IF WDSFORMS NQ 0
                  AND TTABFILENBR [TABLENBR] EQ 0 
                  THEN
                      BEGIN  # NEED TO ALLOCATE MS UP TO HERE # 
                      ALLOCWDS = TTABCALLOC [TABLENBR]; 
                      FOR ALLOCFWA = 1 WHILE ALLOCFWA LS LASTWA DO
                          BEGIN   # WRITE OUT GARBAGE FOR ALLOCATION #
                          TEMP1 = LASTWA - ALLOCFWA;
                          IF TEMP1 LS ALLOCWDS
                          THEN
                              ALLOCWDS = TEMP1;  # LAST PIECE # 
                          WRITEFILE (INDREF (TTABBASE [TABLENBR]),
                            ALLOCWDS, ALLOCFWA);
                          ALLOCFWA = ALLOCFWA + ALLOCWDS; 
                          END 
                      END 
                  END 
              ELSE
                  BEGIN  # ALL WILL FIT EASILY IN CURRENT ECS BOUNDS #
                  WDSFORECS = NBRWDS; 
                  WDSFORMS = 0; 
                  END 
              IF WDSFORECS NQ 0 
              THEN
                  BEGIN   # CAN WRITE ON ECS - DO SO #
                  ECSWRITE (BASECORE, WDSFORECS, FIRSTWA - 1 +
                    TTABECSBASE [TABLENBR]);  #WRITE DATA TO ECS #
                  $BEGIN
                  TTABECSACC [TABLENBR] = TTABECSACC [TABLENBR] + 1;
                  $END
                  IF LASTWA GR TTABHIGHWA [TABLENBR]
                  THEN
                      TTABHIGHWA [TABLENBR] = LASTWA; 
                  END 
              END 
          IF WDSFORMS NQ 0
          THEN
              BEGIN   # SOME TO WRITE ON MS FROM ECS OVFLOW OR NO ECS # 
              WRITEFILE (BASECORE + WDSFORECS, WDSFORMS, FIRSTWA +
                WDSFORECS);   # WRTE TO MS #
              END 
          CONTROL IFNQ DEBUGCALLS,0;
          DEBUGCSTATUS = "WRITE"; 
          CONTROL FI; 
          RETURN; 
          END 
          CONTROL EJECT;
 #                                                                     #
 #     START MAIN PROCEDURE                                            #
 #                                                                     #
          $BEGIN
 #     ADD TO COUNTER OF TABLE REFERENCES                              #
          TTABNBRREF [TABLENBR] = TTABNBRREF [TABLENBR] + 1;
  
          IF TTABRELD [TABLENBR]
          AND NOT TTABREOPEN [TABLENBR] 
          THEN
              BEGIN 
              PRINTERRORS ("TABLE CLOSED BUT REFERENCED ANYHOW"); 
              ABORT;   #TERMINATE JOB - CANNOT PROCESS CORRECTLY# 
              END 
          IF TABLEENTRY LS 0
          THEN
              BEGIN   # ERROR - NEGATIVE ARGUMENT # 
              PRINTERRORS ("NEGATIVE TABLE POINTER GIVEN     ");
              ABORT;
              END 
          $END
          IF TTABALLINCOR [TABLENBR]
          THEN
              BEGIN   # TABLE IS ALL IN CORE - TAKE SHORT CUT OUT # 
              IF TABLEENTRY LQ TTABLASTENT [TABLENBR] 
              THEN
                  BEGIN  # ENTRY IN CORE - QUICK RETURN # 
                  VIRTUAL = TABLEENTRY; 
                  $BEGIN
                  CASECOUNT1 = CASECOUNT1 + 1;
                  GOTO VIRTUALEXIT; 
                  $END
                  RETURN; 
                  END 
              ELSE
                  BEGIN  # ENTRY MAY BE IN CORE # 
                  IF TABLEENTRY LQ TTABLCENT [TABLENBR] 
                  THEN
                      BEGIN # IT IS IN CORE - RETURN #
                      TTABLASTENT [TABLENBR] = TABLEENTRY;
                      VIRTUAL = TABLEENTRY; 
                      $BEGIN
                      CASECOUNT2 = CASECOUNT2 + 1;
                      GOTO VIRTUALEXIT; 
                      $END
                      RETURN; 
                      END 
                  END 
              END 
          IF TABLEENTRY GR TTABLASTENT [TABLENBR] 
          THEN
              BEGIN 
              IF TABLEENTRY GR TTABLVENT [TABLENBR] 
              THEN
                  ADDENTRY; 
              TTABLASTENT [TABLENBR] = TABLEENTRY;
              END 
          IF TABLEENTRY LQ TTABLCENT [TABLENBR] 
          AND TABLEENTRY GQ TTABFCENT [TABLENBR]
          THEN
              BEGIN  # ANOTHER SNORTCUT - IN BASE SECTION # 
              VIRTUAL = TABLEENTRY - TTABFCENT [TABLENBR];
              $BEGIN
              CASECOUNT3 = CASECOUNT3 + 1;
              GOTO VIRTUALEXIT; 
              $END
              RETURN; 
              END 
          IF NOT TTABSPLIT [TABLENBR] 
          THEN
              BEGIN 
              READTAB;  # IS IN BASE SECTION - READ IT IN # 
              VIRTUAL = TABLEENTRY - TTABFCENT [TABLENBR];
              $BEGIN
              CASECOUNT4 = CASECOUNT4 + 1;
              GOTO VIRTUALEXIT; 
              $END
              RETURN; 
              END 
          ELSE
              BEGIN   # TABLE SPLIT # 
              FOR CURRPTAB = TTABFPTENT [TABLENBR] WHILE CURRPTAB NQ 0
                  DO BEGIN   # FIND PAGE TABLE WHICH HAS ENTRY - IF ONE#
                  IF TABLEENTRY LQ PTLENTRY [CURRPTAB]
                  AND TABLEENTRY GQ PTFENTRY [CURRPTAB] 
                  THEN
                      GOTO RTNTHISPAGE;  # FOUND IT - RETURN THIS PAGE #
                  ELSE
                      CURRPTAB = PTNEXTENT [CURRPTAB];
                  END 
              READTAB;  # NOT IN CORE - READ PAGE IN #
              IF CURRPTAB EQ 0
              THEN
                  BEGIN  # IN BASE SECTION #
                  VIRTUAL = TABLEENTRY - TTABFCENT [TABLENBR];
                  $BEGIN
                  GOTO CASE5EX; 
                  $END
                  RETURN;   # EXIT #
                  END 
              END 
 RTNTHISPAGE: 
          VIRTUAL = TABLEENTRY - PTFENTRY [CURRPTAB] +
            PTOFFSET [CURRPTAB];
          $BEGIN
 CASE5EX: 
          CASECOUNT5 = CASECOUNT5 + 1;
 VIRTUALEXIT: 
          $END
          CONTROL IFNQ DEBUGCALLS,0;
          PRINTCALLS("VIRTUAL");    # PRINT VIRTUAL TRACE INFO #
          CONTROL FI; 
          RETURN; 
          END 
          TERM
