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