-- RTBasesImpl.Mesa -- START this first. -- last edited February 16, 1983 3:36 pm by Paul Rovner DIRECTORY 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 RTQuanta, RTRefCounts, RTCommon, RTOS, Runs, Space, RTZones EXPORTS RTBases, SafeStorage = BEGIN OPEN RTCommon, RTQuanta, RTBasic, SafeStorage, Runs; -- Types BaseRec: TYPE = 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 _ 16; firstWholeSaleNQ: QuantumCount _ 512; firstGetQuantaFromOSDone: BOOL _ FALSE; -- 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]; 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 ENTRY PROC RETURNS[qc: QuantumCount _ 0] = TRUSTED { ENABLE UNWIND => NULL; p: PROC[iFrom, n: RunValue] = {qc _ qc+n}; MapIntervals[@LOOPHOLE[baseRoot, RealBase].rnFree, p]; }; 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]]; PutRunQuanta[bs, q, nQ]; -- InitBase[bs]; RETURN[[bs]]; END; -- create the package ref-- -- InitBase: ENTRY PROC[bs: RealBase] = -- { bs.next _ listOfBases; listOfBases _ bs}; -- 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, IF NOT firstGetQuantaFromOSDone THEN firstWholeSaleNQ ELSE 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; IF NOT firstGetQuantaFromOSDone THEN {firstGetQuantaFromOSDone _ TRUE; FOR i: CARDINAL IN [0..wnQ/wholeSaleNQ) DO [qi, qc] _ RTOS.GetCollectibleQuanta[wholeSaleNQ, wholeSaleNQ]; AddInterval[@bs.rnFree, qi, qc]; ENDLOOP} ELSE {[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]]]; 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.