'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6599] on 27 April 2005 at 11:14:55 am'!
"Change Set:		VMM38-gc-instrument-image
Date:			27 April 2005
Author:			tim@rowledge.org derived from original by johnmci@smalltalkconsulting.com and andreas.raab@gmx.de

Image side methods to support revised GC handling of weak pointers and GC instrumentation. See SystemDictionary>forceTenure, isYoung: etc.

Needs to go into update stream asap"!


!SystemDictionary methodsFor: 'memory space' stamp: 'JMM 1/27/2005 13:23'!
forceTenure
	"Primitive. Tell the GC logic to force a tenure on the next increment GC."
	<primitive: 'primitiveForceTenure'>
	^self primitiveFailed! !

!SystemDictionary methodsFor: 'memory space' stamp: 'ar 1/18/2005 16:46'!
isRoot: oop
	"Primitive. Answer whether the object is currently a root for youngSpace."
	<primitive: 'primitiveIsRoot'>
	^self primitiveFailed! !

!SystemDictionary methodsFor: 'memory space' stamp: 'ar 1/18/2005 16:47'!
isYoung: oop
	"Primitive. Answer whether the object currently resides in youngSpace."
	<primitive: 'primitiveIsYoung'>
	^self primitiveFailed! !

!SystemDictionary methodsFor: 'memory space' stamp: 'ar 1/18/2005 16:48'!
rootTable
	"Primitive. Answer a snapshot of the VMs root table. 
	Keep in mind that the primitive may itself cause GC."
	<primitive: 'primitiveRootTable'>
	^self primitiveFailed! !

!SystemDictionary methodsFor: 'memory space' stamp: 'ar 1/18/2005 16:49'!
rootTableAt: index
	"Primitive. Answer the nth element of the VMs root table"
	<primitive: 'primitiveRootTableAt'>
	^nil! !

!SystemDictionary methodsFor: 'memory space' stamp: 'JMM 1/27/2005 13:12'!
setGCBiasToGrow: aNumber
	"Primitive. Indicate that the GC logic should be bias to grow"
	<primitive: 'primitiveSetGCBiasToGrow'>
	^self primitiveFailed
"Example:
	Smalltalk setGCBiasToGrowGCLimit: 16*1024*1024.
	Smalltalk setGCBiasToGrow: 1.
"! !

!SystemDictionary methodsFor: 'memory space' stamp: 'JMM 1/27/2005 12:27'!
setGCBiasToGrowGCLimit: aNumber
	"Primitive. Indicate that the bias to grow logic should do a GC after aNumber Bytes"
	<primitive: 'primitiveSetGCBiasToGrowGCLimit'>
	^self primitiveFailed
"Example:
	Smalltalk setGCBiasToGrowGCLimit: 16*1024*1024.
"! !

!SystemDictionary methodsFor: 'memory space' stamp: 'ar 1/18/2005 16:54'!
setGCSemaphore: semaIndex
	"Primitive. Indicate the GC semaphore index to be signaled on GC occurance."
	<primitive: 'primitiveSetGCSemaphore'>
	^self primitiveFailed
"Example:

	| index sema process |
	sema := Semaphore new.
	index := Smalltalk registerExternalObject: sema.
	Smalltalk setGCSemaphore: index.
	process := [
		[[true] whileTrue:[
			sema wait.
			Smalltalk beep.
		]] ensure:[
			Smalltalk setGCSemaphore: 0.
			Smalltalk unregisterExternalObject: sema.
		].
	] fork.
	process inspect.
"! !

!SystemDictionary methodsFor: 'special objects' stamp: 'JMM 1/27/2005 12:17'!
recreateSpecialObjectsArray    "Smalltalk recreateSpecialObjectsArray"
	"The Special Objects Array is an array of object pointers used by the
	Squeak virtual machine.  Its contents are critical and unchecked,
	so don't even think of playing here unless you know what you are doing."
	| newArray |
	newArray _ Array new: 50.
	"Nil false and true get used throughout the interpreter"
	newArray at: 1 put: nil.
	newArray at: 2 put: false.
	newArray at: 3 put: true.
	"This association holds the active process (a ProcessScheduler)"
	newArray at: 4 put: (Smalltalk associationAt: #Processor).
	"Numerous classes below used for type checking and instantiation"
	newArray at: 5 put: Bitmap.
	newArray at: 6 put: SmallInteger.
	newArray at: 7 put: String.
	newArray at: 8 put: Array.
	newArray at: 9 put: Smalltalk. 
	newArray at: 10 put: Float.
	newArray at: 11 put: MethodContext.
	newArray at: 12 put: BlockContext.
	newArray at: 13 put: Point.
	newArray at: 14 put: LargePositiveInteger.
	newArray at: 15 put: Display.
	newArray at: 16 put: Message.
	newArray at: 17 put: CompiledMethod.
	newArray at: 18 put: (self specialObjectsArray at: 18)  "(low space Semaphore)".
	newArray at: 19 put: Semaphore.
	newArray at: 20 put: Character.
	newArray at: 21 put: #doesNotUnderstand:.
	newArray at: 22 put: #cannotReturn:.
	newArray at: 23 put: nil.  "*unused*"
	"An array of the 32 selectors that are compiled as special bytecodes,
	paired alternately with the number of arguments each takes."
	newArray at: 24 put: #(+ 1 - 1 < 1 > 1 <= 1 >= 1 = 1 ~= 1 * 1 / 1 \\ 1 @ 1 bitShift: 1 // 1 bitAnd: 1 bitOr: 1 at: 1 at:put: 2 size 0 next 0 nextPut: 1 atEnd 0 == 1 class 0 blockCopy: 1 value 0 value: 1 do: 1 new 0 new: 1 x 0 y 0 ).
	"An array of the 255 Characters in ascii order."
	newArray at: 25 put: ((0 to: 255) collect: [:ascii | Character value: ascii]).
	newArray at: 26 put: #mustBeBoolean.
	newArray at: 27 put: ByteArray.
	newArray at: 28 put: Process.
	"An array of up to 31 classes whose instances will have compact headers"
	newArray at: 29 put: self compactClassesArray.
	newArray at: 30 put: (self specialObjectsArray at: 30)   "(delay Semaphore)".
	newArray at: 31 put: (self specialObjectsArray at: 31)   "(user interrupt Semaphore)".
	newArray at: 32 put: nil. 
	newArray at: 33 put: nil.
	newArray at: 34 put: nil.
	newArray at: 35 put: #cannotInterpret:.
	"Note: This must be fixed once we start using context prototypes"
	newArray at: 36 put: (self specialObjectsArray at: 36). 
						"(MethodContext new: CompiledMethod fullFrameSize)."
	newArray at: 37 put: nil.
	newArray at: 38 put: (self specialObjectsArray at: 38). 
						"(BlockContext new: CompiledMethod fullFrameSize)."

	newArray at: 39 put: Array new.  "array of objects referred to by external code"

	newArray at: 40 put: PseudoContext.
	newArray at: 41 put: TranslatedMethod.

	"finalization Semaphore"
	newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil:[Semaphore new]).

	newArray at: 43 put: LargeNegativeInteger.

	"External objects for callout.
	Note: Written so that one can actually completely remove the FFI."
	newArray at: 44 put: (Smalltalk at: #ExternalAddress ifAbsent:[nil]).
	newArray at: 45 put: (Smalltalk at: #ExternalStructure ifAbsent:[nil]).
	newArray at: 46 put: (Smalltalk at: #ExternalData ifAbsent:[nil]).
	newArray at: 47 put: (Smalltalk at: #ExternalFunction ifAbsent:[nil]).
	newArray at: 48 put: (Smalltalk at: #ExternalLibrary ifAbsent:[nil]).

	newArray at: 49 put: #aboutToReturn:through:.
	newArray at: 50 put: #run:with:in:.

	"Now replace the interpreter's reference in one atomic operation"
	self specialObjectsArray become: newArray! !