-- RTZonesImpl.Mesa
-- START this after starting RTBasesImpl
-- last edited 2-Sep-81 11:14:40 by Willie-Sue Haugeland
-- last edited November 24, 1982 4:36 pm by Paul Rovner

DIRECTORY
Inline USING [LowHalf, LongNumber],
PrincOps USING [StateVector],
Process USING [Detach, GetCurrent, Yield],
RTBases USING [GetQuanta, PutQuanta, BaseOverhead, MakeAnHonestWoman],
RTBasic,
RTCommon,
RTFlags USING[checking, useMicrocode],
RTMicrocode USING [GETCANONICALREFERENTTYPE, GETREFERENTTYPE],
RTOS USING[MyLocalFrame, PermanentPageZone, FreeableSpaceZone, RegisterCedarProcess, NotifyAllocatorReady],
RTQuanta USING[QuantumSizeDIV, QuantumSizeMULT, LASTAddress, QuantumIndex,
PtrToQtmIndex, QuantumSize, QuantumCount],
RTRefCounts USING [StuffMapZiZn, StuffMapQZf, GCMicrocodeExists, StuffZi],
RTSD USING[SD, sSystemZone],
RTStorageOps USING[], -- EXPORTS only (ValidateRef, InvalidRef)
RTTypesBasic USING[Type, FinalizationQueue, NewFQ, EstablishFinalization, FQNext,
GetCanonicalType],
RTTypesBasicPrivate USING[], -- exports only
Runs,
SafeStorage,
SSExtra, -- XXX
TrapSupport USING[BumpPC],
UnsafeStorage USING[UZoneFullProc, NewUObject],
RTZones;

RTZonesImpl: MONITOR -- protects zones
LOCKS zn.LOCK USING zn: PZone
IMPORTS RTTypesBasic, RTBases, RTCommon, RTQuanta, RTRefCounts, RTMicrocode,
RTZones, SafeStorage, TrapSupport, UnsafeStorage, Inline, Runs, Process, RTOS
EXPORTS RTStorageOps, RTTypesBasic, RTTypesBasicPrivate, RTZones,
SafeStorage, SSExtra, UnsafeStorage
= BEGIN
OPEN RTTypesBasic, RTBases, RTCommon, RTQuanta, RTZones, RTBasic, SafeStorage,
UnsafeStorage, Runs;

Type: TYPE = RTTypesBasic.Type;

-- Constants
checking: BOOLEAN = RTFlags.checking;

-- Signals
InvalidRef: PUBLIC ERROR[ref: REF ANY] = CODE;
InvalidCreateZone: PUBLIC ERROR = CODE;
InvalidPointer: PUBLIC ERROR[ptr: Pointer] = CODE;
ReferentOnFreeList: SIGNAL[ptr: Pointer] = CODE;


-- System (built-in) Zones ((used only until the sun comes up))

rZnSystem: prefixed ZoneRec ←
[ new: LOOPHOLE[NewPrefixedObject, UNSPECIFIED],
free: LOOPHOLE[FreePrefixedObject, UNSPECIFIED],
zi: 1,
linkage: [collectible[fullProc: ExtendZone, base: [NIL]]],
  -- beware of RC activity and odd REFs. See the START code.
freeLists: prefixed[], LOCK: ];
znSystem: PPrefixedZone = @rZnSystem;

rZnHeapSystem: prefixed ZoneRec ←
[ new: LOOPHOLE[NewPrefixedHeapObject, UNSPECIFIED],
free: LOOPHOLE[FreePrefixedHeapObject, UNSPECIFIED],
zi: 2,
linkage: [heap[fullProc: ExtendUZone]],
freeLists: prefixed[], LOCK: ];
znHeapSystem: PPrefixedZone ← @rZnHeapSystem;


-- Exported variables

-- NOTE These variables hold eternal refs to the built-in zones
zoneSystem: PUBLIC ZONE;
zoneHeapSystem: PUBLIC UNCOUNTED ZONE;

MapQZf: PUBLIC TMapQZf;
-- MapQZf has an entry for each allocated quantum, for both counted and uncounted zones
MapZiZn: PUBLIC TMapZiZn ← NIL;
-- MapZiZn has an entry for each counted zone (but not for uncounted zones)

-- Other global variables

defaultZoneFullProc: ZoneFullProc ← ExtendZone;
defaultUZoneFullProc: UZoneFullProc ← ExtendUZone;
useCanonicalTypeMicroCode: PUBLIC BOOLEAN ← RTFlags.useMicrocode;

SizeToZn: PUBLIC REF ARRAY [0..SSExtra.maxSizeToZnIndex] OF ZONE ← NIL; -- XXX

-- XXX
QuantizedSize: PUBLIC PROC[size: CARDINAL] RETURNS[CARDINAL] =
{IF size < SIZE[free NodeHeader]-sizeNd THEN size ← SIZE[free NodeHeader]-sizeNd;
size ← SELECT size FROM
<20B => size,
<40B => ((size-1)/4B + 1)*4B,
<100B => ((size-1)/10B + 1)*10B,
<200B => ((size-1)/20B + 1)*20B,
<400B => ((size-1)/40B + 1)*40B,
ENDCASE => size;
RETURN[size];
};



-- Exported procedures (public)

-- Access to built-in Zones
GetHeapSystemZone: PUBLIC PROC RETURNS[UNCOUNTED ZONE] = {RETURN[zoneHeapSystem]};

GetSystemZone: PUBLIC SAFE PROC RETURNS[ZONE] = TRUSTED {RETURN[zoneSystem]};

GetSystemUZone: PUBLIC PROC RETURNS[UNCOUNTED ZONE] = {RETURN[zoneHeapSystem]};

NewZone: PUBLIC SAFE PROC
[ sr: SizeRepresentation ← prefixed,
base: Base ← nullBase, -- default will use RootBase
initialSize: LONG CARDINAL --words-- ← 0
] RETURNS[zone: ZONE] =
TRUSTED BEGIN
zi: ZoneIndex;

-- ************* Allocator Experiment XXX
IF SizeToZn # NIL THEN RETURN[GetSystemZone[]];
-- ************* Allocator Experiment

zi ← AllocateZi[];
IF base = nullBase THEN base ← GetRootBase[];
SELECT sr FROM
quantized =>
{ qzn: QuantizedZone =
zoneSystem.NEW[quantized ZoneRec ←
[ new: LOOPHOLE[NewQuantizedObject, UNSPECIFIED],
free: LOOPHOLE[FreeQuantizedObject, UNSPECIFIED],
linkage: [collectible[base: base, fullProc: defaultZoneFullProc]],
zi: zi, freeLists: quantized[], LOCK: ]];
AllocateAszForQzn[LOOPHOLE[qzn, PQuantizedZone]];
zone ← LOOPHOLE[qzn];
RTRefCounts.StuffZi[zi, zone]; -- the package ref
};
prefixed =>
{ pzn: PrefixedZone =
zoneSystem.NEW[prefixed ZoneRec ←
[ new: LOOPHOLE[NewPrefixedObject, UNSPECIFIED],
free: LOOPHOLE[FreePrefixedObject, UNSPECIFIED],
linkage: [collectible[base: base, fullProc: defaultZoneFullProc]],
zi: zi, freeLists: prefixed[], LOCK: ]];
InitPrefixedZone[LOOPHOLE[pzn, PPrefixedZone]];
zone ← LOOPHOLE[pzn];
RTRefCounts.StuffZi[zi, zone]; -- the package ref
};
ENDCASE => ERROR;
ExtendZone[zone, initialSize];
END;

NewUZone: PUBLIC PROC
[ initialSize: LONG CARDINAL --words-- ← 0,
sr: SizeRepresentation ← prefixed,
typeRepresentation: BOOLEAN ← FALSE
] RETURNS[UNCOUNTED ZONE] =
BEGIN
ans: UNCOUNTED ZONE;
zi: ZoneIndex = AllocateZi[];
prz: PZone;
SELECT sr FROM
quantized =>
{ qzn: PQuantizedZone =
zoneHeapSystem.NEW[quantized ZoneRec ←
[ new: LOOPHOLE[NewQuantizedHeapObject, UNSPECIFIED],
free: LOOPHOLE[FreeQuantizedHeapObject, UNSPECIFIED],
linkage: [heap[fullProc: defaultUZoneFullProc,
typeRepresentation: typeRepresentation]],
zi: zi, freeLists: quantized[], LOCK: ]];
AllocateAszForQzn[qzn];
prz ← qzn;
};
prefixed =>
{ pzn: PPrefixedZone =
zoneHeapSystem.NEW[prefixed ZoneRec ←
[ new: LOOPHOLE[NewPrefixedHeapObject, UNSPECIFIED],
free: LOOPHOLE[FreePrefixedHeapObject, UNSPECIFIED],
linkage: [heap[fullProc: defaultUZoneFullProc,
typeRepresentation: typeRepresentation]],
zi: zi, freeLists: prefixed[], LOCK: ]];
InitPrefixedZone[pzn];
prz ← pzn;
};
ENDCASE => ERROR;
ans ← LOOPHOLE[zoneHeapSystem.NEW[PZone ← prz], UNCOUNTED ZONE];
ExtendUZone[ans, initialSize];
RETURN[ans];
END;

FreeUZone: PUBLIC PROC[uz: UNCOUNTED ZONE] =
{ p: LONG POINTER TO PZone ← LOOPHOLE[uz];
prz: PZone ← p^;
FinalizeZone[prz];
zoneHeapSystem.FREE[@prz];
zoneHeapSystem.FREE[@p]};

AllocateAszForQzn: PROC[zn: PQuantizedZone] =
{ nAsz: CARDINAL = zn.mAsz+1;
asz: SubZoneArray ←
DESCRIPTOR[NewUObject[size: SIZE[SubZoneRec]*nAsz, zone: zoneHeapSystem], nAsz];
-- NOTE this may cause a collection !!

FOR i: CARDINAL IN [0..nAsz) DO
asz[i] ← [type: nullType, szi: sziVacant, zi: zn.zi, fl: NIL, size: 0];
ENDLOOP;
zn.nAsz ← 0;
zn.pAsz ← asz};

GetCanonicalReferentTypeTrap: PUBLIC PROC[ref: REF ANY] RETURNS[type: Type] =
{ state: PrincOps.StateVector;
kludge: LONG CARDINAL;

state ← STATE; -- incantation
kludge← 0;
type← GetCanonicalType[InternalReferentType[LOOPHOLE[ref]]];
TrapSupport.BumpPC[2];
state.dest ← LOOPHOLE[RTOS.MyLocalFrame[]];
TRANSFER WITH state -- incantation
};

GetReferentTypeTrap: PUBLIC PROC[ref: REF ANY] RETURNS[type: Type] =
{ state: PrincOps.StateVector;
kludge: LONG CARDINAL;

state ← STATE; -- incantation
kludge← 0;
type← InternalReferentType[LOOPHOLE[ref]];
TrapSupport.BumpPC[2];
state.dest ← LOOPHOLE[RTOS.MyLocalFrame[]];
TRANSFER WITH state -- incantation
};

GetCanonicalReferentTypeSDTrap: PUBLIC PROC[ref: REF ANY] RETURNS[type: Type] =
{RETURN[GetCanonicalType[InternalReferentType[LOOPHOLE[ref]]]]};

InternalReferentType: PROC[ptr: Pointer] RETURNS[type: Type] =
BEGIN
mz: ZoneFinger;
IF ptr = NIL THEN RETURN[nullType];
mz ← MapPtrZf[ptr];
WITH mz: mz SELECT FROM
prefixed => { IF checking THEN
{ zn: Zone = MapZiZn[mz.zi];
IF mz.zi = 0 OR ((zn # NIL) AND (zn.sr # prefixed))
THEN ERROR
ELSE IF LOOPHOLE[(ptr - sizeNd), PNode].state = free
   THEN {SIGNAL ReferentOnFreeList[ptr];
    WHILE TRUE DO Process.Yield[] ENDLOOP}};
RETURN[LOOPHOLE[LOOPHOLE[(ptr-sizeNd), InusePNode].type, Type]]};
sub => RETURN[GetSzType[mz.szi]];
ENDCASE => ERROR;
END;

IsReferentType: PUBLIC SAFE PROC[ref: REF ANY, type: Type] RETURNS[BOOLEAN] =
TRUSTED {RETURN[GetCanonicalType[type] = GetCanonicalReferentType[ref]]};

NarrowRef: PUBLIC SAFE PROC[ref: REF ANY, type: Type] RETURNS[REF ANY] =
TRUSTED {IF ref = NIL THEN RETURN[NIL]
ELSE IF GetCanonicalType[type] = GetCanonicalReferentType[ref]
THEN RETURN[ref]
ELSE ERROR NarrowRefFault[ref, type]};

GetCanonicalReferentType: PUBLIC SAFE PROC[ref: REF ANY] RETURNS[type: Type] =
TRUSTED { IF useCanonicalTypeMicroCode THEN RETURN[RTMicrocode.GETCANONICALREFERENTTYPE[ref]]
ELSE RETURN[GetCanonicalType[DoGetHeapReferentType[LOOPHOLE[ref]]]]};

GetReferentType: PUBLIC SAFE PROC[ref: REF ANY] RETURNS[type: Type] =
TRUSTED { RETURN[DoGetHeapReferentType[LOOPHOLE[ref]]]};

GetHeapReferentType: PUBLIC PROC[ptr: Pointer] RETURNS[type: Type] =
{ RETURN[DoGetHeapReferentType[ptr]]};

DoGetHeapReferentType: PROC[ptr: Pointer] RETURNS[type: Type] =
INLINE BEGIN
mz: ZoneFinger;
IF useCanonicalTypeMicroCode THEN RETURN[RTMicrocode.GETREFERENTTYPE[LOOPHOLE[ptr]]];
IF ptr = NIL THEN RETURN[nullType];
mz ← MapPtrZf[ptr];
WITH mz: mz SELECT FROM
prefixed => { IF checking THEN
{ zn: Zone = MapZiZn[mz.zi];
IF mz.zi = 0 OR ((zn # NIL) AND (zn.sr # prefixed))
   THEN ERROR
ELSE IF LOOPHOLE[(ptr - sizeNd), PNode].state = free
   THEN {SIGNAL ReferentOnFreeList[ptr];
    WHILE TRUE DO Process.Yield[] ENDLOOP}};
RETURN[LOOPHOLE[LOOPHOLE[(ptr-sizeNd), InusePNode].type, Type]]};
sub => RETURN[GetSzType[mz.szi]];
ENDCASE => ERROR;
END;

SetZoneFullProc: PUBLIC SAFE PROC[zone: ZONE, proc: ZoneFullProc] RETURNS[oldProc: ZoneFullProc] =
TRUSTED {RETURN[DoSetZoneFullProc[LOOPHOLE[zone], proc]]};

DoSetZoneFullProc: ENTRY PROC[zn: PZone, proc: ZoneFullProc] RETURNS[oldProc: ZoneFullProc] =
{ENABLE UNWIND => NULL;
WITH zl: zn.linkage SELECT FROM
collectible => {oldProc ← zl.fullProc; zl.fullProc ← proc};
ENDCASE => ERROR};

ExtendZone: PUBLIC ZoneFullProc =
TRUSTED { nQ: QuantumCount = MapSizeNq[size];
zn: Zone = LOOPHOLE[zone];
qNew: QuantumIndex;
firstQuantum: BOOLEAN;
[qNew, firstQuantum] ← GetQuanta[LOOPHOLE[zn.linkage, collectible ZoneLinkage].base, nQ];
ExtendZoneWithQuanta[LOOPHOLE[zn], qNew, nQ, firstQuantum]};

SetUZoneFullProc: PUBLIC PROC[zone: UNCOUNTED ZONE, proc: UZoneFullProc]
RETURNS[oldProc: UZoneFullProc] =
{RETURN[DoSetUZoneFullProc[LOOPHOLE[zone], proc]]};

DoSetUZoneFullProc: ENTRY PROC[zn: PZone, proc: UZoneFullProc] RETURNS[oldProc: UZoneFullProc] =
{ENABLE UNWIND => NULL;
WITH zl: zn.linkage SELECT FROM
heap => {oldProc ← zl.fullProc; zl.fullProc ← proc};
ENDCASE => ERROR};

ExtendUZone: PUBLIC UZoneFullProc =
{ nQ: QuantumCount = MapSizeNq[size];
zn: PZone = LOOPHOLE[zone, LONG POINTER TO PZone]^;
qNew: QuantumIndex;
firstQuantum: BOOLEAN;
[qNew, firstQuantum] ← GetQuanta[GetRootBase[], nQ];
ExtendZoneWithQuanta[zn, qNew, nQ, firstQuantum]};

ExtendZoneWithQuanta: ENTRY PROC
[zn: PZone, qNew: QuantumIndex, nQ: QuantumCount, firstQuantum: BOOLEAN] =
BEGIN ENABLE UNWIND => NULL;
IF firstQuantum THEN zn.qFirst ← qNew;
WITH zn: zn SELECT FROM
quantized =>
{ IF zn.qNext # 0 THEN ReturnQuanta[LOOPHOLE[@zn, PQuantizedZone], zn.qNext, zn.qLast - zn.qNext];
zn.qNext ← qNew;
zn.qLast ← qNew + nQ};
prefixed =>
{ overhead: CARDINAL = IF firstQuantum THEN BaseOverhead ELSE 0;
FOR q: QuantumIndex IN [qNew..qNew + nQ) DO MapQZf[q] ← [prefixed[zn.zi]]; ENDLOOP;
AddBlock[ RepAddrPtr[QuantumSizeMULT[qNew] + overhead],
QuantumSizeMULT[nQ] - overhead,
zn.pfn --@zn.fnd--]};
ENDCASE => ERROR;
AddInterval[@zn.runs, qNew, nQ];
END;

-- Exported procedures (within GC only)

-- prefixedly an INTERNAL proccedure
ReturnQuanta: PUBLIC PROC[pzn: PZone, q: QuantumIndex, nQ: QuantumCount] =
{ FOR i: QuantumIndex IN [q..q + nQ) DO MapQZf[i] ← mzVacant; ENDLOOP;
DeleteInterval[@pzn.runs, q, nQ];
IF pzn.qFirst IN [q..CARDINAL[q + nQ]) THEN pzn.qFirst ← 0;
WITH zl: pzn.linkage SELECT FROM
collectible => PutQuanta[zl.base, q, nQ];
heap => PutQuanta[GetRootBase[], q, nQ]
ENDCASE => ERROR};


-- PRIVATE procedures

InitPrefixedZone: PROC[zn: PPrefixedZone] = {zn.fnd.pfnNext ← zn.fnd.pfnPrev ← zn.pfn ← @zn.fnd};

ZoneResidueWords: PROC[zn: PZone] RETURNS[LONG CARDINAL] =
{ nWords: LONG CARDINAL ← 0;
IF zn.qFirst # 0 THEN nWords ← nWords + BaseOverhead;

WITH zn: zn SELECT FROM
quantized =>
{ qf: QuantumIndex = zn.qFirst; -- nonsense, bound variant bug in compiler
AccumulateResidues: PROC[iFrom, n: RunValue] =
{ q: QuantumIndex ← iFrom;
DO
ovhd: CARDINAL = (IF qf = q THEN BaseOverhead ELSE 0);
blockSize: LONG CARDINAL;
qSize: LONG CARDINAL;
nQ: QuantumCount;

IF q IN [zn.qNext..zn.qLast) THEN LOOP;
WITH mz: MapQZf[q] SELECT FROM
sub => {blockSize ← GetSzSize[mz.szi];
IF ovhd = 0 THEN nQ ← QuantumSizeDIV[blockSize + QuantumSize - 1]
ELSE nQ ← MapSizeNq[blockSize]};
ENDCASE => ERROR;
qSize ← QuantumSizeMULT[nQ] - ovhd;

nWords ← nWords + (qSize MOD blockSize);
q ← q + nQ;
IF q = iFrom + n THEN EXIT;
ENDLOOP;
};
MapIntervals[@zn.runs, AccumulateResidues];
};
ENDCASE;
RETURN[nWords]};

ZoneFreeWords: PROC[zn: PZone] RETURNS[LONG CARDINAL] =
{ nWords: LONG CARDINAL ← 0;
WITH zn: zn SELECT FROM
quantized =>
{ asz: SubZoneArray = zn.pAsz;
FOR i: CARDINAL IN [0..zn.mAsz] DO
sz: SubZone = @asz[i];
IF IsSubZoneVacant[sz] THEN LOOP;
FOR fl: FreeList ← sz.fl, fl^ UNTIL fl = NIL DO nWords ← nWords + sz.size; ENDLOOP;
ENDLOOP;
nWords ← nWords + QuantumSizeMULT[ShortenLongCardinal[zn.qLast - zn.qNext]]};
prefixed =>
{ pfn: PFreeNode ← zn.pfn;
DO
nWords ← nWords + NodeLength[pfn];
IF (pfn ← pfn.pfnNext) = zn.pfn THEN EXIT;
ENDLOOP};
ENDCASE => ERROR;
RETURN[nWords]};

ZoneFreeQuanta: PROC[zn: PZone] RETURNS[nQuanta: LONG CARDINAL] =
{RETURN[WITH zn: zn SELECT FROM
quantized => zn.qLast - zn.qNext,
prefixed => 0,
ENDCASE => ERROR]};

ZoneFreeObjects: PROC[zn: PZone] RETURNS[nObjects: LONG CARDINAL] =
{ nObjects ← 0;
WITH zn: zn SELECT FROM
quantized =>
{ asz: SubZoneArray = zn.pAsz;
FOR i: CARDINAL IN [0..zn.mAsz] DO
sz: SubZone = @asz[i];
IF IsSubZoneVacant[sz] THEN LOOP;
FOR fl: FreeList ← sz.fl, fl^ UNTIL fl = NIL DO nObjects ← nObjects + 1; ENDLOOP;
ENDLOOP};
prefixed =>
{ pfn: PFreeNode ← zn.pfn;
DO
nObjects ← nObjects + 1;
IF (pfn ← pfn.pfnNext) = zn.pfn THEN EXIT;
ENDLOOP};
ENDCASE => ERROR;
RETURN[nObjects]};

-- NOTE this is not an ENTRY proc!! It is meant to be called while debugging.
-- cellsInService includes overhead cells and 1 word for the type code in prefix objects
-- overheadCells is applicable for prefixed zones, residueCells for quantized zones
-- overheadCells is one word for small objects, 2 for big ones and does not include 1 word for
-- the type code in prefix objects
SummarizeZone: PUBLIC PROC[zn: PZone]
RETURNS[nQuanta, freeQuanta, objectsInService, overheadCells, freeObjects,
cellsInService, freeCells, residueCells: LONG CARDINAL] =
{ CountQuanta: PROC[iFrom, n: RunValue] ={ nQuanta ← nQuanta + n};

nQuanta ← 0;
MapIntervals[@zn.runs, CountQuanta];
freeQuanta ← ZoneFreeQuanta[zn];
objectsInService ← zn.objectsInService;
overheadCells ← zn.overheadCells;
freeObjects ← ZoneFreeObjects[zn];
cellsInService ← zn.cellsInService;
freeCells ← ZoneFreeWords[zn];
residueCells ← ZoneResidueWords[zn]};

IsZoneEmpty: PUBLIC SAFE PROC[zone: ZONE] RETURNS[BOOLEAN] =
TRUSTED {RETURN[DoIsZoneEmpty[LOOPHOLE[zone]]]};

DoIsZoneEmpty: ENTRY PROC[zn: PZone] RETURNS[BOOLEAN] =
BEGIN ENABLE UNWIND => NULL;
nq: CARDINAL ← 0;
CountQuanta: PROC[iFrom, n: RunValue] = {nq ← nq + n};

MapIntervals[@zn.runs, CountQuanta];
RETURN[(ZoneFreeWords[zn] + ZoneResidueWords[zn]) = QuantumSizeMULT[nq]];
END;

IsUZoneEmpty: PUBLIC PROC[zone: UNCOUNTED ZONE] RETURNS[BOOLEAN] =
{RETURN[DoIsZoneEmpty[LOOPHOLE[zone, LONG POINTER TO PZone]^]]};

ZoneFinalizerProcess: PROC[zfq: FinalizationQueue] =
{ DO
zone: ZONE = LOOPHOLE[FQNext[zfq]]; -- NOTE
IF LOOPHOLE[zone, Zone].zi < 2 THEN ERROR; -- NOTE SetZiNext[3]
TrimZone[zone];
IF IsZoneEmpty[zone] THEN FinalizeZone[LOOPHOLE[zone, PZone]];
ENDLOOP};

FinalizeZone: ENTRY PROC[zn: PZone] =
BEGIN ENABLE UNWIND => NULL;
FreeQRun: PROC[iFrom, n: CARDINAL] = -- should be qFirst, nQ
{ReturnQuanta[zn, iFrom, n]};

MapIntervals[@zn.runs, FreeQRun];
WITH zn: zn SELECT FROM
quantized => -- free the subzones
{ lp: LONG POINTER ← BASE[zn.pAsz];
FOR i: CARDINAL IN [0..zn.mAsz] DO
sz: SubZone = @zn.pAsz[i];
IF NOT IsSubZoneVacant[sz] THEN AssignSz[sz.szi, NIL];
ENDLOOP;
zoneHeapSystem.FREE[@lp]};
ENDCASE;
MapZiZn[zn.zi] ← NIL; -- kill the package ref
END;

Pair: TYPE = MACHINE DEPENDENT RECORD [low, high: CARDINAL];
MaxBank: CARDINAL = LOOPHOLE[RTQuanta.LASTAddress/(LONG[LAST[CARDINAL]] + 1),
Inline.LongNumber].lowbits; --63
ValidateRef: PUBLIC PROC [ref: REF ANY] = {
-- returns happily if the pointer refers to the start of an object

-- A ref to someplace in a quantized zone points at the start of
-- an object if the ref has the correct modulus with respect to
-- the size of the objects in the appropriate sub-zone. This must
-- be adjusted for BaseOverhead if the quantum is the one indicated
-- by zone.qFirst.

-- for a prefixed zone, gotta scan the run that contains the referenced object.

IF ref = NIL THEN RETURN; -- NIL is OK

IF (LOOPHOLE[ref, LONG CARDINAL] MOD 2 = 1)
OR (LOOPHOLE[ref, Pair].high > MaxBank)
THEN ERROR InvalidRef[ref];

{qx: RTQuanta.QuantumIndex = RTQuanta.PtrToQtmIndex[LOOPHOLE[ref, LONG POINTER]];
mz: ZoneFinger = MapQZf[qx];
IF mz = mzVacant THEN ERROR InvalidRef[ref]; -- not even in the quantum map
WITH mz: mz SELECT FROM
sub => {sz: CARDINAL = GetSzSize[mz.szi];
rz: Zone = MapZiZn[GetSzZi[mz.szi]];
lc: CARDINAL ← CARDINAL[Inline.LowHalf[ref]] MOD RTQuanta.QuantumSize;

IF rz = NIL THEN ERROR InvalidRef[ref];
IF checking AND rz.linkage.tag # collectible THEN ERROR;
IF qx = rz.qFirst THEN
{IF lc < RTBases.BaseOverhead THEN ERROR InvalidRef[ref];
lc ← lc - RTBases.BaseOverhead};
IF sz > RTQuanta.QuantumSize THEN ERROR;
IF lc MOD sz # 0 THEN ERROR InvalidRef[ref]};
prefixed => ValidatePrefixedRef[zn: LOOPHOLE[MapZiZn[mz.zi], PZone], ref: ref];
ENDCASE => ERROR}};

ValidatePrefixedRef: ENTRY PROC [zn: PZone, ref: REF ANY] =
{ ENABLE UNWIND => NULL;
ptr: LONG POINTER = LOOPHOLE[ref];
WITH z: zn SELECT FROM
prefixed =>
{-- look at all of the objects, both allocated and freed
FOR r: Runs.Run ← z.runs, r.rnNext UNTIL r = NIL DO
lim: PNode = LOOPHOLE[LONG[r.iTo] * RTQuanta.QuantumSize]; -- iTo not included
pNode: PNode ← LOOPHOLE[LONG[r.iFrom] * RTQuanta.QuantumSize];
IF LOOPHOLE[ptr, LONG CARDINAL] >= LOOPHOLE[pNode, LONG CARDINAL]
  AND LOOPHOLE[ptr, LONG CARDINAL] < LOOPHOLE[lim, LONG CARDINAL]
  THEN -- this is the run in which we should find the ref
  {WHILE pNode # lim DO -- look at each object in the run
size: LONG CARDINAL = NodeLength[pNode];
IF pNode.state # free AND ptr = pNode + sizeNd THEN RETURN;
  pNode ← pNode + size;
   IF LOOPHOLE[ptr, LONG CARDINAL] < LOOPHOLE[pNode, LONG CARDINAL]
   THEN ERROR InvalidRef[ref];
ENDLOOP;
  ERROR};
ENDLOOP;
  ERROR InvalidRef[ref]};
ENDCASE => ERROR};



-- MODULE INITIALIZATION ... this is extremely delicate

LOOPHOLE[LOOPHOLE[znSystem.linkage, collectible ZoneLinkage].base, Pointer] ← LOOPHOLE[GetRootBase[]];

SetZiNext[3]; -- 0: zoneVacant, 1: zoneSystem, 2: zoneHeapSystem, NOTE ZoneFinalizerProcess, TandS

BEGIN
nQ: CARDINAL = LAST[QuantumIndex] - FIRST[QuantumIndex] + 1;
MapQZf ← LOOPHOLE[RTOS.PermanentPageZone.NEW[RMapQZf[nQ]]];
FOR i: CARDINAL IN [0..nQ) DO MapQZf[i] ← mzVacant ENDLOOP;
RTRefCounts.StuffMapQZf[MapQZf];
END;
useCanonicalTypeMicroCode ← useCanonicalTypeMicroCode AND RTRefCounts.GCMicrocodeExists;

InitPrefixedZone[LOOPHOLE[znSystem, PPrefixedZone]];
InitPrefixedZone[LOOPHOLE[znHeapSystem, PPrefixedZone]];

-- ******Until the sun comes up*******
LOOPHOLE[zoneSystem, Pointer] ← znSystem;
LOOPHOLE[zoneHeapSystem, Pointer] ← @znHeapSystem;

LOOPHOLE[MapZiZn, Pointer] ← RTOS.FreeableSpaceZone.NEW[PMapZiZn[nZiMaxInit] ← [zones: NULL]];
FOR i: CARDINAL IN [0..nZiMaxInit) DO LOOPHOLE[MapZiZn, LONG POINTER TO PMapZiZn][i] ← 0 ENDLOOP;

LOOPHOLE[MapZiZn[rZnSystem.zi], Pointer] ← znSystem;
RTRefCounts.StuffMapZiZn[LOOPHOLE[MapZiZn, LONG POINTER TO PMapZiZn]];
-- ******Until the sun comes up*******

LOOPHOLE[@RTSD.SD[RTSD.sSystemZone], POINTER TO LONG POINTER]^
← LOOPHOLE[zoneSystem, LONG POINTER];
RTOS.NotifyAllocatorReady[]; -- the allocator is now useable
RTOS.RegisterCedarProcess[LOOPHOLE[Process.GetCurrent[]]];
{ zfq: FinalizationQueue = NewFQ[];
EstablishFinalization[CODE[ZoneRec], 1, zfq];
Process.Detach[FORK ZoneFinalizerProcess[zfq]];
};

RTBases.MakeAnHonestWoman[];

{ oldZs: PrefixedZone = LOOPHOLE[zoneSystem];
zs: PrefixedZone =
NEW[prefixed ZoneRec ←
[ new: oldZs.new,
free: oldZs.free,
zi: oldZs.zi,
linkage: [collectible[fullProc: ExtendZone, base: GetRootBase[]]],
qFirst: oldZs.qFirst,
runs: oldZs.runs,
cellsInService: oldZs.cellsInService,
objectsInService: oldZs.objectsInService,
overheadCells: oldZs.overheadCells,
freeLists: prefixed[], LOCK: ]
];
InitPrefixedZone[LOOPHOLE[zs, PPrefixedZone]];

IF oldZs.fnd.pfnNext # @oldZs.fnd THEN
{ zs.fnd.pfnNext ← oldZs.fnd.pfnNext;
oldZs.fnd.pfnNext.pfnPrev ← @zs.fnd;
zs.fnd.pfnPrev ← oldZs.fnd.pfnPrev;
oldZs.fnd.pfnPrev.pfnNext ← @zs.fnd
};

LOOPHOLE[zoneSystem, Pointer] ← NIL;
zoneSystem ← LOOPHOLE[zs]; -- NOTE stuff this in the SD!!
LOOPHOLE[@RTSD.SD[RTSD.sSystemZone], POINTER TO LONG POINTER]^
← LOOPHOLE[zoneSystem, LONG POINTER];
};

{ mzizn: TMapZiZn = NEW[RMapZiZn[nZiMaxInit] ← [zones: NULL]];
p: LONG POINTER ← LOOPHOLE[MapZiZn];
FOR i: CARDINAL IN [0..nZiMaxInit) DO LOOPHOLE[mzizn, LONG POINTER TO PMapZiZn][i] ← 0 ENDLOOP;
LOOPHOLE[MapZiZn, Pointer] ← NIL;
MapZiZn ← mzizn;
MapZiZn[LOOPHOLE[zoneSystem, Zone].zi] ← LOOPHOLE[zoneSystem, Zone];
RTOS.FreeableSpaceZone.FREE[@p];
RTRefCounts.StuffMapZiZn[LOOPHOLE[MapZiZn, LONG POINTER TO PMapZiZn]];
};

LOOPHOLE[LOOPHOLE[znSystem.linkage, collectible ZoneLinkage].base, Pointer] ← NIL;

-- XXX
IF SSExtra.useSizeToZn THEN
{stz: REF ARRAY [0..SSExtra.maxSizeToZnIndex] OF ZONE
= NEW[ARRAY [0..SSExtra.maxSizeToZnIndex] OF ZONE ← ALL[NIL]];
FOR i: [0..SSExtra.maxSizeToZnIndex/2] IN [0..SSExtra.maxSizeToZnIndex/2]
DO IF stz[QuantizedSize[i*2]] = NIL THEN stz[QuantizedSize[i*2]] ← NewZone[];
ENDLOOP;
SizeToZn ← stz; -- subsequent calls on the prefixed allocator for any ZONE will use this stuff
};

END.