DIRECTORY
Allocator USING[BlockSizeIndex, bsiEscape, BSIToSizeObj, EHeaderP, ExtendedHeader, FNHeaderP, Header, HeaderP, LastAddress, logPagesPerQuantum, maxSmallBlockSize, minLargeBlockSize, NHeaderP, NormalHeader, pagesPerQuantum, PUZone, QMObject, QuantumCount, QuantumIndex, QuantumMap, SizeToBSIObj, UZoneObject, wordsPerQuantum, Zone, ZoneObject],
AllocatorOps USING[REFToNHP, permanentPageZone, CreateMediumSizedHeapObject, FreeMediumSizedHeapObject, DFHeaderP, DoubleFreeHeader, Rover, nonNullType],
Basics USING[LowHalf, BITAND],
Collector USING[InternalReclaim],
PrincOps USING[SD, wordsPerPage, StateVector, zRET],
PrincOpsUtils USING[ZERO, MyLocalFrame],
RCMicrocodeOps USING[CreateRef, Allocate, Free, rcMicrocodeExists, InsertQuanta, DoFREE, SoftwareAllocate, SoftwareFree, FREEPLEASE],
RTSD USING[sSystemZone],
SafeStorage USING[nullType, GetCanonicalType, NarrowRefFault, Type],
SafeStoragePrivate USING[], -- TEMPORARY export of NewObject
StorageAccounting USING[nObjectsCreated, ConsiderCollection, nObjectsReclaimed, nWordsReclaimed],
StorageTraps USING[],
TrapSupport USING[BumpPC, GetTrapParam],
UnsafeStorage USING[],
VM USING[PageNumberForAddress, PagesForWords, Free, CantAllocate, Allocate, wordsPerPage],
ZCT USING[Enter, ExpandZCT, zct];
ERRORS
InsufficientVM: ERROR = CODE;
InvalidRef: PUBLIC ERROR[ref: REF ANY] = CODE;
CONSTANTS
checking: BOOL = TRUE;
takingStatistics: BOOL = TRUE;
maxSmallBlockRealSize: NAT = QuantizedSize[maxSmallBlockSize];
minLargeBlockRealSize: NAT = QuantizedSize[minLargeBlockSize];
VARIABLES and their INITIALIZATION
NOTE: the declaration sequence below is EXTREMELY DELICATE. Order of the declarations and their initilization is important.
Support for the systemUZone
rZnHeapSystem: UZoneObject ← [new: NewHeapObject, free: FreeHeapObject];
znHeapSystem: LONG POINTER ← LONG[@rZnHeapSystem];
zhs: UNCOUNTED ZONE ← LOOPHOLE[LONG[@znHeapSystem], UNCOUNTED ZONE];
Support for both uncounted and counted storage
bsiToSize maps a bsi to a quantized size (including overhead) for small block sizes
bsiToSize:
PUBLIC LONG
POINTER
TO BSIToSizeObj
← permanentPageZone.NEW[BSIToSizeObj ← ALL[0]];
sizeToBSI maps a requested size <= maxSmallBlockSize (not including overhead) to a bsi
sizeToBSI: PUBLIC LONG POINTER TO SizeToBSIObj ← permanentPageZone.NEW[SizeToBSIObj];
Support for counted storage only
the "medium-sized" free list (msRover): a doubly-linked ring
msRoot: DoubleFreeHeader ← [
dummy entry; the "medium-sized" free list never has NIL ptrs
eh: [extendedSize: 0, normalHeader: [blockSizeIndex: bsiEscape]],
nextFree: @msRoot,
prevFree: @msRoot
];
msRover: Rover ← @msRoot;
the "permanent" free list (permRover): a doubly-linked ring
permRoot: DoubleFreeHeader ← [
dummy entry; the "permanent" free list never has NIL ptrs
eh: [extendedSize: 0, normalHeader: [blockSizeIndex: bsiEscape]],
nextFree: @permRoot,
prevFree: @permRoot
];
permRover: Rover ← @permRoot;
This has a flag for each page in VM, TRUE iff the page is assigned to a counted ZONE.
quantumMap: PUBLIC QuantumMap ← permanentPageZone.NEW[QMObject];
systemZone: ZONE ← NIL;
permanentZone: ZONE ← NIL;
Statistics
nQMapEntries: INT ← 0;
END: VARIABLES and their INITIALIZATION
PROCEDURES
Support for uncounted storage
Public access to uncounted storage
NewUObject:
PUBLIC
PROC[size:
CARDINAL
--words--, zone:
UNCOUNTED
ZONE]
RETURNS [LONG POINTER] ={
RETURN[NewHeapObject[LOOPHOLE[zone, PUZone], size]];
};
GetSystemUZone:
PUBLIC
PROC
RETURNS[
UNCOUNTED
ZONE] =
{RETURN[zhs]};
TrimUZone:
PUBLIC
PROC[zone:
UNCOUNTED
ZONE] = {
NULL;
};
UNCOUNTED ZONE procs
Referenced only via zhs, The "systemUZone"
NewHeapObject:
PROC[self: PUZone, size:
CARDINAL]
RETURNS[p: LONG POINTER] = {
realSize: INT = MAX[QuantizedSize[size], SIZE[DoubleFreeHeader]];
IF IsLargeRealSize[realSize]
THEN p ← CreateLargeObject
[type: nonNullType, size: realSize, permanent: FALSE, counted: FALSE]
ELSE
WHILE (p ← AllocatorOps.CreateMediumSizedHeapObject[size: realSize]) =
NIL
DO ExpandDoubleFreeList
[realSize: realSize, permanent: TRUE, varRover: NIL, counted: FALSE];
ENDLOOP;
IF checking
THEN {
nhp: NHeaderP = p-SIZE[NormalHeader];
IF nhp.inZCT
OR nhp.f
OR nhp.rcOverflowed
OR nhp.refCount # 0
OR nhp.type # nonNullType
OR UsableWords[nhp] < size
THEN ERROR;
};
RETURN[p];
}; -- end NewHeapObject
Referenced only via zhs, The "systemUZone"
FreeHeapObject:
PROC[self: PUZone, object:
LONG
POINTER] = {
nhp: NHeaderP = LOOPHOLE[object - SIZE[NormalHeader]];
IF checking
THEN
IF nhp.inZCT
OR nhp.f
OR nhp.rcOverflowed
OR nhp.refCount # 0
OR nhp.type # nonNullType
THEN ERROR;
IF nhp.blockSizeIndex = bsiEscape
THEN {
-- large or medium-sized object or extended header for some other reason
ehp: EHeaderP = NHPToEHP[nhp];
realSize: INT ← ExtendedBlockSize[ehp];
IF IsLargeRealSize[realSize]
THEN {
IF checking
AND (realSize MOD wordsPerQuantum # 0)
AND (LOOPHOLE[ehp, INT] MOD wordsPerQuantum # 0)
AND NOT IsClearQMapRange[qi: LPToQI[ehp], qc: WordsToQC[realSize]]
THEN ERROR;
VM.Free[
[page: VM.PageNumberForAddress[ehp],
count: VM.PagesForWords[realSize]
]];
}
ELSE AllocatorOps.FreeMediumSizedHeapObject[
LOOPHOLE[ehp, DFHeaderP]];
medium-sized or small object.
}
ELSE {
-- small normal object
LOOPHOLE[nhp, EHeaderP]^
← [extendedSize: bsiToSize[nhp.blockSizeIndex],
normalHeader: [blockSizeIndex: bsiEscape]];
AllocatorOps.FreeMediumSizedHeapObject[LOOPHOLE[nhp, DFHeaderP]];
};
}; -- end FreeHeapObject
Support for counted storage
Public access to counted storage
GetSystemZone:
PUBLIC
SAFE
PROC
RETURNS[
ZONE] =
TRUSTED{RETURN[systemZone]};
GetPermanentZone:
PUBLIC
SAFE
PROC
RETURNS[
ZONE] =
TRUSTED{RETURN[permanentZone]};
TrimSystemZone: PUBLIC SAFE PROC = TRUSTED{NULL};
NewObject:
PUBLIC
PROC[type: SafeStorage.Type, size:
CARDINAL, zone:
ZONE ←
NIL]
RETURNS[ans: REF ← NIL] = {
IF zone = NIL THEN zone ← systemZone;
IF zone = systemZone THEN ans ← NewSystemObject[NIL, size, type]
ELSE IF zone = permanentZone THEN ans ← NewPermanentObject[NIL, size, type]
ELSE ERROR;
};
ValidateRef:
PUBLIC
ENTRY PROC[ref:
REF] = {
ENABLE UNWIND => NULL;
IF
NOT IsValidRef[
LOOPHOLE[ref,
LONG
POINTER]]
THEN RETURN WITH ERROR InvalidRef[ref];
};
IsValidRef:
PUBLIC
--INTERNAL--
PROC[p:
LONG
POINTER]
RETURNS[
BOOL] = {
qi: QuantumIndex;
IF p = NIL THEN RETURN[TRUE];
IF
LOOPHOLE[p,
LONG
CARDINAL] > LastAddress
OR NOT quantumMap[qi ← LPToQI[p]] THEN RETURN[FALSE];
UNTIL qi = FIRST[QuantumIndex] OR NOT quantumMap[qi-1] DO qi ← qi-1 ENDLOOP;
Start parsing at the beginning of the first quantum in this run
FOR hp: HeaderP ← QIToLP[qi], hp + BlockSize[hp]
UNTIL LOOPHOLE[hp, LONG CARDINAL] > LOOPHOLE[p, LONG CARDINAL]
DO
r:
LONG
POINTER
=
IF IsExtendedBlock[hp]
THEN hp + SIZE[ExtendedHeader] ELSE hp + SIZE[NormalHeader];
IF p = r
THEN {
nhp: NHeaderP ← REFToNHP[LOOPHOLE[r, REF]];
IF nhp.type # SafeStorage.nullType THEN RETURN[TRUE] ELSE RETURN[FALSE];
};
ENDLOOP;
RETURN[FALSE];
};
ZONE procs
Referenced from systemZone and called from NewObject and Initialize
size DOES NOT INCLUDE overhead
NewSystemObject:
--PUBLIC--PROC[self: Zone, size: CARDINAL, type: SafeStorage.Type]
RETURNS[r: REF] = {
realSize: INT ← size;
IF (r ← RCMicrocodeOps.Allocate[size, type]) = NIL
THEN {
-- medium-sized or large object
realSize ← QuantizedSize[size];
IF IsLargeRealSize[realSize]
THEN r ←
LOOPHOLE
[CreateLargeObject
[type: type, size: realSize, permanent: FALSE, counted: TRUE],
REF]
ELSE
-- medium-sized object.
WHILE (r ←
LOOPHOLE[CreateMediumSizedObject
[size: realSize, type: type,
roverP: @msRover], REF]) = NIL
DO ExpandDoubleFreeList
[realSize: realSize, permanent: TRUE,
varRover: @msRover, counted: TRUE];
ENDLOOP;
};
StorageAccounting.nObjectsCreated ← StorageAccounting.nObjectsCreated + 1;
StorageAccounting.ConsiderCollection[size, IF takingStatistics THEN realSize ELSE size];
IF checking
THEN {
nhp: NHeaderP = REFToNHP[r];
IF
NOT nhp.inZCT
OR nhp.f
OR nhp.rcOverflowed
OR nhp.refCount # 0
OR nhp.type # type
OR UsableWords[nhp] < size
THEN ERROR;
};
}; -- end NewSystemObject
Called from Allocate and AllocateTrap.
ExpandNormalFreeList:
PUBLIC PROC[bsi: BlockSizeIndex] = {
qi: QuantumIndex;
qc: QuantumCount;
druthers: QuantumCount = WordsToQC[Lcm[bsiToSize[bsi], wordsPerQuantum]];
first: FNHeaderP ← NIL;
last: FNHeaderP;
next: FNHeaderP;
incr: NAT = bsiToSize[bsi];
[qi, qc]
← GetQuanta[
desired: druthers,
smallest x s.t. bsiToSize[bsi] divides QCToWords[x]
needed: druthers,
-- (bsiToSize[bsi]-1)/wordsPerQuantum + 1
smallest x s.t. (QCToWords[x]) >= bsiToSize[bsi]
permanent: TRUE
];
last ← LOOPHOLE[QIToLP[qi], FNHeaderP];
next ← LOOPHOLE[QIToLP[qi+qc], FNHeaderP];
Clear[last, QCToWords[qc]];
FOR fnhp: FNHeaderP ← last, fnhp + incr
UNTIL fnhp = next
DO
fnhp.fnh ← [blockSizeIndex: bsi];
fnhp.nextFree ← first;
WAS fnhp^ ← [fnh: [blockSizeIndex: bsi], nextFree: first]; ??
first ← fnhp;
ENDLOOP;
PutQuantaOnNormalFreeList[bsi, qi, qc, first, last];
};
Called only from ExpandNormalFreeList
PutQuantaOnNormalFreeList:
ENTRY
PROC[
atomic: stuffing the quantum map and expansion of the free list. Should be in the quantumMap monitor
bsi: BlockSizeIndex, qi: QuantumIndex,
qc: QuantumCount, first, last: FNHeaderP] = {
ENABLE UNWIND => NULL;
IF checking
AND Basics.BITAND[Basics.LowHalf[LOOPHOLE[first, LONG CARDINAL]], 1] # 0
THEN ERROR;
RCMicrocodeOps.InsertQuanta[bsi, first, last];
now stuff the QMap
StuffQMapRange[qi, qc];
};
Called only from NewSystemObject.
CreateNormalObject: ENTRY PROC[bsi: BlockSizeIndex, type: SafeStorage.Type]
RETURNS[r: REF ← NIL] = {ENABLE UNWIND => NULL;
fnhp: FNHeaderP;
IF (fnhp ← bsiToFreeList[bsi]) = NIL THEN RETURN;
IF checking
AND Basics.BITAND
[Basics.LowHalf[LOOPHOLE[fnhp.nextFree, LONG CARDINAL]], 1] # 0
THEN ERROR;
bsiToFreeList[bsi] ← fnhp.nextFree;
fnhp.nextFree ← NIL; -- CLEAR IT
IF checking THEN {
nhp: NHeaderP = @fnhp.fnh;
IF nhp.inZCT
OR nhp.maybeOnStack
OR nhp.f
OR nhp.rcOverflowed
OR nhp.refCount # 0
OR nhp.type # SafeStorage.nullType
THEN ERROR;
};
fnhp.fnh.type ← type;
r ← NHPToREF[@fnhp.fnh]; -- gotta have a ref on the stack
RCMicrocodeOps.CreateRef[@fnhp.fnh];
};
Referenced from permanentZone and called from NewObject
size DOES NOT INCLUDE overhead
NewPermanentObject:
--PUBLIC--PROC[self: Zone, size: CARDINAL, type: SafeStorage.Type]
RETURNS[r: REF] = {
realSize: INT;
IF IsSmallRequestedSize[size]
THEN {
-- small object
bsi: BlockSizeIndex = sizeToBSI[size];
realSize ← bsiToSize[bsi];
WHILE (r ←
LOOPHOLE[CreateMediumSizedObject
[size: realSize, type: type,
roverP: @permRover], REF]) = NIL
DO ExpandDoubleFreeList
[realSize: realSize, permanent: TRUE,
varRover: @permRover, counted: TRUE];
ENDLOOP;
}
ELSE {
-- medium-sized or large object
realSize ← QuantizedSize[size];
IF IsLargeRealSize[realSize]
THEN r ←
LOOPHOLE
[CreateLargeObject
[type: type, size: realSize, permanent: TRUE, counted: TRUE],
REF]
ELSE
-- medium-sized object.
WHILE (r ←
LOOPHOLE[CreateMediumSizedObject
[size: realSize, type: type,
roverP: @permRover],
REF])
= NIL
DO ExpandDoubleFreeList
[realSize: realSize, permanent: TRUE,
varRover: @permRover, counted: TRUE];
ENDLOOP;
};
StorageAccounting.nObjectsCreated ← StorageAccounting.nObjectsCreated + 1;
StorageAccounting.ConsiderCollection
[size, IF takingStatistics THEN realSize ELSE size];
IF checking
THEN {
nhp: NHeaderP = REFToNHP[r];
IF
NOT nhp.inZCT
OR nhp.f
OR nhp.rcOverflowed
OR nhp.refCount # 0
OR nhp.type # type
OR UsableWords[nhp] < size
THEN ERROR;
};
RETURN[r];
};
Referenced from systemZone and permanentZone
FreeSystemObject:
PROC[self: Zone, object:
REF
ANY] = {
NULL; -- XXX RCMapWalkerImpl.FreeCollectibleObject[object];
};
Procs called from ZONE procs and UNCOUNTED ZONE procs
Called from NewSystemObject and NewPermanentObject
size includes overhead, has been quantized and is >= SIZE[DoubleFreeHeader].
This proc may return an object of a larger size than requested.
Returns NIL if free list needs expansion.
CreateMediumSizedObject:
ENTRY
PROC
[size: NAT, type: SafeStorage.Type, roverP: LONG POINTER TO--VAR-- Rover]
RETURNS[p: LONG POINTER ← NIL] = {ENABLE UNWIND => NULL;
p ← DoCreateMediumSizedObject[size, type, roverP, TRUE];
};
Called from CreateMediumSizedObject and UnsafeAllocatorImpl.CreateMediumSizedHeapObject
size includes overhead, has been quantized and is >= SIZE[DoubleFreeHeader].
This proc may return an object of a larger size than requested.
Returns NIL if free list needs expansion.
DoCreateMediumSizedObject:
PUBLIC
--INTERNAL--
PROC
[size: NAT, type: SafeStorage.Type, roverP: LONG POINTER TO--VAR-- Rover, counted: BOOL]
RETURNS[p: LONG POINTER ← NIL] = {
rover: Rover ← roverP^;
first: DFHeaderP ← rover;
freeBlockLength, excess: INT;
nhp: NHeaderP ← NIL;
UNTIL (freeBlockLength ← ExtendedBlockSize[@rover.eh]) >= size
DO
roverP^ ← rover ← rover.nextFree;
IF rover = first THEN RETURN -- no free block is large enough
ENDLOOP;
Here with a large enough free block; rover points to it
IF (excess ← freeBlockLength - size) >= size
OR IsLargeRealSize[freeBlockLength]
this OR clause is here in case the new object gets reclaimed to avoid thinking it a LargeObject and therefore assuming it page-aligned and a page-size multiple, hence VM.Free-able. Large objects are allocated above this level.
THEN {
-- split the block
get the new object from the end of the free block
IF checking
AND excess <
SIZE[normal free Header]
THEN
ERROR;
says here that this can't happen
change the size of the free block
IF counted
AND IsSmallRealSize[excess]
THEN {
move the excess block to a normal free list
frag: DFHeaderP = rover;
roverP^ ← frag.nextFree;
frag.nextFree.prevFree ← frag.prevFree;
frag.prevFree.nextFree ← frag.nextFree;
DoFreeNormalFragment[frag, excess];
}
ELSE
--change the size of the free block--
IF rover.eh.sizeTag = pages
THEN {
IF excess <
LAST[
CARDINAL]
THEN {
can't be equal 'cause excess is even
rover.eh.sizeTag ← words;
rover.eh.extendedSize ← excess;
}
ELSE {
-- excess is large
IF excess
MOD PrincOps.wordsPerPage # 0
THEN {
ERROR; -- XXX not implemented yet (I'm getting sick of this)
};
rover.eh.extendedSize ← excess/PrincOps.wordsPerPage;
};
}
ELSE {rover.eh.extendedSize ← excess; rover.eh.sizeTag ← words};
done dealing with the fragment
rover ← LOOPHOLE[rover + excess];
LOOPHOLE[rover, EHeaderP]^
← [extendedSize: size, normalHeader: [blockSizeIndex: bsiEscape]];
} --end case of excess >= size OR IsLargeRealSize[freeBlockLength]
ELSE {
-- remove the block from the free list without splitting it
rover.nextFree.prevFree ← rover.prevFree;
roverP^ ← rover.prevFree.nextFree ← rover.nextFree;
rover.nextFree ← rover.prevFree ← NIL; -- CLEAR IT
size ← freeBlockLength;
};
nhp ←
IF IsSmallRealSize[size]
THEN LOOPHOLE[MakeNormalFragment[rover, size].fnhp, NHeaderP]
ELSE DFHPToNHP[rover];
nhp.type ← type;
p ← nhp+SIZE[NormalHeader]; -- here for the conservative scan
IF counted THEN RCMicrocodeOps.CreateRef[nhp];
}; -- end DoCreateMediumSizedObject
Called from NewHeapObject, NewSystemObject and NewPermanentObject
CreateLargeObject:
PROC[type: SafeStorage.Type, size: INT, permanent: BOOL, counted: BOOL]
RETURNS[p: LONG POINTER ← NIL] = {
qi: QuantumIndex;
qc: QuantumCount;
druthers: QuantumCount = WordsToQC[size];
ehp: EHeaderP;
IF checking AND size MOD wordsPerQuantum # 0 THEN ERROR;
[qi, qc] ← GetQuanta[desired: druthers, needed: druthers, permanent: permanent];
ehp ← LOOPHOLE[QIToLP[qi], EHeaderP];
IF counted THEN Clear[ptr: ehp, size: QCToWords[qc]];
ehp^ ← [
sizeTag: pages,
extendedSize: QCToPages[qc],
normalHeader: [blockSizeIndex: bsiEscape, type: type]
];
p ← ehp + SIZE[ExtendedHeader]; -- here for the conservative scan
IF counted THEN DoCreateLargeObject[qi, qc, ehp, type];
};
Called only from CreateLargeObject
DoCreateLargeObject:
ENTRY
PROC[
--belongs in the quantumMap monitor
qi: QuantumIndex, qc: QuantumCount, ehp: EHeaderP, type: SafeStorage.Type] = {
ENABLE UNWIND => NULL;
RCMicrocodeOps.CreateRef[EHPToNHP[ehp]];
StuffQMapRange[qi, qc];
};
Procs called by the reclaimer and TraceAndSweepImpl
FreeObject:
PUBLIC
PROC[nhp: NHeaderP] = {
realSize: INT;
IF checking
THEN
IF nhp.inZCT
OR nhp.f
OR nhp.rcOverflowed
OR nhp.refCount # 0
OR nhp.type = SafeStorage.nullType
THEN ERROR;
StorageAccounting.nObjectsReclaimed ← StorageAccounting.nObjectsReclaimed + 1;
IF RCMicrocodeOps.Free[nhp].success
THEN realSize ← bsiToSize[nhp.blockSizeIndex]
ELSE {
-- large or medium-sized object or extended header for some other reason
ehp: EHeaderP = NHPToEHP[nhp];
realSize ← ExtendedBlockSize[ehp];
IF IsLargeRealSize[realSize]
THEN {
IF checking
AND (realSize MOD wordsPerQuantum # 0)
AND (LOOPHOLE[ehp, INT] MOD wordsPerQuantum # 0)
AND NOT IsFullQMapRange[qi: LPToQI[ehp], qc: WordsToQC[realSize]]
THEN ERROR;
ClearQMapRange[qi: LPToQI[ehp], qc: WordsToQC[realSize]];
VM.Free[
[page: VM.PageNumberForAddress[ehp],
count: VM.PagesForWords[realSize]
]];
}
ELSE
IF IsMediumRealSize[realSize]
THEN {
-- medium-sized object.
[] ← PrincOpsUtils.
ZERO[ehp +
SIZE[ExtendedHeader],
realSize - SIZE[ExtendedHeader]];
FreeMediumSizedObject[LOOPHOLE[ehp, DFHeaderP]];
}
ELSE FreeNormalFragment[ehp, realSize];
};
StorageAccounting.nWordsReclaimed
← StorageAccounting.nWordsReclaimed + realSize;
}; -- end FreeObject
TAndSFreeObject:
PUBLIC
--INTERNAL--
PROC[nhp: NHeaderP] = {
StorageAccounting.nObjectsReclaimed ← StorageAccounting.nObjectsReclaimed + 1;
IF
NOT RCMicrocodeOps.
FREEPLEASE[nhp].success
THEN {
-- large or medium-sized object or extended header for some other reason
ehp: EHeaderP = NHPToEHP[nhp];
realSize: INT ← ExtendedBlockSize[ehp];
StorageAccounting.nWordsReclaimed
← StorageAccounting.nWordsReclaimed + realSize;
IF IsLargeRealSize[realSize]
THEN {
IF checking
AND (realSize MOD wordsPerQuantum # 0)
AND (LOOPHOLE[ehp, INT] MOD wordsPerQuantum # 0)
AND
NOT IsFullQMapRangeInternal[qi: LPToQI[ehp],
qc: WordsToQC[realSize]]
THEN ERROR;
ClearQMapRangeInternal[qi: LPToQI[ehp], qc: WordsToQC[realSize]];
VM.Free[
[page: VM.PageNumberForAddress[ehp],
count: VM.PagesForWords[realSize]
]];
}
ELSE
IF IsMediumRealSize[realSize]
THEN {
-- medium-sized object.
[] ← PrincOpsUtils.
ZERO[ehp +
SIZE[ExtendedHeader],
realSize - SIZE[ExtendedHeader]];
DoFreeMediumSizedObject[LOOPHOLE[ehp, DFHeaderP], msRover];
}
ELSE TAndSDoFreeNormalFragment[ehp, realSize];
};
}; -- end TAndSFreeObject
Called only by FreeObject
stick this block (which may be extended) on the specified (small-sized) free list
FreeNormalSizedObject: ENTRY PROC[fnhp: FNHeaderP, bsi: BlockSizeIndex] = {
ENABLE UNWIND => NULL;
DoFreeNormalSizedObject[fnhp, bsi];
};
Called only by FreeObject
FreeNormalFragment:
ENTRY
PROC[p:
LONG
POINTER, realSize:
NAT] = {
ENABLE UNWIND => NULL;
DoFreeNormalFragment[p, realSize];
};
called by DoFreeNormalFragment
DoFreeNormalSizedObject:
INTERNAL PROC[fnhp: FNHeaderP, bsi: BlockSizeIndex] = {
IF checking
AND Basics.BITAND[Basics.LowHalf[LOOPHOLE[fnhp, LONG CARDINAL]], 1] # 0
THEN ERROR;
fnhp.fnh.type ← SafeStorage.nullType; -- mark the object as free
fnhp.nextFree ← bsiToFreeList[bsi];
bsiToFreeList[bsi] ← fnhp;
};
called by FreeNormalFragment and by CreateMediumSizedObject
DoFreeNormalFragment:
--INTERNAL--
PROC[p:
LONG
POINTER, realSize:
NAT] = {
bsi: BlockSizeIndex;
fnhp: FNHeaderP;
[fnhp, bsi] ← MakeNormalFragment[p, realSize];
RCMicrocodeOps.DoFREE[fnhp, bsi];
};
TAndSDoFreeNormalFragment:
--INTERNAL--PROC[p: LONG POINTER, realSize: NAT] = {
bsi: BlockSizeIndex;
fnhp: FNHeaderP;
[fnhp, bsi] ← MakeNormalFragment[p, realSize];
--********
RCMicrocodeOps.DoFREE[fnhp, bsi];
fnhp.fnh.type ← SafeStorage.nullType; -- mark the object as free
fnhp.nextFree ← ZCT.zct.bsiToFreeList[bsi];
ZCT.zct.bsiToFreeList[bsi] ← fnhp;
--********
};
called by DoFreeNormalFragment, CreateMediumSizedObject
Returns the bsi s.t. bsiToSize[bsi] <= realSize
MakeNormalFragment:
--INTERNAL-- PROC[p: LONG POINTER, realSize: NAT]
RETURNS[fnhp: FNHeaderP ← NIL, rbsi: BlockSizeIndex ← 0] = {
bsi: BlockSizeIndex ← sizeToBSI[realSize -
SIZE[NormalHeader]];
Yields bsi s.t. bsiToSize[bsi] >= realSize
IF checking AND bsiToSize[bsi] < realSize THEN ERROR;
PrincOpsUtils.ZERO[p, realSize];
IF bsiToSize[bsi] = realSize
THEN {
-- make it a small block with a normal header
nhp: NHeaderP ← LOOPHOLE[p, NHeaderP];
nhp^ ← [blockSizeIndex: bsi];
fnhp ← LOOPHOLE[nhp, FNHeaderP];
rbsi ← bsi;
}
ELSE {
-- bsiToSize[bsi] > realSize
unusual size: make an extended block
ehp: EHeaderP = LOOPHOLE[p, EHeaderP];
ehp^ ← [extendedSize: realSize, normalHeader: [blockSizeIndex: bsiEscape]];
IF checking
AND (bsi = FIRST[BlockSizeIndex] OR bsiToSize[bsi-1] > realSize)
THEN ERROR;
fnhp ← LOOPHOLE[@ehp.normalHeader, FNHeaderP];
rbsi ← bsi - 1;
};
};
Called from FreeObject.
Assume header is made
Assume block is cleared
FreeMediumSizedObject:
ENTRY
PROC[ptr: DFHeaderP] = {
ENABLE UNWIND => NULL;
DoFreeMediumSizedObject[ptr, msRover];
};
Called only from ExpandDoubleFreeList.
Assume header is made
Assume block is cleared
FreeNewMediumSizedObject:
ENTRY
PROC
[ptr: DFHeaderP,
varRover: LONG POINTER TO Rover,
qi: QuantumIndex,
qc: QuantumCount] = {
ENABLE UNWIND => NULL;
DoFreeMediumSizedObject[ptr, varRover^];
StuffQMapRange[qi, qc]; -- stuff the quantum map
};
Called from FreeNewMediumSizedObject, FreeMediumSizedObject, FreeMediumSizedHeapObject, TAndSFreeObject.
DoFreeMediumSizedObject:
PUBLIC --INTERNAL-- PROC[ptr: DFHeaderP, rover: Rover] = {
ptr.eh.normalHeader.type ← SafeStorage.nullType;
ptr.nextFree ← rover.nextFree;
ptr.prevFree ← rover;
rover.nextFree.prevFree ← ptr;
rover.nextFree ← ptr;
};
Called from TraceAndSweepImpl.
EnterAndCallBack:
PUBLIC
ENTRY
PROC[proc:
PROC] = {
ENABLE UNWIND => NULL;
proc[];
};
Trap handlers
AllocateTrap:
PUBLIC
PROC[size:
CARDINAL, type: SafeStorage.Type]
RETURNS[r: REF] = {
state: PrincOps.StateVector;
state ← STATE; -- incantation
SELECT (
IF RCMicrocodeOps.rcMicrocodeExists
THEN TrapSupport.GetTrapParam[]
ELSE 0)
FROM
0 => r ← RCMicrocodeOps.SoftwareAllocate[size, type]; -- no microcode
2 => {
-- uCode is disabled; someone is inside this monitor
p:
PROC[size:
CARDINAL, type: SafeStorage.Type] =
MACHINE CODE{PrincOps.zRET};
ZCT.Enter[];
state.dest ← LOOPHOLE[PrincOpsUtils.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
p[size, type];
};
4 => {
-- zctFull
p:
PROC[size:
CARDINAL, type: SafeStorage.Type] =
MACHINE CODE{PrincOps.zRET};
ZCT.ExpandZCT[];
state.dest ← LOOPHOLE[PrincOpsUtils.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
p[size, type];
};
6 => {
-- expandNormalFreeList
p:
PROC[size:
CARDINAL, type: SafeStorage.Type] =
MACHINE CODE{PrincOps.zRET};
ExpandNormalFreeList[sizeToBSI[size]];
state.dest ← LOOPHOLE[PrincOpsUtils.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
p[size, type];
};
ENDCASE => ERROR;
TrapSupport.BumpPC[2]; -- length of opcode
state.dest ← LOOPHOLE[PrincOpsUtils.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
};
FreeTrap:
PUBLIC
PROC[nhp: NHeaderP]
RETURNS[success:
BOOL] = {
state: PrincOps.StateVector;
state ← STATE; -- incantation
SELECT (
IF RCMicrocodeOps.rcMicrocodeExists
THEN TrapSupport.GetTrapParam[]
ELSE 0)
FROM
0 => success ← RCMicrocodeOps.SoftwareFree[nhp]; -- no microcode
2 => {
-- uCode is disabled; someone is inside this monitor
p: PROC[nhp: NHeaderP] = MACHINE CODE{PrincOps.zRET};
ZCT.Enter[];
state.dest ← LOOPHOLE[PrincOpsUtils.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
p[nhp];
};
ENDCASE => ERROR;
TrapSupport.BumpPC[2]; -- length of opcode
state.dest ← LOOPHOLE[PrincOpsUtils.MyLocalFrame[]];
TRANSFER WITH state; -- incantation
};
Support for NARROW; referent types
GetReferentType:
PUBLIC
SAFE
PROC[ref:
REF
ANY]
RETURNS[type: SafeStorage.Type] = TRUSTED{
RETURN[GetCanonicalReferentType[ref]]
};
GetCanonicalReferentType:
PUBLIC
SAFE PROC[ref:
REF
ANY]
RETURNS[type: SafeStorage.Type] = TRUSTED{
IF ref =
NIL
THEN RETURN[SafeStorage.nullType]
ELSE RETURN[REFToNHP[ref].type]
};
GetCanonicalReferentTypeTrap:
PUBLIC
PROC[ref:
REF
ANY]
RETURNS[type: SafeStorage.Type] = {
state: PrincOps.StateVector;
kludge: LONG CARDINAL;
state ← STATE; -- incantation
kludge ← 0;
type ← GetCanonicalReferentType[ref];
TrapSupport.BumpPC[2];
state.dest ← LOOPHOLE[PrincOpsUtils.MyLocalFrame[]];
TRANSFER WITH state -- incantation
};
IsReferentType:
PUBLIC
SAFE
PROC[ref:
REF
ANY, type: SafeStorage.Type]
RETURNS[BOOL] = TRUSTED {
RETURN[SafeStorage.GetCanonicalType[type] = GetCanonicalReferentType[ref]];
};
NarrowRef:
PUBLIC
SAFE
PROC[ref:
REF, type: SafeStorage.Type]
RETURNS[REF] = TRUSTED {
IF ref = NIL THEN RETURN[NIL]
ELSE IF SafeStorage.GetCanonicalType[type] = GetCanonicalReferentType[ref]
THEN RETURN[ref]
ELSE ERROR SafeStorage.NarrowRefFault[ref, type];
};
QuantumMap
StuffQMapRange:
INTERNAL
PROC[qi: QuantumIndex, qc: QuantumCount] = {
nQMapEntries ← nQMapEntries + qc;
FOR i: QuantumIndex ← qi, i+1
UNTIL i = qi + qc
DO quantumMap[i] ← TRUE ENDLOOP;
};
ClearQMapRange:
ENTRY
PROC[qi: QuantumIndex, qc: QuantumCount] = {
ENABLE UNWIND => NULL;
ClearQMapRangeInternal[qi, qc];
};
ClearQMapRangeInternal:
--INTERNAL--PROC[qi: QuantumIndex, qc: QuantumCount] = {
nQMapEntries ← nQMapEntries - qc;
FOR i: QuantumIndex ← qi, i+1
UNTIL i = qi + qc
DO quantumMap[i] ← FALSE ENDLOOP;
};
IsFullQMapRange:
ENTRY
PROC[qi: QuantumIndex, qc: QuantumCount]
RETURNS[ans: BOOL ← TRUE] = {
ENABLE UNWIND => NULL;
RETURN[IsFullQMapRangeInternal[qi, qc]]};
IsFullQMapRangeInternal:
--INTERNAL--PROC[qi: QuantumIndex, qc: QuantumCount]
RETURNS[ans: BOOL ← TRUE] = {
FOR i: QuantumIndex ← qi, i+1
UNTIL i = qi + qc
DO IF NOT quantumMap[i] THEN RETURN[FALSE] ENDLOOP;
};
IsClearQMapRange:
ENTRY
PROC[qi: QuantumIndex, qc: QuantumCount]
RETURNS[ans: BOOL ← TRUE] = {
ENABLE UNWIND => NULL;
FOR i: QuantumIndex ← qi, i+1
UNTIL i = qi + qc
DO IF quantumMap[i] THEN RETURN[FALSE] ENDLOOP;
};
NQMapEntries:
ENTRY
PROC
RETURNS[ans:
INT ← 0] = {
ENABLE UNWIND => NULL;
FOR i: QuantumIndex
IN QuantumIndex
DO IF quantumMap[i] THEN ans ← ans + 1 ENDLOOP;
};
Utilities
This is called very early in the (delicate) initialization sequence. It calls nothing.
arg is a requested block size NOT INCLUDING overhead; result is an even, quantized size that INCLUDES OVERHEAD. Requested sizes > (1100B - SIZE[NormalHeader]) require extended headers. It is not true that the difference between any two quantized sizes is a valid quantized size.
QuantizedSize:
PROC[size:
CARDINAL]
RETURNS[
INT] = {
n: NAT = SIZE[NormalHeader]; -- minimum overhead
e: NAT = SIZE[ExtendedHeader] - n; -- additional overhead for extended headers
IF checking AND size = 0 THEN ERROR;
RETURN[
SELECT size
FROM
<= 22B => ((size-1+n)/2 + 1)*2, -- 4, 6, 10B, 12B, 14B, 16B, 20B, 22B, 24B
<= 42B => ((size-1+n)/4B + 1)*4B, -- 30B, 34B, 40B, 44B
<= 106B => ((size-1+n)/10B + 1)*10B, -- 50B, 60B, 70B, 100B, 110B
<= 216B => ((size-1+n)/20B + 1)*20B, -- 120B, 140B, 160B, 200B, 220B
<= 436B => ((size-1+n)/40B + 1)*40B, -- 240B, 300B, 340B, 400B, 440B
<= 1076B => ((size-1+n)/100B + 1)*100B, -- 500B, 600B, 700B, 1000B, 1100B
requested sizes > maxSmallBlockSize (1076B) require extended headers
<= 2174B => ((size-1+n+e)/200B + 1)*200B, -- 1200B, 1400B, 1600B, 2000B, 2200B
ENDCASE => ((
LONG[size]-1+n+e)/400B + 1)*400B
steps of 400B for requested size > (2200B - SIZE[ExtendedHeader]), starting at 2400B
];
};
BlockSize:
PUBLIC PROC[hp: HeaderP]
RETURNS[
INT] = {
nhp: NHeaderP = LOOPHOLE[hp, NHeaderP];
IF nhp.blockSizeIndex = bsiEscape
THEN RETURN[ExtendedBlockSize[LOOPHOLE[hp, EHeaderP]]]
ELSE RETURN[bsiToSize[nhp.blockSizeIndex]];
};
IsExtendedBlock:
PROC[hp: HeaderP]
RETURNS[
BOOL] = {
RETURN[LOOPHOLE[hp, NHeaderP].blockSizeIndex = bsiEscape];
};
ExtendedBlockSize:
PROC[ehp: EHeaderP]
RETURNS[
INT] = {
RETURN[
SELECT ehp.sizeTag
FROM
words => LONG[ehp.extendedSize],
pages => LONG[ehp.extendedSize] * VM.wordsPerPage,
bsi => LONG[bsiToSize[ehp.extendedSize]],
ENDCASE => ERROR];
};
UsableWords:
PROC[nhp: NHeaderP]
RETURNS[
INT] = {
IF nhp.blockSizeIndex # bsiEscape
THEN RETURN[bsiToSize[nhp.blockSizeIndex] - SIZE[NormalHeader]]
ELSE RETURN[ExtendedBlockSize[NHPToEHP[nhp]] - SIZE[ExtendedHeader]];
};
IsLargeRealSize:
PROC[size:
INT]
RETURNS[
BOOL] = {
RETURN[size >= minLargeBlockRealSize];
};
IsMediumRealSize:
PROC[size:
INT]
RETURNS[
BOOL] = {
RETURN[maxSmallBlockRealSize < size AND size< minLargeBlockRealSize];
};
IsSmallRealSize:
PROC[size:
INT]
RETURNS[
BOOL] = {
RETURN[size <= maxSmallBlockRealSize];
};
IsSmallRequestedSize:
PROC[size:
CARDINAL]
RETURNS[
BOOL] = {
RETURN[size <= maxSmallBlockSize];
};
QIToLP:
PROC[qi: QuantumIndex]
RETURNS[
LONG
POINTER] = {
RETURN[LOOPHOLE[LONG[qi]*wordsPerQuantum, LONG POINTER]];
};
LPToQI:
PROC[ptr:
LONG
POINTER]
RETURNS[QuantumIndex] = {
RETURN[LOOPHOLE[ptr, LONG CARDINAL] / wordsPerQuantum];
};
QCToWords:
PROC[qc: QuantumCount]
RETURNS[
INT] = {
RETURN[LONG[qc]*wordsPerQuantum];
};
WordsToQC:
PROC[words:
INT]
RETURNS[QuantumCount] = {
RETURN[words/wordsPerQuantum];
};
QCToPages:
PROC[qc: QuantumCount]
RETURNS[
INT] = {
RETURN[LONG[qc]*pagesPerQuantum];
};
EHPToNHP:
PROC[ehp: EHeaderP]
RETURNS[NHeaderP] = {
RETURN[LOOPHOLE[ehp + SIZE[ExtendedHeader] - SIZE[NormalHeader], NHeaderP]];
};
NHPToEHP:
PROC[nhp: NHeaderP]
RETURNS[EHeaderP] = {
RETURN[LOOPHOLE[nhp + SIZE[NormalHeader] - SIZE[ExtendedHeader], EHeaderP]];
};
DFHPToNHP:
PROC[dfhp: DFHeaderP]
RETURNS[NHeaderP] = {
RETURN[LOOPHOLE[dfhp + SIZE[ExtendedHeader] - SIZE[NormalHeader], NHeaderP]];
};
Clear:
PROC[ptr:
LONG
POINTER, size:
INT] = {
WHILE size >
LAST[
CARDINAL]
DO [] ← PrincOpsUtils.
ZERO[ptr,
LAST[
CARDINAL]];
size ← size - LAST[CARDINAL];
ptr ← ptr + LAST[CARDINAL];
ENDLOOP;
[] ← PrincOpsUtils.ZERO[ptr, Basics.LowHalf[size]];
};
Lcm:
PROC[m,n:
INT]
RETURNS[
INT] = {
RETURN[(m*n)/Gcd[m,n]]};
Gcd:
PROC[m,n:
INT]
RETURNS[
INT] = {
DO
r: INT = m MOD n;
IF r = 0 THEN RETURN[n];
m ← n;
n ← r;
ENDLOOP;
};
Called from NewHeapObject, NewSystemObject and NewPermanentObject
ExpandDoubleFreeList:
PROC[realSize: INT, permanent: BOOL, varRover: LONG POINTER TO Rover, counted: BOOL] = {
qi: QuantumIndex;
qc: QuantumCount;
ehp: EHeaderP;
desired: QuantumCount = WordsToQC[Lcm[realSize, wordsPerQuantum]];
desired: smallest x s.t. realSize divides QCToWords[x]
[qi, qc] ← GetQuanta[desired: desired, needed: desired, permanent: permanent];
needed: (realSize-1)/wordsPerQuantum + 1
OR smallest x s.t. (QCToWords[x]) >= realSize
realSize ← QCToWords[qc];
ehp ← LOOPHOLE[QIToLP[qi], EHeaderP];
Clear[ehp, realSize];
ehp^ ← [extendedSize: realSize, normalHeader: [blockSizeIndex: bsiEscape]];
IF counted
THEN FreeNewMediumSizedObject[LOOPHOLE[ehp, DFHeaderP], varRover, qi, qc]
ELSE AllocatorOps.FreeMediumSizedHeapObject[LOOPHOLE[ehp, DFHeaderP]];
};
Called from CreateLargeObject, ExpandNormalFreeList, ExpandDoubleFreeList
GetQuanta:
PROC[desired, needed: QuantumCount, permanent:
BOOL ←
FALSE]
RETURNS[qi: QuantumIndex, qc: QuantumCount] = {
qc ← desired;
DO {
qi ←
VM.Allocate
[count: qc * pagesPerQuantum, alignment: logPagesPerQuantum, in64K: permanent
!
VM.CantAllocate =>
{
IF bestInterval.count >= needed * pagesPerQuantum
THEN {qc ← needed; RETRY}
ELSE GOTO noVM}
].page/pagesPerQuantum;
EXIT;
EXITS noVM => ERROR InsufficientVM;
};
ENDLOOP;
};
END: PROCEDURES
This is called long after this module is started; CODE[mumble] isn't meaningful until then
Initialize:
PUBLIC
PROC = {
systemZone ← LOOPHOLE[NewSystemObject[NIL, SIZE[ZoneObject], CODE[ZoneObject]], ZONE];
LOOPHOLE[systemZone, Zone]^ ← [new: NewSystemObject, free: FreeSystemObject];
LOOPHOLE[@PrincOps.
SD[
RTSD.sSystemZone],
POINTER
TO
LONG
POINTER]^
← LOOPHOLE[systemZone, LONG POINTER];
permanentZone
← LOOPHOLE[NEW[ZoneObject ← [new: NewPermanentObject, free: FreeSystemObject]]];
};
This is called by the TAndS
Reset:
PUBLIC
PROC = {
msRover ← @msRoot;
msRover.nextFree ← @msRoot;
msRover.prevFree ← @msRoot;
permRover ← @permRoot;
permRover.nextFree ← @permRoot;
permRover.prevFree ← @permRoot;
};
START CODE
Initialize the quantum map: needed here because ALL has a bug
FOR i: QuantumIndex IN QuantumIndex DO quantumMap[i] ← FALSE ENDLOOP;
{
--Initialize bsiToSize and sizeToBSI
oldQS: NAT ← 0;
nextBSI: BlockSizeIndex ← 0;
FOR size:
--requested-- [0..maxSmallBlockSize]
IN [0..maxSmallBlockSize]
DO
qs: NAT = QuantizedSize[IF size = 0 THEN 1 ELSE size];
IF qs # oldQS
THEN {
-- new size and bsi
IF nextBSI = bsiEscape THEN ERROR;
oldQS ← qs;
bsiToSize[nextBSI] ← qs;
nextBSI ← nextBSI + 1;
};
sizeToBSI[size] ← nextBSI - 1;
ENDLOOP;
};
The systemUZone (zhs) is now ready for use