-- RTBasesImpl.Mesa
-- START this first.
-- last edited May 27, 1982 4:11 pm by Paul Rovner

DIRECTORY
  Inline USING [HighHalf, LowHalf],
  Process USING [Detach],
  RTBases,
  RTCommon,
  RTBasic,
  RTFlags USING[takingStatistics, checking],
  RTOS USING[GetCollectibleQuanta, GetQuantaFromNewSpace, InsufficientVM, DeleteSpace],
  RTQuanta,
  RTRefCounts USING [ReclaimForQuanta],
  RTTypesBasic USING [Type, FinalizationQueue, EstablishFinalization, FQNext, NewFQ],
  Runs,
  SafeStorage,
  Space USING[Handle, nullHandle, PageNumber, PageFromLongPointer, GetHandle,
              virtualMemory, GetAttributes, LongPointerFromPage],
  RTZones USING[MapPtrQ];

RTBasesImpl: MONITOR -- protects bases and their common bookkeeping data
  IMPORTS Process, RTTypesBasic, RTQuanta, RTRefCounts, RTCommon,
          --RTStartPrivate, --RTOS, Inline, Runs, Space, RTZones
  EXPORTS RTBases, SafeStorage
= BEGIN
  OPEN RTTypesBasic, RTCommon, RTQuanta, RTBasic, SafeStorage, Runs, Inline;

-- Types

  BaseRec: TYPE = MONITORED RECORD
    [
    addrBase: Address,
    next: RealBase ← NIL,
    baseParent: RealBase,
    rnFree: Run ← NIL,
    offMax: Address,
    getQuanta: PROC[bs: RealBase, nQ: QuantumCount] RETURNS[QuantumIndex],
    putQuanta: PROC[bs: RealBase, q: QuantumIndex, nQ: QuantumCount]
    ];
  RealBase: TYPE = REF BaseRec;  -- "bs"

-- PUBLIC variables and ERRORs

   -- NOTE that the ref count for baseMDS starts at rcAbsent and will never be smaller.
   --   That for baseRoot starts higher, and never gets smaller.
  baseRoot: PUBLIC Base;

  InvalidSize: PUBLIC ERROR[size: LONG CARDINAL] = CODE;
  MemoryExhausted: PUBLIC SIGNAL[base: Base] = CODE;
--  CantNarrowRefToRelative: PUBLIC ERROR[ref: REF ANY, base: Base] = CODE;


-- Private variables
  maxDataQuanta: QuantumCount ← 0;
  dataQuantaInService: QuantumCount ← 0;
  listOfBases: RealBase ← NIL;
  wholeSaleNQ: QuantumCount ← 32;

-- System Bases, used until the sun comes up

  bsRoot: Pointer = @brRoot;

  brRoot: BaseRec ←
        [ baseParent: LOOPHOLE[nullBase], rnFree: NIL, addrBase: 0, offMax: LASTAddress,
          getQuanta: GetQuantaFromOS, putQuanta: PutQuantaToOS, LOCK: ];

  checking: BOOLEAN = RTFlags.checking;

-- Statistics
  takingStatistics: BOOLEAN = RTFlags.takingStatistics;
      -- "= FALSE" suppresses compilation of statistics code
  Count: TYPE = LONG CARDINAL;
  Bump: PROC[p: POINTER TO Count, delta: Count ← 1] = INLINE
    BEGIN  IF takingStatistics THEN p↑ ← p↑+delta  END;
  AllocStatsRec: TYPE = RECORD
    [ nNewQuanta: Count ← 0,
      nNewSubspaceQuanta: Count ← 0,
      nDeleteQuanta: Count ← 0
    ];
  Stats: AllocStatsRec ← [];  -- the one and only


-- Exported procedures (public)

  GetDQIS: PUBLIC PROC RETURNS[QuantumCount] = {RETURN[dataQuantaInService]};
  
  SetMaxDataQuanta: PUBLIC SAFE PROC[nQuanta: CARDINAL] RETURNS[CARDINAL] =
    TRUSTED { n: CARDINAL = maxDataQuanta; maxDataQuanta ← nQuanta; RETURN[n]};

        -- Access to built-in Bases
  GetRootBase: PUBLIC SAFE PROC RETURNS[Base] =
    TRUSTED { RETURN[baseRoot]  -- the entire address space--};

  NewBase: PUBLIC SAFE PROC[nWords: LONG CARDINAL  --words--, baseParent: Base ← nullBase]
       RETURNS[Base] =
    TRUSTED BEGIN
        -- at least one quantum
      longnQ: LONG CARDINAL = QuantumSizeDIV[ShortenLongCardinal[nWords+QuantumSize-1]];
      nQ: QuantumCount;
      q: QuantumIndex;
      bsParent: RealBase = LOOPHOLE[IF baseParent = nullBase THEN baseRoot ELSE baseParent];
      bs: RealBase;
        -- no more than 64K words
      IF nWords < RTBases.BaseOverhead OR nWords > LASTAddress OR longnQ > LAST[QuantumCount] THEN
          ERROR InvalidSize[nWords];
      nQ ← ShortenLongCardinal[longnQ];
      [q, ] ← GetQuanta[baseParent, nQ];
      bs ← NEW[BaseRec ← [ baseParent: bsParent, addrBase: LOOPHOLE[QtmIndexToPtr[q]],
                           offMax: nWords-1,
                           getQuanta: GetRunQuanta,
                           putQuanta: PutRunQuanta,
                           LOCK: ]];
      PutRunQuanta[bs, q, nQ];
      InitBase[bs];
      RETURN[[bs]];
    END;

  InitBase: ENTRY PROC[bs: RealBase] =
    { bs.next ← listOfBases; listOfBases ← bs-- the package ref--};

--  NarrowRefToRelative: PUBLIC PROC[ref: REF ANY, base: Base] RETURNS[Offset] =
--    BEGIN
--    bs: RealBase = LOOPHOLE[base];
--    addr: Address = RepPtrAddr[LOOPHOLE[ref, Pointer]];
--    IF ref = NIL THEN RETURN[0];
--    IF addr < bs.addrBase+RTBases.BaseOverhead OR addr > bs.addrBase+bs.offMax THEN
--      ERROR CantNarrowRefToRelative[ref, base];
--    RETURN[addr-bs.addrBase];
--    END;

--  NarrowRefToRelativeShort: PUBLIC PROC[ref: REF ANY, base: Base] RETURNS[ShortOffset] =
--    BEGIN
--    bs: RealBase = LOOPHOLE[base];
--    addr: Address = RepPtrAddr[LOOPHOLE[ref, Pointer]];
--    off: Offset;
--    IF ref = NIL THEN RETURN[0];
--    IF addr < bs.addrBase+RTBases.BaseOverhead OR (off ← addr-bs.addrBase) > bs.offMax
--        OR off > LAST[ShortOffset] THEN
--      ERROR CantNarrowRefToRelative[ref, base];
--    RETURN[LowHalf[off]];
--    END;

--  WidenRelativeToRef: PUBLIC PROC[off: Offset, base: Base] RETURNS[REF ANY] =
--    BEGIN
--    bs: RealBase = LOOPHOLE[base];
--    RETURN[IF off = 0 THEN NIL ELSE LOOPHOLE[RepAddrPtr[bs.addrBase+off], REF ANY]];
--    END;

--  WidenRelativeShortToRef: PUBLIC PROC[off: ShortOffset, base: Base] RETURNS[REF ANY] =
--    BEGIN
--    bs: RealBase = LOOPHOLE[base];
--    RETURN[IF off = 0 THEN NIL ELSE LOOPHOLE[RepAddrPtr[bs.addrBase+off], REF ANY]];
--    END;

-- Exported procedures 

  GetQuanta: PUBLIC PROC[base: Base, nQ: QuantumCount]
        RETURNS[q: QuantumIndex, firstQuantum: BOOLEAN] =
    BEGIN
    bs: RealBase = LOOPHOLE[base];
    DO { q ← bs.getQuanta[bs, nQ ! MemoryExhausted => GOTO failed];
           EXIT;
           EXITS failed =>
             {  IF RTRefCounts.ReclaimForQuanta[] # 0 THEN LOOP;  -- will call TrimAllZones
                q ← bs.getQuanta[bs, nQ] -- give up entirely if this fails
              }
         };
     ENDLOOP;
    firstQuantum ← (q = PtrToQtmIndex[LOOPHOLE[bs.addrBase, LONG POINTER]]);
    END;

  GetSubspaceQuanta: PUBLIC PROC[nQ: QuantumCount] RETURNS[QuantumIndex] =
    { DO { RETURN[DoGetSubspaceQuanta[nQ ! MemoryExhausted => GOTO failed]];
           EXITS failed =>
              IF RTRefCounts.ReclaimForQuanta[] # 0 THEN LOOP  -- will call TrimAllZones
               ELSE RETURN[DoGetSubspaceQuanta[nQ]]  -- give up entirely if this fails
         };
       ENDLOOP};

  DoGetSubspaceQuanta: PROC[nQ: QuantumCount] RETURNS[q: QuantumIndex] =
   { WHILE maxDataQuanta # 0 AND dataQuantaInService + nQ > maxDataQuanta
       DO SIGNAL MemoryExhausted[baseRoot]; ENDLOOP;
     q ← RTOS.GetQuantaFromNewSpace[nQ, FALSE
                                     ! RTOS.InsufficientVM => ERROR MemoryExhausted[baseRoot]];
     dataQuantaInService ← dataQuantaInService + nQ;
     Bump[@Stats.nNewSubspaceQuanta]};

  PutQuanta: PUBLIC PROC[base: Base, q: QuantumIndex, nQ: QuantumCount] =
    {bs: RealBase = LOOPHOLE[base]; bs.putQuanta[bs, q, nQ]};


-- Private procedures

  GetRunQuanta: ENTRY PROC[bs: RealBase, nQ: QuantumCount] RETURNS[qi: QuantumIndex] =
    { ENABLE UNWIND => NULL;
      RETURN[FindInterval[@bs.rnFree, nQ ! CantFindInterval => ERROR MemoryExhausted[[bs]]]]};

  PutRunQuanta: ENTRY PROC[bs: RealBase, q: QuantumIndex, nQ: QuantumCount] =
   { ENABLE UNWIND => NULL; AddInterval[@bs.rnFree, q, nQ]};

  GetQuantaFromOS: ENTRY PROC[bs: RealBase, nQ: QuantumCount] RETURNS[q: QuantumIndex] =
   { ENABLE UNWIND => NULL;
     wnQ: QuantumCount ← MAX[nQ, wholeSaleNQ];
     DO
       { WHILE maxDataQuanta # 0 AND dataQuantaInService + nQ > maxDataQuanta DO
               SIGNAL MemoryExhausted[[bs]]; ENDLOOP;
         q ← FindInterval[@bs.rnFree, nQ ! CantFindInterval => GOTO getMore];
         dataQuantaInService ← dataQuantaInService + nQ;
         Bump[@Stats.nNewQuanta];
         RETURN;
         EXITS getMore =>
           { qi: QuantumIndex;
	     qc: QuantumCount;
	     
	     WHILE maxDataQuanta # 0 AND dataQuantaInService + nQ > maxDataQuanta DO
               SIGNAL MemoryExhausted[[bs]]; ENDLOOP;
             [qi, qc] ← RTOS.GetCollectibleQuanta
                            [wnQ, nQ ! RTOS.InsufficientVM
			                  => IF wnQ # MAX[nQ, wnQ/2]
				              THEN {wnQ ← MAX[nQ, wnQ/2]; LOOP}
					      ELSE ERROR MemoryExhausted[[bs]]
			    ];
	     AddInterval[@bs.rnFree, qi, qc];
           } 
       }
     ENDLOOP};

  PutQuantaToOS: PROC[bs: RealBase, q: QuantumIndex, nQ: QuantumCount] =
   {PutRunQuanta[bs, q, nQ];
    dataQuantaInService ← dataQuantaInService - nQ;
    Bump[@Stats.nDeleteQuanta]};

    reclaimedSpace: SIGNAL = CODE;
  TrimRootBase: PUBLIC SAFE PROC RETURNS[CARDINAL] =
   TRUSTED {RETURN[DoTrimRootBase[LOOPHOLE[baseRoot]]]};

  DoTrimRootBase: ENTRY PROC[bs: RealBase] RETURNS[nSpacesDeleted: CARDINAL ← 0] =
   { ENABLE UNWIND => NULL;
     p: PROC[iFrom, n: RunValue] =
      { sh: Space.Handle;
        sq: QuantumIndex;
        snQ: QuantumCount;
        [sh, sq, snQ] ← FindEntireSpace[MapQPtr[iFrom], MapQPtr[iFrom+n]];
        IF sh # Space.nullHandle
         THEN {DeleteInterval[@bs.rnFree, sq, snQ];
                  RTOS.DeleteSpace[sh];
                  nSpacesDeleted ← nSpacesDeleted + 1;
                  SIGNAL reclaimedSpace}
      };

     MapIntervals[@bs.rnFree, p ! reclaimedSpace => RETRY];
   };

  FindEntireSpace: PROC[first, next: LONG POINTER]
     RETURNS[sh: Space.Handle, sq: QuantumIndex ← 0, snQ: QuantumCount ← 0] =
   { OPEN Space;
     n: CARDINAL;
     FOR page: PageNumber ← PageFromLongPointer[first], page + n
       UNTIL page >= PageFromLongPointer[next]
      DO
        n ← 1;
        sh ← GetHandle[page];
        IF checking AND sh = virtualMemory THEN ERROR;
        FOR parent: Handle ← GetAttributes[sh].parent, GetAttributes[parent].parent
          UNTIL parent = virtualMemory DO sh ← parent ENDLOOP;
        IF GetAttributes[sh].base = page
         THEN {nextPg: PageNumber = page + GetAttributes[sh].size;
               IF nextPg <= PageFromLongPointer[next]
                 THEN
                   {sq ← RTZones.MapPtrQ[LongPointerFromPage[page]];
                    snQ ← RTZones.MapPtrQ[LongPointerFromPage[nextPg]] - sq;
                    IF checking AND (page MOD PagesPerQuantum # 0
                                      OR GetAttributes[sh].size MOD PagesPerQuantum # 0)
                      THEN ERROR;
                    RETURN}
                 ELSE EXIT}
         ELSE n ← GetAttributes[sh].size - (page - GetAttributes[sh].base);
       ENDLOOP;
     sh ← nullHandle;
   };

  IsQRunFree: ENTRY PROC[bs: RealBase, q: QuantumIndex, nQ: QuantumCount]
                                                RETURNS[free: BOOLEAN] =
    { ENABLE UNWIND => NULL;
      free ← TRUE;
      DeleteInterval[@bs.rnFree, q, nQ !  MissingInterval => BEGIN  free ← FALSE; CONTINUE  END]};

  BaseFinalizerProcess: PROC[bfq: FinalizationQueue] =
    BEGIN
      DO
        bs: RealBase = LOOPHOLE[FQNext[bfq]];
        IF FinalizeBase[LOOPHOLE[bs]] THEN KillBasePackageRef[bs];
       ENDLOOP;
    END;

  KillBasePackageRef: ENTRY PROC[bs: RealBase] =
    { prev: RealBase ← listOfBases;
      IF prev = bs THEN listOfBases ← bs.next
       ELSE
        { UNTIL prev.next = bs DO prev ← prev.next; IF prev = NIL THEN ERROR ENDLOOP;
          prev.next ← bs.next
        }
    };

  FinalizeBase: PROC[base: Base] RETURNS[empty: BOOLEAN] =
    BEGIN
      bs: RealBase = LOOPHOLE[base];
      q: QuantumIndex ← PtrToQtmIndex[LOOPHOLE[bs.addrBase, LONG POINTER]];
      nQ: QuantumCount ← PtrToQtmIndex[LOOPHOLE[bs.offMax, LONG POINTER]] + 1;
      empty ← FALSE;
      IF IsQRunFree[bs, q, nQ] THEN  -- kills the run ifso
       { bs.baseParent.putQuanta[bs.baseParent, q, nQ]; empty ← TRUE};
    END;

  MakeAnHonestWoman: PUBLIC PROC =
    BEGIN
      bfq: FinalizationQueue ← NewFQ[];
      b: Base;

      EstablishFinalization[CODE[BaseRec],1,bfq];

      b ← LOOPHOLE[NEW[BaseRec ← [ next: NIL,
                                   addrBase: LOOPHOLE[baseRoot, RealBase].addrBase,
                                   baseParent: LOOPHOLE[nullBase, RealBase],
                                   rnFree: LOOPHOLE[baseRoot, RealBase].rnFree,
                                   offMax: LOOPHOLE[baseRoot, RealBase].offMax,
                                   getQuanta: LOOPHOLE[baseRoot, RealBase].getQuanta,
                                   putQuanta: LOOPHOLE[baseRoot, RealBase].putQuanta,
                                   LOCK: ]]];

      LOOPHOLE[baseRoot, Pointer] ← NIL;
      baseRoot ← b;
      listOfBases ← LOOPHOLE[baseRoot];
      Process.Detach[FORK BaseFinalizerProcess[bfq]];
    END;


-- MODULE INITIALIZATION


    -- only until the sun comes up
  LOOPHOLE[baseRoot, Pointer] ← bsRoot;


END.