These are VM changes that are *suggested* for full text indexing.. There's
nothing new here, except for some new comments in the new method cache..
They make full text indexing about 2.5 times faster.

* I include my new method cache.

* I include the root table overflow patch.[2]

You don't need them, but they're nice. I've been running with both of them
for several months.


Scott


[2] Because full text indexing alters large tenured sets, it overflows the
root table nearly constantly. This is shown as a large number of fullGC's.




-------------- next part --------------
'From Squeak3.2alpha of 11 October 2001 [latest update: #4646] on 12 February 2002 at 1:59:53 pm'!
ObjectMemory subclass: #Interpreter
	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext messageSelector argumentCount newMethod currentBytecode successFlag primitiveIndex methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks extraVMMemory newNativeMethod methodClass receiverClass interpreterVersion obsoleteIndexedPrimitiveTable obsoleteNamedPrimitiveTable interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable cacheRandomState '
	classVariableNames: 'ActiveProcessIndex AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CacheProbeShift CallerIndex CharacterValueIndex CompilerHooksSize CrossedX DirBadPath DirEntryFound DirNoMoreEntries EndOfRun ExcessSignalsIndex FirstLinkIndex GenerateBrowserPlugin HeaderIndex HomeIndex InitialIPIndex InstanceSpecificationIndex InstructionPointerIndex JitterTable LastLinkIndex LiteralStart MaxExternalPrimitiveTableSize MaxPrimitiveIndex MessageArgumentsIndex MessageDictionaryIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodCacheClass MethodCacheEntries MethodCacheEntrySize MethodCacheMask MethodCacheMethod MethodCacheNative MethodCachePrim MethodCacheSelector MethodCacheSize MethodIndex MillisecondClockMask Must MyListIndex NextLinkIndex PrimitiveExternalCallIndex PrimitiveTable PriorityIndex ProcessListsIndex ReceiverIndex SelectorStart SemaphoresToSignalSize SenderIndex StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TempFrameStart ValueIndex XIndex YIndex '
	poolDictionaries: ''
	category: 'VMConstruction-Interpreter'!

!Interpreter methodsFor: 'initialization' stamp: 'sac 10/3/2001 08:42'!
initializeInterpreter: bytesToShift 
	"Initialize Interpreter state before starting execution of a new image."
	interpreterProxy _ self sqGetInterpreterProxy.
	self initializeObjectMemory: bytesToShift.
	self initCompilerHooks.
	self flushExternalPrimitives.
	activeContext _ nilObj.
	theHomeContext _ nilObj.
	method _ nilObj.
	receiver _ nilObj.
	messageSelector _ nilObj.
	newMethod _ nilObj.
	methodClass _ nilObj.
	lkupClass _ nilObj.
	receiverClass _ nilObj.
	cacheRandomState _ 1.
	self flushMethodCache.
	self flushAtCache.
	self loadInitialContext.
	interruptCheckCounter _ 0.
	interruptCheckCounterFeedBackReset _ 1000.
	interruptChecksEveryNms _ 5.
	nextPollTick _ 0.
	nextWakeupTick _ 0.
	lastTick _ 0.
	interruptKeycode _ 2094.
	"cmd-."
	interruptPending _ false.
	semaphoresUseBufferA _ true.
	semaphoresToSignalCountA _ 0.
	semaphoresToSignalCountB _ 0.
	deferDisplayUpdates _ false.
	pendingFinalizationSignals _ 0.

	"Initialize these to numbers."
	primitiveIndex _ 0.
	newNativeMethod _ 0.! !

!Interpreter methodsFor: 'message sending' stamp: 'sac 10/5/2001 02:56'!
normalSend
	"Send a message, starting lookup with the receiver's class."
	"Assume: messageSelector and argumentCount have been set, and that 
	the receiver and arguments have been pushed onto the stack,"
	"Note: This method is inlined into the interpreter dispatch loop."
	| rcvr |
	self inline: true.
	self sharedCodeNamed: 'commonSend' inCase: 131.
	rcvr _ self internalStackValue: argumentCount.
	lkupClass _ self fetchClassOf: rcvr.
	receiverClass _ lkupClass.
     self internalFindNewMethod.
	self internalExecuteNewMethod.
	self fetchNextBytecode! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 2/12/2002 13:56'!
addNewMethodToCache
	"Add the given entry to the method cache.  
	
	The policy is as follows:

	We have a hash table, where each entry in the table contains 4 slots. We replace a random entry with the new cached methodlookup. We don't bother searching for an empty entry because there will basically never be on except during startup or after a GC."
	| probe hash |
	self inline: false.
	self compilerTranslateMethodHook.
	"newMethod x lkupClass -> newNativeMethod (may cause GC !!)"
	hash _ self hashIndex: messageSelector with: lkupClass.

	"The cache is almost always going to be full, so don't bother to find an empty slot, just do random replacement."	

	probe _ hash + ((cacheRandomState bitAnd: CacheProbeMax - 1)
					* MethodCacheEntrySize).
	"Overwrite an entry."
	methodCache at: probe + MethodCacheSelector put: messageSelector.
	methodCache at: probe + MethodCacheClass put: lkupClass.
	methodCache at: probe + MethodCacheMethod put: newMethod.
	methodCache at: probe + MethodCachePrim put: primitiveIndex.
	methodCache at: probe + MethodCacheNative put: newNativeMethod.
	"Construct a new random seed."
	cacheRandomState _ cacheRandomState * 23 >> 4 + 1 bitAnd: 16777215! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 9/25/2001 03:25'!
flushAtCache
	self inline: false.
	1 to: AtCacheTotalSize do: [ :i | atCache at: i put: 0].! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 9/25/2001 03:25'!
flushMethodCache
	"Flush the method cache. The method cache is flushed on every programming change and garbage collect."
	self inline: false.
	1 to: MethodCacheSize do: [ :i | methodCache at: i put: 0 ].

! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:02'!
hash: aSelector with: aClass
	"Compute the hash code for the selector and class."
	^(aSelector bitXor: aClass).
! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/3/2001 07:38'!
hashIndex: aSelector with: aClass 
	"Compute the slot index in the hash table for the given selector and  
	class."
	^ (self hash: aSelector with: aClass)
		bitAnd: ((MethodCacheMask << CacheProbeShift) bitAnd: MethodCacheMask).! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:16'!
invalidateMethodCache

	| probe |
	"Invalidate the method cache. Don't remove unused entries. Just invalidate everything."
	"Flush the method cache. The method cache is flushed on every programming change and garbage collect."
	
	probe _ 0.
	1 to: MethodCacheEntries do: [ :i |
methodCache at: probe + MethodCacheSelector put: 0.
		probe _ probe + MethodCacheEntrySize].
! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 2/12/2002 13:59'!
lookupInMethodCacheSel: selector class: class 
	"This method implements a simple method lookup cache.
	
	The cache is implemented as a set of entries where each entry has several slots. When we probe, we prombe the first slot. If its a hit, we're done. If one of the other slots matches, we swap that slot with the previous one, trying to put the most frequently used method&selector in the first slot.

     If an entry for  
	the given selector and class is found in the cache, set the values of  
	'newMethod' and 'primitiveIndex' and return true. Otherwise, return  
	false."
	"About the re-probe scheme: The hash is the low bits of the XOR of two  
	large addresses, minus their useless lowest two bits."
	"WARNING: Since the hash computation is based on the object addresses of 
	the class and selector, we must rehash or flush when compacting  
	storage. We've chosen to flush, since that also saves the trouble of  
	updating the addresses of the objects in the cache."
	| hash probe |
	self inline: true.
	hash _ self hashIndex: selector with: class.

	probe _ hash.
	"first probe"
	((methodCache at: probe + MethodCacheSelector)
				= selector
			and: [(methodCache at: probe + MethodCacheClass)
					= class])
		ifTrue: [newMethod _ methodCache at: probe + MethodCacheMethod.
			primitiveIndex _ methodCache at: probe + MethodCachePrim.
			newNativeMethod _ methodCache at: probe + MethodCacheNative.
			^ true].
	"Damn, didn't find it first, so we do the long search among the rest."
	1
		to: CacheProbeMax - 1
		do: [:i | 
			probe _ hash + (i * MethodCacheEntrySize).
			"All later probes."
			((methodCache at: probe + MethodCacheSelector)
						= selector
					and: [(methodCache at: probe + MethodCacheClass)
							= class])
				ifTrue: ["Get the feedback."
					newMethod _ methodCache at: probe + MethodCacheMethod.
					primitiveIndex _ methodCache at: probe + MethodCachePrim.
					newNativeMethod _ methodCache at: probe + MethodCacheNative.
					"And swap this entry with the last one."
					self swapCacheWithPrevEntry: probe.
					^ true]].
	^ false! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/3/2001 08:34'!
rewriteMethodCacheSel: selector class: class primIndex: localPrimIndex 
	"Rewrite an existing entry in the method cache with a new primitive  
	index."
	| probe hash |
	self inline: false.
	hash _ self hashIndex: selector with: class.
	0
		to: CacheProbeMax - 1
		do: [:p | 
			probe _ hash + (p * MethodCacheEntrySize).
			((methodCache at: probe + MethodCacheSelector)
						= selector
					and: [(methodCache at: probe + MethodCacheClass)
							= class])
				ifTrue: [methodCache at: probe + MethodCachePrim put: localPrimIndex.
					^ nil]]! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:44'!
swapCacheWithPrevEntry: probe
	self inline: true.
	self swapFieldWithPrevEntry: probe offset: MethodCacheSelector.
	self swapFieldWithPrevEntry: probe offset: MethodCacheClass.
	self swapFieldWithPrevEntry: probe offset: MethodCacheMethod.
	self swapFieldWithPrevEntry: probe offset: MethodCachePrim.
	self swapFieldWithPrevEntry: probe offset: MethodCacheNative.
	! !

!Interpreter methodsFor: 'method lookup cache' stamp: 'sac 10/2/2001 20:44'!
swapFieldWithPrevEntry: probe offset: offset
	| t u |
	self inline: true.
	t _ methodCache at: probe + offset.
	u _ methodCache at: probe - MethodCacheEntrySize + offset.
	methodCache at: probe + offset put: u.
	methodCache at: probe - MethodCacheEntrySize + offset put: t.
	! !

!Interpreter methodsFor: 'object access primitives' stamp: 'sac 9/25/2001 03:24'!
primitiveChangeClass
	"Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have."
	| arg rcvr argClass classHdr sizeHiBits byteSize argFormat rcvrFormat ccIndex |
	arg _ self stackObjectValue: 0.
	rcvr _ self stackObjectValue: 1.
	successFlag ifFalse:[^nil].

	"Get the class we want to convert the receiver into"
	argClass _ self fetchClassOf: arg.

	"Check what the format of the class says"
	classHdr _ self formatOfClass: argClass. "Low 2 bits are 0"

	"Compute the size of instances of the class (used for fixed field classes only)"
	sizeHiBits _ (classHdr bitAnd: 16r60000) >> 9.
	classHdr _ classHdr bitAnd: 16r1FFFF.
	byteSize _ (classHdr bitAnd: SizeMask) + sizeHiBits. "size in bytes -- low 2 bits are 0"

	"Check the receiver's format against that of the class"
	argFormat _ (classHdr >> 8) bitAnd: 16rF.
	rcvrFormat _ self formatOf: rcvr.
	argFormat = rcvrFormat ifFalse:[^self success: false]. "no way"

	"For fixed field classes, the sizes must match.
	Note: byteSize-4 because base header is included in class size."
	argFormat < 2 ifTrue:[(byteSize - 4) = (self byteSizeOf: rcvr) ifFalse:[^self success: false]].

	(self headerType: rcvr) = HeaderTypeShort ifTrue:[
		"Compact classes. Check if the arg's class is compact and exchange ccIndex"
		ccIndex _ classHdr bitAnd: CompactClassMask.
		ccIndex = 0 ifTrue:[^self success: false]. "class is not compact"
		self longAt: rcvr put:
			(((self longAt: rcvr) bitAnd: CompactClassMask bitInvert32)
				bitOr: ccIndex)
	] ifFalse:[
		"Exchange the class pointer, which could make rcvr a root for argClass"
		self longAt: rcvr-4 put: (argClass bitOr: (self headerType: rcvr)).
		(rcvr < youngStart) ifTrue: [
			self possibleRootStoreInto: rcvr value: argClass.
		].
	].
	"Flush cache because rcvr's class has changed"
	self flushMethodCache.
	self flushAtCache.

	successFlag ifTrue: [ self pop: 1 ].! !

!Interpreter methodsFor: 'other primitives' stamp: 'sac 10/2/2001 20:24'!
primitiveFlushCache
	"Clear the method lookup cache. This must be done after every 
	programming change."
	self invalidateMethodCache.
	self flushAtCache.
	self compilerFlushCacheHook: nil! !

!Interpreter methodsFor: 'plugin support' stamp: 'sac 9/25/2001 03:23'!
flushExternalPrimitives
	"Flush the references to external functions from plugin primitives.
	This will force a reload of those primitives when accessed next.
	Note: We must flush the method cache here so that any failed
	primitives are looked up again."
	| oop fmt primIdx |
	oop _ self firstObject.
	[oop < endOfMemory] whileTrue:[
		(self isFreeObject: oop) ifFalse: [
			fmt _ self formatOf: oop.
			fmt >= 12 ifTrue:["This is a compiled method"
				primIdx _ self primitiveIndexOf: oop.
				primIdx = PrimitiveExternalCallIndex ifTrue:["It's primitiveExternalCall"
					self flushExternalPrimitiveOf: oop.
				].
			].
		].
		oop _ self objectAfter: oop.
	].
	self flushMethodCache.
	self flushAtCache.
	self flushObsoleteIndexedPrimitives.
	self flushExternalPrimitiveTable.! !


!Interpreter class methodsFor: 'initialization' stamp: 'sac 10/3/2001 10:55'!
initializeCaches
	| atCacheEntrySize |
	MethodCacheEntries _ 8192.
	MethodCacheSelector _ 1.
	MethodCacheClass _ 2.
	MethodCacheMethod _ 3.
	MethodCachePrim _ 4.
	MethodCacheNative _ 5.
	MethodCacheEntrySize _ 8.
	"Must be power of two for masking scheme."
	MethodCacheMask _ MethodCacheEntries - 1 * MethodCacheEntrySize.
	MethodCacheSize _ MethodCacheEntries * MethodCacheEntrySize.
	CacheProbeShift _ 2.
	CacheProbeMax _ 1 << CacheProbeShift.
	AtCacheEntries _ 8.
	"Must be power of two"
	AtCacheOop _ 1.
	AtCacheSize _ 2.
	AtCacheFmt _ 3.
	AtCacheFixedFields _ 4.
	atCacheEntrySize _ 4.
	"Must be power of two for masking scheme."
	AtCacheMask _ AtCacheEntries - 1 * atCacheEntrySize.
	AtPutBase _ AtCacheEntries * atCacheEntrySize.
	AtCacheTotalSize _ AtCacheEntries * atCacheEntrySize * 2! !

ObjectMemory subclass: #Interpreter
	instanceVariableNames: 'activeContext theHomeContext method receiver instructionPointer stackPointer localIP localSP localHomeContext messageSelector argumentCount newMethod currentBytecode successFlag primitiveIndex cacheRandomState methodCache atCache lkupClass reclaimableContextCount nextPollTick nextWakeupTick lastTick interruptKeycode interruptPending semaphoresToSignalA semaphoresUseBufferA semaphoresToSignalCountA semaphoresToSignalB semaphoresToSignalCountB savedWindowSize fullScreenFlag deferDisplayUpdates pendingFinalizationSignals compilerInitialized compilerHooks extraVMMemory newNativeMethod methodClass receiverClass interpreterVersion obsoleteIndexedPrimitiveTable obsoleteNamedPrimitiveTable interpreterProxy showSurfaceFn interruptCheckCounterFeedBackReset interruptChecksEveryNms externalPrimitiveTable '
	classVariableNames: 'ActiveProcessIndex AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BlockArgumentCountIndex BytecodeTable CacheProbeMax CacheProbeShift CallerIndex CharacterValueIndex CompilerHooksSize CrossedX DirBadPath DirEntryFound DirNoMoreEntries EndOfRun ExcessSignalsIndex FirstLinkIndex GenerateBrowserPlugin HeaderIndex HomeIndex InitialIPIndex InstanceSpecificationIndex InstructionPointerIndex JitterTable LastLinkIndex LiteralStart MaxExternalPrimitiveTableSize MaxPrimitiveIndex MessageArgumentsIndex MessageDictionaryIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodCacheClass MethodCacheEntries MethodCacheEntrySize MethodCacheMask MethodCacheMethod MethodCacheNative MethodCachePrim MethodCacheSelector MethodCacheSize MethodIndex MillisecondClockMask Must MyListIndex NextLinkIndex PrimitiveExternalCallIndex PrimitiveTable PriorityIndex ProcessListsIndex ReceiverIndex SelectorStart SemaphoresToSignalSize SenderIndex StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TempFrameStart ValueIndex XIndex YIndex '
	poolDictionaries: ''
	category: 'VMConstruction-Interpreter'!
-------------- next part --------------
'From Squeak3.1alpha of 28 February 2001 [latest update: #4354] on 28 September 2001 at 1:08:25 am'!
"Change Set:		RootTableOverflows-ar
Date:			28 September 2001
Author:			Andreas Raab

Changes the default behavior of forcing a full GC on a root table overflow. The change set introduces a 'red zone' for the roots table - when this limit has been reached, we force an incremental GC at the next available time at the next available time and tenure all survivers. This limits the number of full GCs due to root table overflows to a (hopefully unmeasurable) minimum."!

Object subclass: #ObjectMemory
	instanceVariableNames: 'memory youngStart endOfMemory memoryLimit nilObj falseObj trueObj specialObjectsOop rootTable rootTableCount child field parentField freeBlock lastHash allocationCount lowSpaceThreshold signalLowSpace compStart compEnd fwdTableNext fwdTableLast remapBuffer remapBufferCount allocationsBetweenGCs tenuringThreshold statFullGCs statFullGCMSecs statIncrGCs statIncrGCMSecs statTenures statRootTableOverflows freeContexts freeLargeContexts interruptCheckCounter displayBits totalObjectCount shrinkThreshold growHeadroom '
	classVariableNames: 'AllButHashBits AllButMarkBit AllButMarkBitAndTypeMask AllButRootBit AllButTypeMask BaseHeaderSize BlockContextProto CharacterTable ClassArray ClassBitmap ClassBlockContext ClassByteArray ClassCharacter ClassCompiledMethod ClassExternalAddress ClassExternalData ClassExternalFunction ClassExternalLibrary ClassExternalStructure ClassFloat ClassInteger ClassLargeNegativeInteger ClassLargePositiveInteger ClassMessage ClassMethodContext ClassPoint ClassProcess ClassPseudoContext ClassSemaphore ClassString ClassTranslatedMethod CompactClassMask CompactClasses ConstMinusOne ConstOne ConstTwo ConstZero CtxtTempFrameStart DoAssertionChecks DoBalanceChecks Done ExternalObjectsArray FalseObject FloatProto GCTopMarker HashBits HashBitsOffset HeaderTypeClass HeaderTypeFree HeaderTypeGC HeaderTypeShort HeaderTypeSizeAndClass LargeContextBit LargeContextSize MarkBit MethodContextProto NilContext NilObject RemapBufferSize RootBit RootTableRedZone RootTableSize SchedulerAssociation SelectorAboutToReturn SelectorCannotInterpret SelectorCannotReturn SelectorDoesNotUnderstand SelectorMustBeBoolean SizeMask SmallContextSize SpecialSelectors StackStart StartField StartObj TheDisplay TheFinalizationSemaphore TheInputSemaphore TheInterruptSemaphore TheLowSpaceSemaphore TheTimerSemaphore TrueObject TypeMask Upward '
	poolDictionaries: ''
	category: 'VMConstruction-Interpreter'!

!ObjectMemory methodsFor: 'garbage collection' stamp: 'ar 9/28/2001 01:03'!
incrementalGC
	"Do a mark/sweep garbage collection of just the young object area of object memory (i.e., objects above youngStart), using the root table to identify objects containing pointers to young objects from the old object area."

	| survivorCount startTime |
	self inline: false.
	rootTableCount >= RootTableSize ifTrue: [
		"root table overflow; cannot do an incremental GC (this should be very rare)"
		statRootTableOverflows _ statRootTableOverflows + 1.
		^ self fullGC].

	DoAssertionChecks ifTrue: [self reverseDisplayFrom: 8 to: 15].
	DoAssertionChecks ifTrue: [self validateRoots].
	self preGCAction: false.
	"incremental GC and compaction"
	startTime _ self ioMicroMSecs.
	self markPhase.
	survivorCount _ self sweepPhase.
	self incrementalCompaction.
	allocationCount _ 0.
	statIncrGCs _ statIncrGCs + 1.
	statIncrGCMSecs _ statIncrGCMSecs + (self ioMicroMSecs - startTime).

	(survivorCount > tenuringThreshold 
		or:[rootTableCount >= RootTableRedZone]) ifTrue: [
		"move up the young space boundary if
		* there are too many survivors:
			this limits the number of objects that must be processed on future
			incremental GC's
		* we're about to overflow the roots table
			this limits the number of full GCs that may be caused by 
			root table overflows in the near future"

		statTenures _ statTenures + 1.
		self clearRootsTable.
		youngStart _ freeBlock.  "reset the young object boundary"
	].
	self postGCAction.
	DoAssertionChecks ifTrue: [self reverseDisplayFrom: 8 to: 15].
! !

!ObjectMemory methodsFor: 'garbage collection' stamp: 'ar 9/28/2001 01:03'!
noteAsRoot: oop headerLoc: headerLoc
	"Record that the given oop in the old object area points to an object in the young area.
	HeaderLoc is usually = oop, but may be an addr in a forwarding block."

	| header |
	self inline: true.
	header _ self longAt: headerLoc.
	(header bitAnd: RootBit) = 0 ifTrue:[
		"record oop as root only if not already recorded"
		rootTableCount < RootTableRedZone ifTrue:[
			"record root if there is enough room in the roots table"
			rootTableCount _ rootTableCount + 1.
			rootTable at: rootTableCount put: oop.
			self longAt: headerLoc put: (header bitOr: RootBit).
		] ifFalse:["we're getting in the red zone"
			rootTableCount < RootTableSize ifTrue:[
				"but there's still space to record it"
				rootTableCount _ rootTableCount + 1.
				rootTable at: rootTableCount put: oop.
				self longAt: headerLoc put: (header bitOr: RootBit).
				"but force an IGC on the next allocation"
				allocationCount _ allocationsBetweenGCs + 1.
			].
		].
	].
! !


!ObjectMemory class methodsFor: 'initialization' stamp: 'ar 9/28/2001 01:03'!
initialize
	"ObjectMemory initialize"

	"Translation flags (booleans that control code generation via conditional translation):"
	DoAssertionChecks _ false.  "generate assertion checks"
	DoBalanceChecks _ false. "generate stack balance checks"

	self initializeSpecialObjectIndices.
	self initializeObjectHeaderConstants.

	SmallContextSize _ 92.  "16 indexable fields"
	LargeContextSize _ 252.  "56 indexable fileds.  Max with single header word."
	LargeContextBit _ 16r40000.  "This bit set in method headers if large context is needed."
	CtxtTempFrameStart _ 6.  "Copy of TempFrameStart in Interp"
	NilContext _ 1.  "the oop for the integer 0; used to mark the end of context lists"

	RemapBufferSize _ 25.
	RootTableSize _ 2500.  	"number of root table entries (4 bytes/entry)"
	RootTableRedZone _ RootTableSize - 100.	"red zone of root table - when reached we force IGC"

	"tracer actions"
	StartField _ 1.
	StartObj _ 2.
	Upward _ 3.
	Done _ 4.! !

ObjectMemory initialize!