-- 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.