-- RTTraceAndSweepImpl.mesa -- last change by Russ Atkinson, 17-Jul-81 12:23:33 -- last change by Willie-Sue Haugeland, 31-Jul-81 13:40:47 -- last change by Paul Rovner, November 29, 1982 5:42 pm -- This module implements a trace-and-sweep garbage collector for -- Cedar ("DoTraceAndSweepCollection"). It uses auxilliary storage for bit tables -- and reference stacks. To allow subsequent incremental collection, -- DoTraceAndSweepCollection restores reference counts to correct values. -- No collectible storage is allocated while DoTraceAndSweepCollection -- is active, nor are any REFs change in counted storage during -- that time. Client processes that attempt to do so are suspended -- until after DoTraceAndSweepCollection finishes. DIRECTORY Environment: TYPE USING [wordsPerPage], Inline: TYPE USING [LowHalf, LongNumber], Mopcodes: TYPE USING [zAND, zLIB], PilotLoadStateOps: TYPE USING [InputLoadState, ReleaseLoadState], PrincOps: TYPE USING [CSegPrefix, GlobalFrame, GlobalFrameHandle, MainBodyIndex], Process: TYPE USING [Yield], ProcessOperations: TYPE USING [LongEnter, LongExit], RCMap: TYPE USING [nullIndex], RTBases: TYPE USING [BaseOverhead], RTBasic: TYPE USING [Address, Pointer, nullType], RTCommon: TYPE USING [ShortenLongCardinal], RTFlags: TYPE USING [checking, clearing, takingStatistics], RTLoader: TYPE USING [GetGFRCType], RTMicrocode: TYPE USING [RTMOVESTATUS, LONGZERO], RTOS: TYPE USING [EnumerateGlobalFrames, MapRCFrameBodies, SnapshotTheFrameHeap, FreeableSpaceZone, GetDataPagesFromNewSpace, GetCurrent, FrameCopySpaceTooSmall, AllocateFrameBodyBuffer], RTQuanta: TYPE USING [QuantumIndex, QuantumSize, PtrToQtmIndex, LASTAddress], RTRefCounts: TYPE USING [ClearRCTable, DecrementReferenceCount, nWordsReclaimed, IncrementReferenceCount, GCState, gcStopped, gcRunning, nObjectsReclaimed, frameBodyBufferPages], RTStorageOps: TYPE USING [OutOfOverflowTable], RTTypesBasic: TYPE USING [Type, GetReferentType], RTTypesBasicPrivate: TYPE USING [MapTiRcmx, MapRefs, NPackageRefs], Runs: TYPE USING [Run], RTZones: TYPE USING [GetSzSize, GetSzZi, PZone, SubZone, PFreeNode, FromCollectibleZone, ZoneFinger, MapQZf, MapPtrZf, mzVacant, PNode, MapSziSz, PPrefixedZone, MapZiZn, InusePNode, NodeLength, Zone, SubZoneArray, FreeList, sizeNd, ZoneIndex]; RTTraceAndSweepImpl: MONITOR IMPORTS Inline, PilotLoadStateOps, Process, ProcessOperations, RTCommon, RTLoader, RTMicrocode, RTOS, RTQuanta, RTRefCounts, RTStorageOps, RTTypesBasic, RTTypesBasicPrivate, RTZones EXPORTS RTRefCounts = BEGIN OPEN Environment, RTZones, RTMicrocode; -- Variables traceAndSweepEnabled: BOOLEAN _ TRUE; countingOn: BOOLEAN _ TRUE; quantizedCellsInitiallyFreed: LONG CARDINAL; quantizedObjectsInitiallyFreed: LONG CARDINAL _ 0; refStackChain: RefStack _ NIL; refStackFree: RefStack _ NIL; -- interesting statistics prefixedObjectsMarkedFree: LONG CARDINAL _ 0; prefixedObjectsReclaimed: LONG CARDINAL _ 0; prefixedObjectsKept: LONG CARDINAL _ 0; quantizedObjectsReclaimed: LONG CARDINAL _ 0; quantizedObjectsKept: LONG CARDINAL _ 0; nGlobalFrames: LONG CARDINAL _ 0; nLocalFrames: LONG CARDINAL _ 0; quantizedObjectsSeen: LONG CARDINAL _ 0; prefixedObjectsSeen: LONG CARDINAL _ 0; BankTableArray: TYPE = ARRAY [0..MaxBank] OF BankTablePtr; bankTableArray: LONG POINTER TO BankTableArray _ RTOS.FreeableSpaceZone.NEW[BankTableArray _ ALL[NIL]]; -- debugging aids SuspectSeen: SIGNAL = CODE; suspect: LONG POINTER TO UNSPECIFIED _ LOOPHOLE[LONG[-1]]; BadObjectStart: ERROR = CODE; checkMarkRef: BOOLEAN _ FALSE; checkTraceObject: BOOLEAN _ FALSE; bugRefs: CARDINAL _ 0; bugRefArray: ARRAY [0..8) OF ParsedRef _ ALL[ParsedRef[word: 1, prefixed: TRUE, pad: 0, bank: 0]]; BugRefFound: SIGNAL = CODE; SignalBugRefFound: PROC = { SIGNAL BugRefFound}; CheckBugRef: PROC [pr: ParsedRef] = { FOR i: CARDINAL IN [0..bugRefs) DO npr: ParsedRef _ bugRefArray[i]; IF pr.word = npr.word AND pr.bank = npr.bank THEN SignalBugRefFound[ ! UNWIND => CONTINUE ]; ENDLOOP}; -- TYPEs and constants ParsedNil: ParsedRef = [word: 0, prefixed: FALSE, pad: 0, bank: 0]; BankTableSize: CARDINAL = 4096; -- words (2^bitsPerWord / bitsPerWord) BankTablePages: CARDINAL = BankTableSize / wordsPerPage; -- 16 MaxBank: CARDINAL = LOOPHOLE[RTQuanta.LASTAddress/(LONG[LAST[CARDINAL]] + 1), Inline.LongNumber].lowbits; --63 ParsedRef: TYPE = MACHINE DEPENDENT RECORD [word (0): CARDINAL, prefixed (1: 0..0): BOOLEAN, pad (1: 1..7): [0..63], bank (1: 8..15): [0..255]]; BankTable: TYPE = PACKED ARRAY CARDINAL OF BOOLEAN; BankTablePtr: TYPE = LONG POINTER TO BankTable; Pair: TYPE = MACHINE DEPENDENT RECORD [low, high: CARDINAL]; PhonyTable: TYPE = ARRAY INTEGER [0..BankTableSize) OF CARDINAL; PhonyTablePtr: TYPE = LONG POINTER TO PhonyTable; RefStackRep: TYPE = RECORD [next: RefStack, size, max: CARDINAL, refs: SEQUENCE COMPUTED CARDINAL OF ParsedRef]; RefStack: TYPE = LONG POINTER TO RefStackRep; BadAddress: ERROR = CODE; -- PROCS IncRC: PROC [ref: REF ANY] = INLINE {IF countingOn THEN RTRefCounts.IncrementReferenceCount [ref ! RTStorageOps.OutOfOverflowTable => {countingOn _ FALSE; CONTINUE}]}; DecRC: PROC [ref: REF ANY] = INLINE {IF countingOn THEN RTRefCounts.DecrementReferenceCount [ref ! RTStorageOps.OutOfOverflowTable => {countingOn _ FALSE; CONTINUE}]}; -- local space management NewPages: PROC [pages: CARDINAL] RETURNS [LONG POINTER] = { RETURN [RTOS.GetDataPagesFromNewSpace[pages]]}; FreePages: PROC [ptr: LONG POINTER] = { RTOS.FreeableSpaceZone.FREE[@ptr]}; IsTraceAndSweepEnabled: PUBLIC PROC RETURNS [BOOLEAN] = { RETURN[traceAndSweepEnabled]}; StuffZi: PUBLIC ENTRY PROC[zi: ZoneIndex, zone: ZONE] = {ENABLE UNWIND => NULL; z: REF ANY _ LOOPHOLE[zone]; MapZiZn[zi] _ NARROW[z]}; SuspendClientRCActivity: PROC = {-- set the microcode to trap on any RC activity in any process other than this one RTRefCounts.GCState.GCStateBasic.collector _ LOOPHOLE[RTOS.GetCurrent[]]; RTRefCounts.GCState.GCStateBasic.reclaimState _ RTRefCounts.gcStopped; [] _ RTMOVESTATUS[toMemory, 0]; }; ResumeClientRCActivity: PROC[countingOn: BOOL] = {IF countingOn -- else reference counting will be disabled THEN RTRefCounts.GCState.GCStateBasic.reclaimState _ RTRefCounts.gcRunning; RTRefCounts.GCState.GCStateBasic.collector _ NIL; [] _ RTMOVESTATUS[toMemory, 0]; }; -- this is really an INTERNAL procedure of the collector's monitor (RTRefCountsImpl) DoTraceAndSweepCollection: PUBLIC ENTRY PROC = { ENABLE UNWIND => NULL; -- acquire the lock on the runtime loader (REFs in GF's are counted) [] _ PilotLoadStateOps.InputLoadState[]; -- Acquire all ZONE locks. New ZONE creation is not a problem because the first -- ZONE lock acquired is for the system ZONE, and NewZone won't stuff MapZiZn -- while the TandS is active. FOR zi: CARDINAL IN [0..MapZiZn.length) DO zone: Zone _ MapZiZn[zi]; IF zone = NIL THEN LOOP; IF zone.linkage.tag # collectible THEN LOOP; UNTIL ProcessOperations.LongEnter[@zone.LOCK] DO Process.Yield[]; ENDLOOP; ENDLOOP; SuspendClientRCActivity[]; RTRefCounts.ClearRCTable[]; -- set start bits for prefixed objects and clear quantized free lists quantizedCellsInitiallyFreed _ quantizedObjectsInitiallyFreed _ 0; FOR zi: CARDINAL IN [0..MapZiZn.length) DO zone: Zone _ MapZiZn[zi]; IF zone = NIL THEN LOOP; IF zone.linkage.tag # collectible THEN LOOP; WITH z: zone SELECT FROM quantized => {sza: SubZoneArray _ z.pAsz; FOR i: CARDINAL IN [0..LENGTH[sza]) DO size: CARDINAL = sza[i].size; fl: FreeList _ sza[i].fl; WHILE fl # NIL DO next: FreeList _ fl^; IF RTFlags.checking AND NOT ObjectStart[LOOPHOLE[fl]] THEN ERROR; [] _ LONGZERO[fl, SIZE[FreeList]]; quantizedObjectsInitiallyFreed _ quantizedObjectsInitiallyFreed + 1; quantizedCellsInitiallyFreed _ quantizedCellsInitiallyFreed + size; fl _ next; ENDLOOP; sza[i].fl _ NIL; ENDLOOP}; prefixed => -- parse the prefixed zone, set object (start) bit for non-free object {InitPrefixedObject: PROC [pref: ParsedRef] = {SetObjectBit[ParsedRefToPointer[pref]]}; ObjectsInPrefixedZone[zone, InitPrefixedObject]}; ENDCASE => ERROR ENDLOOP; -- trace from all local and global frames in the world IF RTFlags.takingStatistics THEN nGlobalFrames _ nLocalFrames _ 0; DO { RTOS.SnapshotTheFrameHeap[ ! RTOS.FrameCopySpaceTooSmall => GOTO expandFCS]; EXIT; EXITS expandFCS => RTOS.AllocateFrameBodyBuffer[RTRefCounts.frameBodyBufferPages _ RTRefCounts.frameBodyBufferPages+1]; } ENDLOOP; RTOS.MapRCFrameBodies[TraceLocalFrame]; [] _ RTOS.EnumerateGlobalFrames[TraceGlobalFrame]; -- continue marking from the ref stack and from objects UNTIL EmptyRefStack[] DO TraceRefsInObject[PopRef[]] ENDLOOP; -- free the space for ref stacks FreeRefStacks[]; -- free the objects -- initialize consistency counters IF RTFlags.takingStatistics THEN prefixedObjectsMarkedFree _ prefixedObjectsSeen _ prefixedObjectsKept _ prefixedObjectsReclaimed _ quantizedObjectsSeen _ quantizedObjectsKept _ quantizedObjectsReclaimed _ 0; FOR zi: CARDINAL IN [0..MapZiZn.length) DO zone: Zone _ MapZiZn[zi]; IF zone = NIL THEN LOOP; IF zone.linkage.tag # collectible THEN LOOP; WITH z: zone SELECT FROM quantized => ObjectsInQuantizedZone[zone, VisitOneObject]; prefixed => ObjectsInPrefixedZone [zone, VisitOneObject]; ENDCASE => ERROR ENDLOOP; RTRefCounts.nObjectsReclaimed _ RTRefCounts.nObjectsReclaimed - quantizedObjectsInitiallyFreed; RTRefCounts.nWordsReclaimed _ RTRefCounts.nWordsReclaimed - quantizedCellsInitiallyFreed; -- check for consistency IF RTFlags.takingStatistics AND RTFlags.checking THEN {IF prefixedObjectsMarkedFree + prefixedObjectsReclaimed + prefixedObjectsKept # prefixedObjectsSeen OR quantizedObjectsKept + quantizedObjectsReclaimed # quantizedObjectsSeen THEN ERROR}; FreeAllObjectBits[]; ResumeClientRCActivity[countingOn]; -- release all the ZONE locks FOR zi: CARDINAL IN [0..MapZiZn.length) DO zone: Zone _ MapZiZn[zi]; IF zone = NIL THEN LOOP; ProcessOperations.LongExit[@zone.LOCK] ENDLOOP; -- release the loader's lock PilotLoadStateOps.ReleaseLoadState[]; RETURN; -- exiting the collector's monitor will unwedge reference-counting clients }; -- this is called once for each valid REF found in counted storage -- (this includes reconstructing the RC for the object) MarkRef: PROC [pref: ParsedRef] = INLINE { ref: REF ANY = UnParseRef[pref]; IF Marked[pref] THEN {IncRC[ref]; RETURN}; -- here if this REF is valid and not seen before -- finalization: get the type, the package count, and -- establish the correct initial RC (+1!) FOR i: CARDINAL IN [1..RTTypesBasicPrivate.NPackageRefs[RTTypesBasic.GetReferentType[ref]]] DO DecRC[ref] ENDLOOP; SetMark[pref]; IF checkMarkRef THEN CheckBugRef[pref]; IF NOT RefContaining[pref] THEN RETURN; PushRef[pref]}; -- the following proc will clear the mark bit for a ref -- and free the object if it was unmarked VisitOneObject: PROC [pref: ParsedRef] = { IF NOT ObjectStart[ParsedRefToPointer[pref]] THEN ERROR; IF Marked[pref] THEN {IF pref.prefixed THEN {IF RTFlags.takingStatistics THEN prefixedObjectsKept _ prefixedObjectsKept + 1; ClearMark[pref]} ELSE IF RTFlags.takingStatistics THEN quantizedObjectsKept _ quantizedObjectsKept + 1} ELSE {IF RTFlags.takingStatistics THEN IF pref.prefixed THEN prefixedObjectsReclaimed _ prefixedObjectsReclaimed + 1 ELSE quantizedObjectsReclaimed _ quantizedObjectsReclaimed + 1; TAndSFreeObject[LOOPHOLE[UnParseRef[pref]]]}}; -- *******this stuff copied and slightly altered from RTReclaimerImpl TAndSFreeObject: PROC[ptr: RTBasic.Pointer] = {mz: ZoneFinger = MapPtrZf[ptr]; IF RTFlags.checking THEN { IF ptr = NIL THEN ERROR; IF NOT FromCollectibleZone[LOOPHOLE[ptr, REF ANY]] THEN ERROR}; RTRefCounts.nObjectsReclaimed _ RTRefCounts.nObjectsReclaimed + 1; WITH mz: mz SELECT FROM sub => {sz: SubZone = MapSziSz[mz.szi]; size: CARDINAL _ sz.size; RTRefCounts.nWordsReclaimed _ RTRefCounts.nWordsReclaimed + size; IF RTFlags.clearing THEN [] _ LONGZERO[ptr, size]; TAndSFreeQuantizedNode[ptr, LOOPHOLE[MapZiZn[sz.zi]], sz]}; prefixed => {size: CARDINAL = RTCommon.ShortenLongCardinal[NodeLength[LOOPHOLE[ptr-sizeNd, PNode]]]; IF RTFlags.checking AND size = 0 THEN ERROR; RTRefCounts.nWordsReclaimed _ RTRefCounts.nWordsReclaimed + size; IF RTFlags.clearing THEN [] _ LONGZERO[ptr, size-sizeNd]; TAndSFreePrefixedNode[ptr, LOOPHOLE[MapZiZn[mz.zi]]]}; ENDCASE => ERROR}; TAndSFreeQuantizedNode: PROC[ptr: RTBasic.Pointer, zn: PZone, sz: SubZone] = {LOOPHOLE[ptr, FreeList]^ _ sz.fl; sz.fl _ ptr; IF RTFlags.takingStatistics THEN { zn.cellsInService _ zn.cellsInService - sz.size; zn.objectsInService _ zn.objectsInService - 1}}; TAndSFreePrefixedNode: PROC[ptr: RTBasic.Pointer, zn: PZone] = { IF RTFlags.takingStatistics THEN { pn: PNode = LOOPHOLE[ptr, PNode] - sizeNd; zn.cellsInService _ zn.cellsInService - NodeLength[pn]; zn.overheadCells _ zn.overheadCells - sizeNd; zn.objectsInService _ zn.objectsInService - 1}; LinkHeapNode[ptr-sizeNd, @LOOPHOLE[zn, PPrefixedZone].fnd]}; -- NOTE copied in RTPrefAllocImpl LinkHeapNode: PROC[pfn, pfnPrev: PFreeNode] = {pfnNext: PFreeNode = pfnPrev.pfnNext; pfn.body _ free[pfnPrev: pfnPrev, pfnNext: pfnNext]; pfnNext.pfnPrev _ pfn; pfnPrev.pfnNext _ pfn}; -- *******end of stuff copied and slightly altered from RTReclaimerImpl GlobalFrameSize: PROC [gf: PrincOps.GlobalFrameHandle] RETURNS [CARDINAL] = { -- return the size in words of the given global frame -- 0 is returned for frames not yet started IF gf = NIL OR NOT gf.started THEN RETURN [0]; {cp: LONG POINTER TO PrincOps.CSegPrefix _ LOOPHOLE[gf.code]; pbody: LONG POINTER TO CARDINAL _ LOOPHOLE[cp + CARDINAL[cp.entry[PrincOps.MainBodyIndex].initialpc]]; RETURN [(pbody - 1)^] }}; TraceLocalFrame: PROC [pa: LONG POINTER TO RTBasic.Address, nWords: CARDINAL] = { -- this procedure is used to mark refs in a local frame -- RCs must be decremented on first encounter IF RTFlags.takingStatistics THEN nLocalFrames _ nLocalFrames + 1; IF nWords >= (SIZE[REF]) THEN FOR i: CARDINAL IN [0..nWords - (SIZE[REF])] DO addr: RTBasic.Address = (pa + i)^; IF ObjectStart[LOOPHOLE[addr]] THEN -- if this REF is valid {ref: REF ANY = LOOPHOLE[addr]; pref: ParsedRef _ ParseRef[ref]; IF Marked[pref] THEN LOOP; -- here if this REF is valid and not seen before -- finalization: get the type, the package count, and -- establish the correct initial RC (0) FOR i: CARDINAL IN [0..RTTypesBasicPrivate.NPackageRefs[RTTypesBasic.GetReferentType[ref]]] DO DecRC[ref] ENDLOOP; SetMark[pref]; IF NOT RefContaining[pref] THEN LOOP; PushRef[pref]}; ENDLOOP}; procRef: PROC [ref: REF] = { IF RTFlags.checking AND NOT ObjectStart[LOOPHOLE[ref]] THEN ERROR; MarkRef[ParseRef[ref]]}; TraceGlobalFrame: PROC [gfh: PrincOps.GlobalFrameHandle] RETURNS [BOOLEAN] = { -- this procedure is used to mark refs from a global frame -- the algorithm is essentially the same as for regular objects type: RTTypesBasic.Type = RTLoader.GetGFRCType[gfh.gfi]; IF type # RTBasic.nullType THEN RTTypesBasicPrivate.MapRefs [LONG[gfh], RTTypesBasicPrivate.MapTiRcmx[type], procRef]; RETURN[FALSE]}; -- size _ GlobalFrameSize[gf]; -- p: POINTER TO RTBasic.Address _ LOOPHOLE[gf]; -- IF RTFlags.takingStatistics THEN nGlobalFrames _ nGlobalFrames + 1; -- IF size >= SIZE[REF] THEN -- FOR i: CARDINAL IN [SIZE[PrincOps.GlobalFrame]..size - (SIZE[REF])] DO -- addr: RTBasic.Address = (p + i)^; -- IF ObjectStart[LOOPHOLE[addr]] THEN -- MarkRef[ParseRef[LOOPHOLE[addr]]] -- ENDLOOP; -- RETURN [FALSE]}; TraceRefsInObject: PROC [pref: ParsedRef] = { -- applies P to each reference in the indicated object (ref) ref: REF ANY = UnParseRef[pref]; type: RTTypesBasic.Type _ RTTypesBasic.GetReferentType[ref]; IF checkTraceObject THEN CheckBugRef[pref]; RTTypesBasicPrivate.MapRefs [LOOPHOLE[ref], RTTypesBasicPrivate.MapTiRcmx[type], procRef]}; ObjectsInPrefixedZone: PROC [zone: Zone, visit: PROC [ParsedRef]] = { -- this proc visits all non-free objects in a prefixed zone WITH z: zone 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 ptr: PNode _ LOOPHOLE[LONG[r.iFrom] * RTQuanta.QuantumSize]; WHILE ptr # lim DO -- look at each object in the run size: LONG CARDINAL = NodeLength[ptr]; pr: ParsedRef _ LOOPHOLE[ptr + sizeNd]; IF RTFlags.checking AND size = 0 THEN ERROR; IF RTFlags.takingStatistics THEN prefixedObjectsSeen _ prefixedObjectsSeen + 1; IF pr.pad # 0 OR pr.prefixed OR size < sizeNd OR LOOPHOLE[pr, LONG CARDINAL] > LOOPHOLE[lim, LONG CARDINAL] THEN ERROR; pr.prefixed _ TRUE; IF ptr.state = free THEN {IF RTFlags.takingStatistics THEN prefixedObjectsMarkedFree _ prefixedObjectsMarkedFree + 1} ELSE visit[pr]; IF RTFlags.checking AND size # NodeLength[ptr] THEN ERROR; -- oops, something changed! ptr _ ptr + size; ENDLOOP ENDLOOP; ENDCASE => ERROR}; ObjectsInQuantizedZone: PROC [zone: Zone, visit: PROC [ParsedRef]] = { -- this proc visits all objects in a quantized zone -- the visitation is in order of increasing address FOR r: Runs.Run _ zone.runs, r.rnNext WHILE r # NIL DO FOR qx: CARDINAL IN [r.iFrom..r.iTo) DO mz: ZoneFinger = MapQZf[qx]; IF mz = mzVacant THEN LOOP; -- unused quantum WITH mz: mz SELECT FROM sub => {size: CARDINAL = GetSzSize[mz.szi]; rz: Zone = MapZiZn[GetSzZi[mz.szi]]; lc: LONG CARDINAL _ 0; p: LONG POINTER _ LOOPHOLE[LONG[qx]*RTQuanta.QuantumSize]; IF rz # zone OR size > RTQuanta.QuantumSize THEN ERROR; IF qx = rz.qFirst THEN lc _ RTBases.BaseOverhead; DO -- for each object in the quantum pr: ParsedRef _ LOOPHOLE[p+lc]; lc _ lc + size; IF lc > RTQuanta.QuantumSize THEN EXIT; IF RTFlags.takingStatistics THEN quantizedObjectsSeen _ quantizedObjectsSeen + 1; visit[pr]; ENDLOOP; }; ENDCASE => ERROR; ENDLOOP; ENDLOOP; }; ParsedRefToPointer: PROC [p: ParsedRef] RETURNS [RTBasic.Pointer] = MACHINE CODE {Mopcodes.zLIB, 377B; Mopcodes.zAND}; ParsedRefToPNode: PROC [p: ParsedRef] RETURNS [InusePNode] = INLINE { IF p.prefixed THEN RETURN [LOOPHOLE[ParsedRefToPointer[p] - sizeNd]]; ERROR}; ObjectStart: PROC [p: RTBasic.Pointer] RETURNS [BOOLEAN] = INLINE { -- returns TRUE if the pointer really refers to the start of an object -- it is OK to hand this thing pure garbage! -- A ref to someplace in a prefixed zone points at the start of -- a non-free object if ObjectBit[ref] is TRUE. We assume that the -- object start bits have been set for prefixed objects -- 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. IF p = NIL OR (LOOPHOLE[p, Pair].low MOD 2 = 1) OR (LOOPHOLE[p, Pair].high > MaxBank) THEN RETURN [FALSE]; {qx: RTQuanta.QuantumIndex = RTQuanta.PtrToQtmIndex[p]; mz: ZoneFinger = MapQZf[qx]; IF mz = mzVacant THEN RETURN [FALSE]; WITH mz: mz SELECT FROM sub => {sz: CARDINAL = GetSzSize[mz.szi]; rz: Zone = MapZiZn[GetSzZi[mz.szi]]; lc: CARDINAL _ CARDINAL[Inline.LowHalf[p]] MOD RTQuanta.QuantumSize; IF rz = NIL THEN RETURN[FALSE]; IF RTFlags.checking AND rz.linkage.tag # collectible THEN ERROR; IF qx = rz.qFirst THEN {IF lc < RTBases.BaseOverhead THEN RETURN [FALSE]; lc _ lc - RTBases.BaseOverhead}; IF sz > RTQuanta.QuantumSize THEN ERROR; -- can't allow this! RETURN [lc MOD sz = 0]}; prefixed => IF MapZiZn[mz.zi] = NIL THEN RETURN[FALSE] ELSE RETURN[ObjectBit[p]]; ENDCASE => ERROR}}; Marked: PROC [pref: ParsedRef] RETURNS [BOOLEAN] = INLINE { -- determines whether ref has been seen ptr: RTBasic.Pointer = ParsedRefToPointer[pref]; IF NOT pref.prefixed THEN RETURN [ObjectBit[ptr]] -- for quantized zones, the ObjectBit is used as the mark! ELSE RETURN [ParsedRefToPNode[pref].marked]}; SetMark: PROC [pref: ParsedRef] = INLINE { -- marks object as being seen ptr: RTBasic.Pointer = ParsedRefToPointer[pref]; IF NOT pref.prefixed THEN SetObjectBit[ptr] -- for quantized zones, the ObjectBit is used as the mark! ELSE ParsedRefToPNode[pref].marked _ TRUE}; ClearMark: PROC [pref: ParsedRef] = INLINE { -- clears object mark to ground state ptr: RTBasic.Pointer = ParsedRefToPointer[pref]; IF NOT pref.prefixed THEN ClearObjectBit[ptr] -- for quantized zones, the ObjectBit is used as the mark! ELSE ParsedRefToPNode[pref].marked _ FALSE}; -- One bit per address in virtual memory. -- For prefixed zones, the "object" bit indicates that the object is allocated. -- For quantized zones, it is used as the mark bit. ObjectBit: PROC [ptr: RTBasic.Pointer] RETURNS [BOOLEAN] = INLINE { -- returns TRUE iff object bit is set for the reference bank: CARDINAL _ LOOPHOLE[ptr, Pair].high; word: CARDINAL _ LOOPHOLE[ptr, Pair].low; IF bank > MaxBank THEN RETURN [FALSE]; IF suspect = ptr THEN SIGNAL SuspectSeen; {table: BankTablePtr _ bankTableArray[bank]; IF table = NIL THEN RETURN [FALSE]; RETURN [table[word]]}}; SetObjectBit: PROC [ptr: RTBasic.Pointer] = INLINE { -- sets the object bit for the reference bank: CARDINAL _ LOOPHOLE[ptr, Pair].high; word: CARDINAL _ LOOPHOLE[ptr, Pair].low; IF bank > MaxBank THEN ERROR BadObjectStart; IF suspect = ptr THEN SIGNAL SuspectSeen; {table: BankTablePtr _ bankTableArray[bank]; IF table = NIL THEN -- create new bank table (and initialize it to ALL[FALSE] efficiently) {table _ LOOPHOLE[NewPages[BankTablePages]]; bankTableArray[bank] _ table; LOOPHOLE[table, PhonyTablePtr]^ _ ALL[0]}; table[word] _ TRUE}}; ClearObjectBit: PROC [ptr: RTBasic.Pointer] = INLINE { -- clears the object bit for the reference bank: CARDINAL _ LOOPHOLE[ptr, Pair].high; word: CARDINAL _ LOOPHOLE[ptr, Pair].low; IF bank > MaxBank THEN ERROR BadObjectStart; IF suspect = ptr THEN SIGNAL SuspectSeen; {table: BankTablePtr _ bankTableArray[bank]; IF table = NIL THEN ERROR BadAddress; table[word] _ FALSE}}; FreeAllObjectBits: PROC = { -- free all of the object bit tables FOR bank: CARDINAL IN [0..MaxBank] DO table: BankTablePtr _ bankTableArray[bank]; IF table = NIL THEN LOOP; FreePages[table]; bankTableArray[bank] _ NIL ENDLOOP}; PushRef: PROC [pref: ParsedRef] = { -- pushes ref to object onto the reference stack stack: RefStack _ refStackChain; IF stack = NIL OR stack.size = stack.max THEN -- time to get a new stack node {IF refStackFree = NIL -- oh well, nothing comes for free THEN {stack _ NewPages[8]; stack.next _ NIL; stack.size _ 0; stack.max _ (8 * wordsPerPage - (SIZE[RefStackRep])) / (SIZE[ParsedRef])} ELSE {stack _ refStackFree; refStackFree _ stack.next}; stack.next _ refStackChain; refStackChain _ stack}; stack[stack.size] _ pref; stack.size _ stack.size + 1}; PopRef: PROC RETURNS [pref: ParsedRef] = { -- pops ref to object from the reference stack stack: RefStack _ refStackChain; IF stack # NIL THEN {size: CARDINAL _ stack.size; IF size = 0 THEN {refStackChain _ stack.next; stack.next _ refStackFree; refStackFree _ stack; IF (stack _ refStackChain) = NIL THEN RETURN [ParsedNil]; IF (size _ stack.size) = 0 THEN ERROR}; size _ size - 1; stack.size _ size; RETURN [stack[size]]}; RETURN [ParsedNil]}; EmptyRefStack: PROC RETURNS [BOOLEAN] = INLINE { -- tests reference stack for emptiness RETURN [refStackChain = NIL]}; FreeRefStacks: PROC = { IF refStackChain # NIL THEN ERROR; -- should never happen, but check anyway WHILE refStackFree # NIL DO stack: RefStack _ refStackFree.next; FreePages[refStackFree]; refStackFree _ stack ENDLOOP}; ParseRef: PROC [ref: REF ANY] RETURNS [ParsedRef] = { -- parses reference into more efficient representation IF LOOPHOLE[ref, Pair].high > MaxBank THEN RETURN [ParsedNil]; {pr: ParsedRef _ LOOPHOLE[ref]; mz: ZoneFinger = MapPtrZf[LOOPHOLE[ref]]; rz: Zone; WITH mz: mz SELECT FROM sub => rz _ MapZiZn[GetSzZi[mz.szi]]; prefixed => rz _ MapZiZn[mz.zi]; ENDCASE => ERROR; IF rz.linkage.tag # collectible THEN RETURN [ParsedNil]; IF rz.sr = prefixed THEN pr.prefixed _ TRUE; RETURN[pr]}}; UnParseRef: PROC [pref: ParsedRef] RETURNS [REF ANY] = INLINE { -- returns user-style reference from parsed ref RETURN [LOOPHOLE[ParsedRefToPointer[pref]]]}; RefContaining: PROC [pref: ParsedRef] RETURNS [BOOLEAN] = INLINE { -- tests for object being ref-containing (assume that ObjectStart is TRUE) IF pref = ParsedNil THEN RETURN [FALSE]; {type: RTTypesBasic.Type = RTTypesBasic.GetReferentType[UnParseRef[pref]]; RETURN [RTTypesBasicPrivate.MapTiRcmx[type] # RCMap.nullIndex]}}; END.