[Vm-dev] VM Maker: Cog.pharo-EstebanLorenzano.201.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Aug 28 13:00:30 UTC 2014


Esteban Lorenzano uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog.pharo-EstebanLorenzano.201.mcz

==================== Summary ====================

Name: Cog.pharo-EstebanLorenzano.201
Author: EstebanLorenzano
Time: 28 August 2014, 3:00:09.130643 pm
UUID: 26c3bd13-1682-4a6a-b319-92d2b38bb5e9
Ancestors: Cog-EstebanLorenzano.200

- prototypes migrated to SpurBootstrapPrototypes hierarchy

=============== Diff against Cog-eem.199 ===============

Item was changed:
+ SystemOrganization addCategory: #Cog!
+ SystemOrganization addCategory: 'Cog-Benchmarks-DeltaBlue'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-Richards'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-SMark'!
+ SystemOrganization addCategory: 'Cog-Benchmarks-Shootout'!
+ SystemOrganization addCategory: 'Cog-Bootstrapping'!
+ SystemOrganization addCategory: 'Cog-Morphing Bytecode Set'!
+ SystemOrganization addCategory: 'Cog-ProcessorPlugins'!
+ SystemOrganization addCategory: 'Cog-Processors'!
+ SystemOrganization addCategory: 'Cog-Processors-Tests'!
+ SystemOrganization addCategory: 'Cog-Scripting'!
+ SystemOrganization addCategory: 'Cog-Scripts'!
+ SystemOrganization addCategory: 'Cog-Tests'!
- SystemOrganization addCategory: #'Cog-Benchmarks-DeltaBlue'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Richards'!
- SystemOrganization addCategory: #'Cog-Benchmarks-SMark'!
- SystemOrganization addCategory: #'Cog-Benchmarks-Shootout'!
- SystemOrganization addCategory: #'Cog-Bootstrapping'!
- SystemOrganization addCategory: #'Cog-Morphing Bytecode Set'!
- SystemOrganization addCategory: #'Cog-ProcessorPlugins'!
- SystemOrganization addCategory: #'Cog-Processors'!
- SystemOrganization addCategory: #'Cog-Processors-Tests'!
- SystemOrganization addCategory: #'Cog-Scripting'!
- SystemOrganization addCategory: #'Cog-Scripts'!
- SystemOrganization addCategory: #'Cog-Tests'!

Item was added:
+ ----- Method: Behavior>>BehaviorPROTOTYPEinstSize (in category '*Cog-method prototypes') -----
+ BehaviorPROTOTYPEinstSize
+ 	"Answer the number of named instance variables
+ 	(as opposed to indexed variables) of the receiver.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>"
+ 	^format bitAnd: 16rFFFF!

Item was added:
+ ----- Method: Behavior>>BehaviorPROTOTYPEinstSpec (in category '*Cog-method prototypes') -----
+ BehaviorPROTOTYPEinstSpec
+ 	"Answer the instance specification part of the format that defines what kind of object
+ 	 an instance of the receiver is.  The formats are
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^(format bitShift: -16) bitAnd: 16r1F!

Item was changed:
  ----- Method: BlockClosure>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category '*Cog-method prototypes') -----
  BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
  	"Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity."
  	| newContext sz |
+ 	newContext := (Context newForMethod: outerContext method)
- 	newContext := (MethodContext newForMethod: outerContext method)
  						setSender: aContext
  						receiver: outerContext receiver
  						method: outerContext method
  						closure: self
  						startpc: startpc.
  	((newContext objectClass: anArray) ~~ Array
  	 or: [numArgs ~= anArray size]) ifTrue:
+ 		[^Context primitiveFailTokenFor: nil].
- 		[^ContextPart primitiveFailTokenFor: nil].
  	sz := self basicSize.
  	newContext stackp: sz + numArgs.
  	1 to: numArgs do:
  		[:i| newContext at: i put: (anArray at: i)].
  	1 to: sz do:
  		[:i| newContext at: i + numArgs put: (self at: i)].
  	^newContext!

Item was changed:
  ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinitialize (in category '*Cog-method prototypes') -----
  CompiledMethodclassPROTOTYPEinitialize    "CompiledMethod initialize"
  	"Initialize class variables specifying the size of the temporary frame
  	needed to run instances of me."
  
  	SmallFrame := 16.	"Context range for temps+stack"
  	LargeFrame := 56.
  	PrimaryBytecodeSetEncoderClass ifNil:
  		[PrimaryBytecodeSetEncoderClass := EncoderForV3PlusClosures].
  	SecondaryBytecodeSetEncoderClass ifNil:
  		[SecondaryBytecodeSetEncoderClass := EncoderForV3PlusClosures]!

Item was changed:
  ----- Method: CompiledMethod class>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category '*Cog-method prototypes') -----
  CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
  	PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue:
  		[^self].
  	(aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse:
  		[self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder'].
  	(self allSubInstances
  			detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]]
  			ifNone: []) ifNotNil:
  		[Warning signal: 'There are existing CompiledMethods with a different encoderClass.'].
  	PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass!

Item was removed:
- ----- Method: CompiledMethod>>CompiledMethodPROTOTYPEencoderClass (in category '*Cog-method prototypes') -----
- CompiledMethodPROTOTYPEencoderClass
- 	"Answer the encoder class that encoded the bytecodes in this method.
- 	 The sign flag bit is used by the VM to select a bytecode set.  This formulation
- 	 may seem odd but this has to be fast, so no property probe unless needed."
- 
- 	^self header >= 0
- 		ifTrue: 
- 			[PrimaryBytecodeSetEncoderClass]
- 		ifFalse:
- 			[PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass
- 				ifTrue: "Support for testing prior to installing another set"
- 					[(self propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]]
- 				ifFalse:
- 					[SecondaryBytecodeSetEncoderClass]]!

Item was added:
+ ----- Method: Context>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') -----
+ ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments 
+ 	"Simulate a primitive method whose index is primitiveIndex.  The simulated receiver and
+ 	 arguments are given as arguments to this message. If successful, push result and return
+ 	 resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
+ 	 execution needs to be intercepted and simulated to avoid execution running away."
+ 
+ 	| value |
+ 	"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
+ 	 the debugger from entering various run-away activities such as spawning a new
+ 	 process, etc.  Injudicious use results in the debugger not being able to debug
+ 	 interesting code, such as the debugger itself.  hence use primitive 19 with care :-)"
+ 	"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
+ 	primitiveIndex = 19 ifTrue:
+ 		[ Smalltalk tools debugger 
+ 			openContext: self
+ 			label:'Code simulation error'
+ 			contents: nil].
+ 
+ 	((primitiveIndex between: 201 and: 222)
+ 	 and: [aReceiver class includesBehavior: BlockClosure]) ifTrue:
+ 		[((primitiveIndex between: 201 and: 205)			 "BlockClosure>>value[:value:...]"
+ 		  or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
+ 			[^aReceiver simulateValueWithArguments: arguments caller: self].
+ 		 primitiveIndex = 206 ifTrue:						"BlockClosure>>valueWithArguments:"
+ 			[^aReceiver simulateValueWithArguments: arguments first caller: self]].
+ 
+ 	primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ 		[^self send: arguments first to: aReceiver with: arguments allButFirst super: false].
+ 	primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ 		[^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (self objectClass: aReceiver)].
+ 	primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ 		[^self send: arguments first to: aReceiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
+ 
+ 	"Mutex>>primitiveEnterCriticalSection
+ 	 Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
+ 	(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
+ 		[| active effective |
+ 		 active := Processor activeProcess.
+ 		 effective := active effectiveProcess.
+ 		 "active == effective"
+ 		 value := primitiveIndex = 186
+ 					ifTrue: [aReceiver primitiveEnterCriticalSectionOnBehalfOf: effective]
+ 					ifFalse: [aReceiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ 		 ^(self isPrimFailToken: value)
+ 			ifTrue: [value]
+ 			ifFalse: [self push: value]].
+ 
+ 	primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
+ 		[^Context
+ 			sender: self
+ 			receiver: aReceiver
+ 			method: (arguments at: 2)
+ 			arguments: (arguments at: 1)].
+ 
+ 	"Closure primitives"
+ 	(primitiveIndex = 200 and: [self == aReceiver]) ifTrue:
+ 		"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
+ 		[^self push: (BlockClosure
+ 						outerContext: aReceiver
+ 						startpc: pc + 2
+ 						numArgs: arguments first
+ 						copiedValues: arguments last)].
+ 
+ 	primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
+ 		[(arguments size = 2
+ 		 and: [arguments first isInteger
+ 		 and: [(self objectClass: arguments last) == Array]]) ifFalse:
+ 			[^Context primitiveFailTokenFor: nil].
+ 		 ^self doPrimitive: arguments first method: meth receiver: aReceiver args: arguments last].
+ 
+ 	value := primitiveIndex = 120 "FFI method"
+ 				ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
+ 				ifFalse:
+ 					[primitiveIndex = 117 "named primitives"
+ 						ifTrue: [self tryNamedPrimitiveIn: meth for: aReceiver withArgs: arguments]
+ 						ifFalse: [aReceiver tryPrimitive: primitiveIndex withArgs: arguments]].
+ 
+ 	^(self isPrimFailToken: value)
+ 		ifTrue: [value]
+ 		ifFalse: [self push: value]!

Item was added:
+ ----- Method: Context>>ContextPROTOTYPEfailPrimitiveWith: (in category '*Cog-method prototypes') -----
+ ContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
+ 	"The receiver is a freshly-created context on a primitive method.  Skip the callPrimitive:
+ 	 bytecode and store the primitive fail code if there is one and the method consumes it."
+ 	self skipCallPrimitive.
+ 	((self isPrimFailToken: maybePrimFailToken)
+ 	  and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
+ 		[self at: stackp put: maybePrimFailToken last]!

Item was added:
+ ----- Method: Context>>ContextPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') -----
+ ContextPROTOTYPEisPrimFailToken: anObject
+ 	^ anObject class == Array
+ 	  and: [anObject size = 2
+ 	  and: [anObject first == PrimitiveFailToken]]!

Item was added:
+ ----- Method: Context>>xray (in category '*Cog-Tests-xrays') -----
+ xray
+ 	"Lift the veil from a context and answer an integer describing its interior state.
+ 	 Used for e.g. VM tests so they can verify they're testing what they think they're testing.
+ 	 0 implies a vanilla heap context.
+ 	 Bit 0 = is or was married to a frame
+ 	 Bit 1 = is still married to a frame
+ 	 Bit 2 = frame is executing machine code
+ 	 Bit 3 = has machine code pc (as opposed to nil or a bytecode pc)
+ 	 Bit 4 = method is currently compiled to machine code"
+ 	<primitive: 213>
+ 	^0 "Can only fail if unimplemented; therefore simply answer 0"!

Item was added:
+ ----- Method: Context>>xrayIsDivorced (in category '*Cog-Tests-xrays') -----
+ xrayIsDivorced
+ 	^(self xray bitAnd: 3) = 1!

Item was added:
+ ----- Method: Context>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') -----
+ xrayIsExecutingMachineCode
+ 	^self xray anyMask: 4!

Item was added:
+ ----- Method: Context>>xrayIsMarried (in category '*Cog-Tests-xrays') -----
+ xrayIsMarried
+ 	^self xray anyMask: 2!

Item was added:
+ ----- Method: Context>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') -----
+ xrayLastExecutedMachineCode
+ 	^self xray anyMask: 8!

Item was added:
+ ----- Method: Context>>xrayMethodIsCompiledToMachineCode (in category '*Cog-Tests-xrays') -----
+ xrayMethodIsCompiledToMachineCode
+ 	^self xray anyMask: 16!

Item was removed:
- ----- Method: ContextPart>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category '*Cog-method prototypes') -----
- ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments 
- 	"Simulate a primitive method whose index is primitiveIndex.  The simulated receiver and
- 	 arguments are given as arguments to this message. If successful, push result and return
- 	 resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
- 	 execution needs to be intercepted and simulated to avoid execution running away."
- 
- 	| value |
- 	"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
- 	 the debugger from entering various run-away activities such as spawning a new
- 	 process, etc.  Injudicious use results in the debugger not being able to debug
- 	 interesting code, such as the debugger itself.  hence use primitive 19 with care :-)"
- 	"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
- 	primitiveIndex = 19 ifTrue:
- 		[ToolSet 
- 			debugContext: self
- 			label:'Code simulation error'
- 			contents: nil].
- 
- 	((primitiveIndex between: 201 and: 222)
- 	 and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
- 		[((primitiveIndex between: 201 and: 205)			 "BlockClosure>>value[:value:...]"
- 		  or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
- 			[^receiver simulateValueWithArguments: arguments caller: self].
- 		 primitiveIndex = 206 ifTrue:						"BlockClosure>>valueWithArguments:"
- 			[^receiver simulateValueWithArguments: arguments first caller: self]].
- 
- 	primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
- 		[^self send: arguments first to: receiver with: arguments allButFirst super: false].
- 	primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
- 		[^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
- 	primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
- 		[^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
- 
- 	"Mutex>>primitiveEnterCriticalSection
- 	 Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
- 	(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
- 		[| active effective |
- 		 active := Processor activeProcess.
- 		 effective := active effectiveProcess.
- 		 "active == effective"
- 		 value := primitiveIndex = 186
- 					ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
- 					ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
- 		 ^(self isPrimFailToken: value)
- 			ifTrue: [value]
- 			ifFalse: [self push: value]].
- 
- 	primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
- 		[^MethodContext
- 			sender: self
- 			receiver: receiver
- 			method: (arguments at: 2)
- 			arguments: (arguments at: 1)].
- 
- 	"Closure primitives"
- 	(primitiveIndex = 200 and: [self == receiver]) ifTrue:
- 		"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
- 		[^self push: (BlockClosure
- 						outerContext: receiver
- 						startpc: pc + 2
- 						numArgs: arguments first
- 						copiedValues: arguments last)].
- 
- 	primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
- 		[(arguments size = 2
- 		 and: [arguments first isInteger
- 		 and: [(self objectClass: arguments last) == Array]]) ifFalse:
- 			[^ContextPart primitiveFailTokenFor: nil].
- 		 ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
- 
- 	value := primitiveIndex = 120 "FFI method"
- 				ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
- 				ifFalse:
- 					[primitiveIndex = 117 "named primitives"
- 						ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
- 						ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
- 
- 	^(self isPrimFailToken: value)
- 		ifTrue: [value]
- 		ifFalse: [self push: value]!

Item was removed:
- ----- Method: ContextPart>>ContextPartPROTOTYPEisPrimFailToken: (in category '*Cog-method prototypes') -----
- ContextPartPROTOTYPEisPrimFailToken: anObject
- 	^(self objectClass: anObject) == Array
- 	  and: [anObject size = 2
- 	  and: [anObject first == PrimitiveFailToken]]!

Item was removed:
- ----- Method: Decompiler>>DecompilerPROTOTYPEdecompile:in:method:using: (in category '*Cog-method prototypes squeak 4.3') -----
- DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
- 
- 	| block node |
- 	constructor := aConstructor.
- 	method := aMethod.
- 	self initSymbols: aClass.  "create symbol tables"
- 	method isQuick
- 		ifTrue: [block := self quickMethod]
- 		ifFalse: 
- 			[stack := OrderedCollection new: method frameSize.
- 			lastJumpIfPcStack := OrderedCollection new.
- 			caseExits := OrderedCollection new.
- 			statements := OrderedCollection new: 20.
- 			numLocalTemps := 0.
- 			super method: method pc: method initialPC.
- 			"skip primitive error code store if necessary"
- 			(method primitive ~= 0 and: [self skipCallPrimitive; willStore]) ifTrue:
- 				[pc := pc + (method encoderClass bytecodeSize: self firstByte).
- 				 tempVars := tempVars asOrderedCollection].
- 			block := self blockTo: method endPC + 1.
- 			stack isEmpty ifFalse: [self error: 'stack not empty']].
- 	node := constructor
- 				codeMethod: aSelector
- 				block: block
- 				tempVars: tempVars
- 				primitive: method primitive
- 				class: aClass.
- 	method primitive > 0 ifTrue:
- 		[node removeAndRenameLastTempIfErrorCode].
- 	^node preen!

Item was removed:
- ----- Method: InstructionStream>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category '*Cog-method prototypes') -----
- InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
- 	| type offset2 byte2 byte3 byte4 |
- 	offset <= 6 ifTrue: 
- 		["Extended op codes 128-134"
- 		byte2 := method at: pc. pc := pc + 1.
- 		offset <= 2 ifTrue:
- 			["128-130:  extended pushes and pops"
- 			type := byte2 // 64.
- 			offset2 := byte2 \\ 64.
- 			offset = 0 ifTrue: 
- 				[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
- 				type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
- 				type = 2  ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
- 				type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
- 			offset = 1 ifTrue: 
- 				[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
- 				type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
- 				type = 2 ifTrue: [self error: 'illegalStore'].
- 				type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
- 			offset = 2 ifTrue: 
- 				[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
- 				type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
- 				type = 2 ifTrue: [self error: 'illegalStore'].
- 				type = 3  ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
- 		"131-134: extended sends"
- 		offset = 3 ifTrue:  "Single extended send"
- 			[^client send: (method literalAt: byte2 \\ 32 + 1)
- 					super: false numArgs: byte2 // 32].
- 		offset = 4 ifTrue:    "Double extended do-anything"
- 			[byte3 := method at: pc. pc := pc + 1.
- 			type := byte2 // 32.
- 			type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
- 									super: false numArgs: byte2 \\ 32].
- 			type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
- 									super: true numArgs: byte2 \\ 32].
- 			type = 2 ifTrue: [^client pushReceiverVariable: byte3].
- 			type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
- 			type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
- 			type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
- 			type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
- 			type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
- 		offset = 5 ifTrue:  "Single extended send to super"
- 			[^client send: (method literalAt: byte2 \\ 32 + 1)
- 					super: true
- 					numArgs: byte2 // 32].
- 		offset = 6 ifTrue:   "Second extended send"
- 			[^client send: (method literalAt: byte2 \\ 64 + 1)
- 					super: false
- 					numArgs: byte2 // 64]].
- 	offset = 7 ifTrue: [^client doPop].
- 	offset = 8 ifTrue: [^client doDup].
- 	offset = 9 ifTrue: [^client pushActiveContext].
- 	byte2 := method at: pc. pc := pc + 1.
- 	offset = 10 ifTrue:
- 		[^byte2 < 128
- 			ifTrue: [client pushNewArrayOfSize: byte2]
- 			ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
- 	byte3 := method at: pc.  pc := pc + 1.
- 	offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
- 	offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
- 	offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
- 	offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
- 	"offset = 15"
- 	byte4 := method at: pc.  pc := pc + 1.
- 	^client
- 		pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
- 		numArgs: (byte2 bitAnd: 16rF)
- 		blockSize: (byte3 * 256) + byte4!

Item was removed:
- ----- Method: InstructionStream>>InstructionStreamPROTOTYPEnextPc: (in category '*Cog-method prototypes') -----
- InstructionStreamPROTOTYPEnextPc: currentByte
- 	"Answer the pc of the next bytecode following the current one, given the current bytecode.."
- 
- 	^pc + (self method encoderClass bytecodeSize: currentByte)!

Item was removed:
- ----- Method: InstructionStream>>InstructionStreamPROTOTYPEskipCallPrimitive (in category '*Cog-method prototypes') -----
- InstructionStreamPROTOTYPEskipCallPrimitive
- 	"If the receiver's method starts with a callPrimitive: bytecode, skip it."
- 	| method encoderClass callPrimitiveCode |
- 	method := self method.
- 	encoderClass := method  encoderClass.
- 	callPrimitiveCode := encoderClass callPrimitiveCode.
- 	(method byteAt: pc) = callPrimitiveCode ifTrue:
- 		[pc := pc + (encoderClass bytecodeSize: callPrimitiveCode)]!

Item was removed:
- ----- Method: MCClassDefinition>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category '*Cog-method prototypes squeak 4.3') -----
- MCClassDefinitionPROTOTYPEkindOfSubclass
- 	type = #normal ifTrue: [^' subclass: '].
- 	type = #variable ifTrue: [^' variableSubclass: '].
- 	type = #bytes ifTrue: [^' variableByteSubclass: '].
- 	type = #compiledMethod ifTrue: [^' variableByteSubclass: ' ].
- 	type = #words ifTrue: [^' variableWordSubclass: '].
- 	type = #weak ifTrue: [^' weakSubclass: ' ].
- 	type = #ephemeron ifTrue: [^' ephemeronSubclass: ' ].
- 	type = #immediate ifTrue: [^' immediateSubclass: ' ].
- 	self error: 'Unrecognized class type'!

Item was removed:
- ----- Method: MCMethodDefinition>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category '*Cog-method prototypes squeak 4.3') -----
- MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString
- classIsMeta: metaBoolean
- selector: selectorString
- category: catString
- timeStamp: timeString
- source: sourceString
- 	className := classString asSymbol.
- 	selector := selectorString asSymbol.
- 	category := catString ifNil: [Categorizer default] ifNotNil: [catString asSymbol].
- 	timeStamp := timeString.
- 	classIsMeta := metaBoolean.
- 	source := sourceString withSqueakLineEndings!

Item was removed:
- ----- Method: MethodContext>>MethodContextPROTOTYPEfailPrimitiveWith: (in category '*Cog-method prototypes') -----
- MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- 	"The receiver is a freshly-created context on a primitive method.  Skip the callPrimitive:
- 	 bytecode and store the primitive fail code if there is one and the method consumes it."
- 	self skipCallPrimitive.
- 	((self isPrimFailToken: maybePrimFailToken)
- 	  and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
- 		[self at: stackp put: maybePrimFailToken last]!

Item was removed:
- ----- Method: MethodContext>>xray (in category '*Cog-Tests-xrays') -----
- xray
- 	"Lift the veil from a context and answer an integer describing its interior state.
- 	 Used for e.g. VM tests so they can verify they're testing what they think they're testing.
- 	 0 implies a vanilla heap context.
- 	 Bit 0 = is or was married to a frame
- 	 Bit 1 = is still married to a frame
- 	 Bit 2 = frame is executing machine code
- 	 Bit 3 = has machine code pc (as opposed to nil or a bytecode pc)
- 	 Bit 4 = method is currently compiled to machine code"
- 	<primitive: 213>
- 	^0 "Can only fail if unimplemented; therefore simply answer 0"!

Item was removed:
- ----- Method: MethodContext>>xrayIsDivorced (in category '*Cog-Tests-xrays') -----
- xrayIsDivorced
- 	^(self xray bitAnd: 3) = 1!

Item was removed:
- ----- Method: MethodContext>>xrayIsExecutingMachineCode (in category '*Cog-Tests-xrays') -----
- xrayIsExecutingMachineCode
- 	^self xray anyMask: 4!

Item was removed:
- ----- Method: MethodContext>>xrayIsMarried (in category '*Cog-Tests-xrays') -----
- xrayIsMarried
- 	^self xray anyMask: 2!

Item was removed:
- ----- Method: MethodContext>>xrayLastExecutedMachineCode (in category '*Cog-Tests-xrays') -----
- xrayLastExecutedMachineCode
- 	^self xray anyMask: 8!

Item was removed:
- ----- Method: MethodContext>>xrayMethodIsCompiledToMachineCode (in category '*Cog-Tests-xrays') -----
- xrayMethodIsCompiledToMachineCode
- 	^self xray anyMask: 16!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstances
- 	"Answer all instances of the receiver."
- 	<primitive: 177>
- 	"The primitive can fail because memory is low.  If so, fall back on the old
- 	 enumeration code, which gives the system a chance to GC and/or grow.
- 	 Because aBlock might change the class of inst (for example, using become:),
- 	 it is essential to compute next before aBlock value: inst."
- 	| inst insts next |
- 	insts := WriteStream on: (Array new: 64).
- 	inst := self someInstance.
- 	[inst == nil] whileFalse:
- 		[next := inst nextInstance.
- 		 (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
- 		 inst := next].
- 	^insts contents!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstancesDo: aBlock
- 	"Evaluate aBlock with each of the current instances of the receiver."
- 	| instances inst next |
- 	instances := self allInstancesOrNil.
- 	instances ifNotNil:
- 		[instances do: aBlock.
- 		 ^self].
- 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
- 	 enumeration code.  Because aBlock might change the class of inst (for example,
- 	 using become:), it is essential to compute next before aBlock value: inst."
- 	inst := self someInstance.
- 	[inst == nil] whileFalse:
- 		[next := inst nextInstance.
- 		 aBlock value: inst.
- 		 inst := next]!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEallInstancesOrNil (in category 'method prototypes') -----
- BehaviorPROTOTYPEallInstancesOrNil
- 	"Answer all instances of the receiver, or nil if the primitive
- 	 fails, which it may be due to being out of memory."
- 	<primitive: 177>
- 	^nil!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicIdentityHash (in category 'method prototypes pharo') -----
- BehaviorPROTOTYPEbasicIdentityHash
- 	"Answer a SmallInteger whose value is related to the receiver's identity.
- 	 Behavior implements identityHash to allow the VM to use an object representation which
- 	 does not include a direct reference to an object's class in an object.  If the VM is using
- 	 this implementation then classes are held in a class table and instances contain the index
- 	 of their class in the table.  A class's class table index is its identityHash so that an instance
- 	 can be created without searching the table for a class's index.  The VM uses this primitive
- 	 to enter the class into the class table, assigning its identityHash with an as yet unused
- 	 class table index. If this primitive fails it means that the class table is full.  In Spur as of
- 	 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
- 
- 	 Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 175>
- 	self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEbasicNew
- 	"Primitive. Answer an instance of the receiver (which is a class) with no 
- 	 indexable variables. Fail if the class is indexable. Essential. See Object 
- 	 documentation whatIsAPrimitive.
- 	
- 	 If the primitive fails because space is low then the scavenger will run
- 	 before the method is activated.  Check that space was low and retry
- 	 via handleFailingBasicNew if so."
- 
- 	<primitive: 70 error: ec>
- 	ec == #'insufficient object memory' ifTrue:
- 		[^self handleFailingBasicNew].
- 	self isVariable ifTrue: [^self basicNew: 0].
- 	self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEbasicNew: sizeRequested
- 	"Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive.
- 	
- 	 If the primitive fails because space is low then the scavenger will run before the
- 	 method is activated.  Check args and retry via handleFailingBasicNew: if they're OK."
- 
- 	<primitive: 71 error: ec>
- 	ec == #'insufficient object memory' ifTrue:
- 		[^self handleFailingBasicNew: sizeRequested].
- 	self isVariable ifFalse:
- 		[self error: self printString, ' cannot have variable sized instances'].
- 	self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbyteSizeOfInstance (in category 'method prototypes') -----
- BehaviorPROTOTYPEbyteSizeOfInstance
- 	"Answer the total memory size of an instance of the receiver."
- 
- 	<primitive: 181 error: ec>
- 	self isVariable ifTrue:
- 		[^self byteSizeOfInstanceOfSize: 0].
- 	self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: (in category 'method prototypes') -----
- BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: basicSize
- 	"Answer the total memory size of an instance of the receiver
- 	 with the given number of indexable instance variables."
- 
- 	<primitive: 181 error: ec>
- 	self isVariable
- 		ifTrue: "If the primitive overflowed answer a close approximation"
- 			[(basicSize isInteger
- 			  and: [basicSize >= 16r1000000]) ifTrue:
- 				[^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
- 				   - (self byteSizeOfInstanceOfSize: 0)]]
- 		ifFalse:
- 			[basicSize = 0 ifTrue:
- 				[^self byteSizeOfInstance]].
- 	self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') -----
- BehaviorPROTOTYPEelementSize
- 	"Answer the size in bytes of an element in the receiver.  The formats are
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := self instSpec.
- 	instSpec < 9 ifTrue: [^Smalltalk wordSize].
- 	instSpec >= 16 ifTrue: [^1].
- 	instSpec >= 12 ifTrue: [^2].
- 	instSpec >= 10 ifTrue: [^4].
- 	^8!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingBasicNew
- 	"handleFailingBasicNew gets sent after basicNew has failed and allowed
- 	 a scavenging garbage collection to occur.  The scavenging collection
- 	 will have happened as the VM is activating the (failing) basicNew.  If
- 	 handleFailingBasicNew fails then the scavenge failed to reclaim sufficient
- 	 space and a global garbage collection is required.  Retry after garbage
- 	 collecting and growing memory if necessary.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 70>
- 	Smalltalk garbageCollect < 1048576 ifTrue:
- 		[Smalltalk growMemoryByAtLeast: 1048576].
- 	^self handleFailingFailingBasicNew "retry after global garbage collect"!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingBasicNew: sizeRequested
- 	"handleFailingBasicNew: gets sent after basicNew: has failed and allowed
- 	 a scavenging garbage collection to occur.  The scavenging collection
- 	 will have happened as the VM is activating the (failing) basicNew:.  If
- 	 handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- 	 space and a global garbage collection is required.  Retry after garbage
- 	 collecting and growing memory if necessary.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 71>
- 	| bytesRequested |
- 	bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
- 	Smalltalk garbageCollect < bytesRequested ifTrue:
- 		[Smalltalk growMemoryByAtLeast: bytesRequested].
- 	"retry after global garbage collect and possible grow"
- 	^self handleFailingFailingBasicNew: sizeRequested!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingFailingBasicNew
- 	"This basicNew gets sent after handleFailingBasicNew: has done a full
- 	 garbage collection and possibly grown memory.  If this basicNew fails
- 	 then the system really is low on space, so raise the OutOfMemory signal.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 70>
- 	"space must be low"
- 	OutOfMemory signal.
- 	^self basicNew  "retry if user proceeds"!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') -----
- BehaviorPROTOTYPEhandleFailingFailingBasicNew: sizeRequested
- 	"This basicNew: gets sent after handleFailingBasicNew: has done a full
- 	 garbage collection and possibly grown memory.  If this basicNew: fails
- 	 then the system really is low on space, so raise the OutOfMemory signal.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable
- 	 variables specified by the argument, sizeRequested.  Fail if this class is not
- 	 indexable or if the argument is not a positive Integer, or if there is not
- 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 71>
- 	"space must be low."
- 	OutOfMemory signal.
- 	^self basicNew: sizeRequested  "retry if user proceeds"!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes squeak') -----
- BehaviorPROTOTYPEidentityHash
- 	"Answer a SmallInteger whose value is related to the receiver's identity.
- 	 Behavior implements identityHash to allow the VM to use an object representation which
- 	 does not include a direct reference to an object's class in an object.  If the VM is using
- 	 this implementation then classes are held in a class table and instances contain the index
- 	 of their class in the table.  A class's class table index is its identityHash so that an instance
- 	 can be created without searching the table for a class's index.  The VM uses this primitive
- 	 to enter the class into the class table, assigning its identityHash with an as yet unused
- 	 class table index. If this primitive fails it means that the class table is full.  In Spur as of
- 	 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
- 
- 	 Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 175>
- 	self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEindexIfCompact (in category 'method prototypes') -----
- BehaviorPROTOTYPEindexIfCompact
- 	"Backward compatibility with the Squeak V3 object format.
- 	 Spur does not have a distinction between compact and non-compact classes."
- 	^0!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEinstSize (in category 'method prototypes') -----
- BehaviorPROTOTYPEinstSize
- 	"Answer the number of named instance variables
- 	(as opposed to indexed variables) of the receiver.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>"
- 	^format bitAnd: 16rFFFF!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
- BehaviorPROTOTYPEinstSpec
- 	"Answer the instance specification part of the format that defines what kind of object
- 	 an instance of the receiver is.  The formats are
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^(format bitShift: -16) bitAnd: 16r1F!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBits (in category 'method prototypes') -----
- BehaviorPROTOTYPEisBits
- 	"Answer whether the receiver contains just bits (not pointers).
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec >= 7!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
- BehaviorPROTOTYPEisBytes
- 	"Answer whether the receiver has 8-bit instance variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec >= 16!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEisEphemeronClass
- 	"Answer whether the receiver has ephemeral instance variables.  The garbage collector will
- 	 fire (queue for finalization) any ephemeron whose first instance variable is not referenced
- 	 other than from the transitive closure of references from ephemerons. Hence referring to
- 	 an object from the first inst var of an ephemeron will cause the ephemeron to fire when
- 	 the rest of the system does not refer to the object and that object is ready to be collected.
- 	 Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
- 	 from firing, ephemerons may act as the associations in weak dictionaries such that the value
- 	 (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
- 	 other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
- 	 pre-mortem finalization."
- 	^self instSpec = 5!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEisImmediateClass
- 	"Answer whether the receiver has immediate instances.  Immediate instances
- 	 store their value in their object pointer, not in an object body.  Hence immediates
- 	 take no space and are immutable.  The immediates are distinguished by tag bits
- 	 in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
- 	 system SmallIntegers are 31-bit signed integers and Characters are 30-bit
- 	 unsigned character codes."
- 	^self instSpec = 7!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
- BehaviorPROTOTYPEisVariable
- 	"Answer whether the receiver has indexable variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := self instSpec.
- 	^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
- BehaviorPROTOTYPEkindOfSubclass
- 	"Answer a String that is the keyword that describes the receiver's kind of subclass,
- 	 either a regular subclass, a variableSubclass, a variableByteSubclass,
- 	 a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
- 	 c.f. typeOfClass"
- 	^self isVariable
- 		ifTrue:
- 			[self isBits
- 				ifTrue:
- 					[self isBytes
- 						ifTrue: [' variableByteSubclass: ']
- 						ifFalse: [' variableWordSubclass: ']]
- 				ifFalse:
- 					[self isWeak
- 						ifTrue: [' weakSubclass: ']
- 						ifFalse: [' variableSubclass: ']]]
- 		ifFalse:
- 			[self isImmediateClass
- 				ifTrue: [' immediateSubclass: ']
- 				ifFalse:
- 					[self isEphemeronClass
- 						ifTrue: [' ephemeronSubclass: ']
- 						ifFalse: [' subclass: ']]]!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes pharo') -----
- BehaviorPROTOTYPElargeIdentityHash
- 	"Answer a SmallInteger whose value is related to the receiver's identity.
- 	 Behavior implements identityHash to allow the VM to use an object representation which
- 	 does not include a direct reference to an object's class in an object.  If the VM is using
- 	 this implementation then classes are held in a class table and instances contain the index
- 	 of their class in the table.  A class's class table index is its identityHash so that an instance
- 	 can be created without searching the table for a class's index.  The VM uses this primitive
- 	 to enter the class into the class table, assigning its identityHash with an as yet unused
- 	 class table index. If this primitive fails it means that the class table is full.  In Spur as of
- 	 2014 there are 22 bits of classTable index and 22 bits of identityHash per object."
- 
- 	<primitive: 175>
- 	self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEshouldNotBeRedefined (in category 'method prototypes') -----
- BehaviorPROTOTYPEshouldNotBeRedefined
- 	"Answer if the receiver should not be redefined.
- 	 The assumption is that classes in Smalltalk specialObjects and 
- 	 instance-specific Behaviors should not be redefined"
- 
- 	^(Smalltalk specialObjectsArray
- 		identityIndexOf: self
- 		ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!

Item was removed:
- ----- Method: SpurBootstrap class>>BehaviorPROTOTYPEtypeOfClass (in category 'method prototypes') -----
- BehaviorPROTOTYPEtypeOfClass
- 	"Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
- 	self isBytes ifTrue:
- 		[^self instSpec = CompiledMethod instSpec
- 			ifTrue: [#compiledMethod] "Very special!!"
- 			ifFalse: [#bytes]].
- 	(self isWords and: [self isPointers not]) ifTrue:
- 		[^self instSpec = SmallInteger instSpec
- 			ifTrue: [#immediate] "Very special!!"
- 			ifFalse: [#words]].
- 	self isWeak ifTrue: [^#weak].
- 	self isVariable ifTrue: [^#variable].
- 	self isEphemeronClass ifTrue: [^#ephemeron].
- 	^#normal!

Item was removed:
- ----- Method: SpurBootstrap class>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
- BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
- BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
- 	numArgs > 15 ifTrue:
- 		[^self error: 'Cannot compile -- too many arguments'].
- 	numTemps > 63 ifTrue:
- 		[^self error: 'Cannot compile -- too many temporary variables'].	
- 	numLits > 65535 ifTrue:
- 		[^self error: 'Cannot compile -- too many literals'].
- 	^(CompiledMethod headerFlagForEncoder: self)
- 	+ (numArgs bitShift: 24)
- 	+ (numTemps bitShift: 18)
- 	"+ (largeBit bitShift: 17)" "largeBit gets filled in later"
- 	+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
- 	+ numLits!

Item was removed:
- ----- Method: SpurBootstrap class>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
- BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
- 	^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEDollarEquals: (in category 'method prototypes') -----
- CharacterPROTOTYPEDollarEquals: aCharacter 
- 	"Primitive. Answer if the receiver and the argument are the
- 	 same object (have the same object pointer). Optional. See
- 	 Object documentation whatIsAPrimitive."
- 	<primitive: 110>
- 	^self == aCharacter!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
- CharacterPROTOTYPEasInteger
- 	"Answer the receiver's character code."
- 	<primitive: 171>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') -----
- CharacterPROTOTYPEasciiValue
- 	"Answer the receiver's character code.
- 	 This will be ascii for characters with value <= 127,
- 	 and Unicode for those with higher values."
- 	<primitive: 171>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEclone (in category 'method prototypes squeak') -----
- CharacterPROTOTYPEclone
- 	"Answer the receiver, because Characters are unique."
- 	^self!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEcodePoint (in category 'method prototypes pharo') -----
- CharacterPROTOTYPEcodePoint
- 	"Just for ANSI Compliance"	
- 	^self!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
- CharacterPROTOTYPEcopy
- 	"Answer the receiver, because Characters are unique."
- 	^self!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
- CharacterPROTOTYPEdeepCopy
- 	"Answer the receiver, because Characters are unique."
- 	^self!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEhash (in category 'method prototypes') -----
- CharacterPROTOTYPEhash
- 	"Hash is reimplemented because = is implemented.
- 	 Answer the receiver's character code."
- 	<primitive: 171>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
- CharacterPROTOTYPEidentityHash
- 	"Answer the receiver's character code."
- 	<primitive: 171>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEsetValue: (in category 'method prototypes pharo') -----
- CharacterPROTOTYPEsetValue: newValue
- 	self error: 'Characters are immutable'!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
- CharacterPROTOTYPEshallowCopy
- 	"Answer the receiver, because Characters are unique."
- 	^self!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
- CharacterPROTOTYPEveryDeepCopyWith: deepCopier
- 	"Answer the receiver, because Characters are unique."
- 	^self!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') -----
- CharacterclassPROTOTYPEdigitValue: x 
- 	"Answer the Character whose digit value is x. For example,
- 	 answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35."
- 
- 	| n |
- 	n := x asInteger.
- 	^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
- CharacterclassPROTOTYPEinitialize
- 	"Create the DigitsValues table."
- 	"Character initialize"
- 	self initializeDigitValues!

Item was removed:
- ----- Method: SpurBootstrap class>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') -----
- CharacterclassPROTOTYPEvalue: anInteger
- 	"Answer the Character whose value is anInteger."
- 	<primitive: 170>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
- 	"Compute the new format for making oldClass a subclass of newSuper.
- 	 Answer the format or nil if there is any problem."
- 	| instSize isVar isWords isPointers isWeak |
- 	type == #compiledMethod ifTrue:
- 		[newInstSize > 0 ifTrue:
- 			[self error: 'A compiled method class cannot have named instance variables'.
- 			^nil].
- 		^CompiledMethod format].
- 	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- 	instSize > 65535 ifTrue:
- 		[self error: 'Class has too many instance variables (', instSize printString,')'.
- 		^nil].
- 	type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
- 	type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
- 	type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
- 	type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
- 	type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
- 	type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
- 	type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
- 	(isPointers not and: [instSize > 0]) ifTrue:
- 		[self error: 'A non-pointer class cannot have named instance variables'.
- 		^nil].
- 	^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- 	"Compute the format for the given instance specfication.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= reserved for 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := isWeak
- 					ifTrue:
- 						[isVar
- 							ifTrue: [4]
- 							ifFalse: [5]]
- 					ifFalse:
- 						[isPointers
- 							ifTrue:
- 								[isVar
- 									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
- 									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
- 							ifFalse:
- 								[isVar
- 									ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
- 									ifFalse: [7]]].
- 	^(instSpec bitShift: 16) + nInstVars!

Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEsuperclass: aClass
- 	immediateSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a
- 	 new immediate class as a subclass of an existing class."
- 	| env |
- 	aClass instSize > 0
- 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
- 	aClass isVariable
- 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
- 	aClass isPointers
- 		ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
- 	"Cope with pre-environment and environment versions. Simplify asap."
- 	env := (Smalltalk classNamed: #EnvironmentRequest)
- 				ifNil: [aClass environment]
- 				ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #immediate
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: SpurBootstrap class>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
- ClassBuilderPROTOTYPEupdate: oldClass to: newClass
- 	"Convert oldClass, all its instances and possibly its meta class into newClass,
- 	 instances of newClass and possibly its meta class. The process is surprisingly
- 	 simple in its implementation and surprisingly complex in its nuances and potentially
- 	 bad side effects.
- 	 We can rely on two assumptions (which are critical):
- 		#1: The method #updateInstancesFrom: will not create any lasting pointers to
- 			 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
- 			 a become of the old vs. the new instances and therefore it will not create
- 			 pointers to *new* instances before the #become: which are *old* afterwards)
- 		#2: The non-preemptive execution of the critical piece of code guarantees that
- 			 nobody can get a hold by 'other means' (such as process interruption and
- 			 reflection) on the old instances.
- 	 Given the above two, we know that after #updateInstancesFrom: there are no pointers
- 	 to any old instances. After the forwarding become there will be no pointers to the old
- 	 class or meta class either.
- 	 Andreas Raab, 2/27/2003 23:42"
- 	| meta |
- 	meta := oldClass isMeta.
- 	"Note: Everything from here on will run without the ability to get interrupted
- 	to prevent any other process to create new instances of the old class."
- 	["Note: The following removal may look somewhat obscure and needs an explanation.
- 	  When we mutate the class hierarchy we create new classes for any existing subclass.
- 	  So it may look as if we don't have to remove the old class from its superclass. However,
- 	  at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
- 	  created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
- 	  subclasses. Since the #become: below will transparently replace the pointers to oldClass
- 	  with newClass the superclass would have newClass in its subclasses TWICE. With rather
- 	  unclear effects if we consider that we may convert the meta-class hierarchy itself (which
- 	  is derived from the non-meta class hierarchy).
- 	  Due to this problem ALL classes are removed from their superclass just prior to converting
- 	  them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
- 	  effectively remove the oldClass (becomeForward:) just a few lines below."
- 
- 		oldClass superclass removeSubclass: oldClass.
- 		oldClass superclass removeObsoleteSubclass: oldClass.
- 
- 		"make sure that the VM cache is clean"
- 		oldClass methodDict do: [:cm | cm flushCache].
- 		
- 		"Convert the instances of oldClass into instances of newClass"
- 		newClass updateInstancesFrom: oldClass.
- 
- 		meta
- 			ifTrue:
- 				[oldClass becomeForward: newClass.
- 				 oldClass updateMethodBindingsTo: oldClass binding]
- 			ifFalse:
- 				[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
- 				 oldClass updateMethodBindingsTo: oldClass binding.
- 				 oldClass class updateMethodBindingsTo: oldClass class binding].
- 
- 		"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
- 		 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
- 		 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
- 		 updated references from the old objects to new objects but didn't destroy the old objects.
- 		 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
- 			valueUnpreemptively!

Item was removed:
- ----- Method: SpurBootstrap class>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes squeak') -----
- ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
- 	"ClassBuilder support for maintaining valid method bindings."
- 	methodDict do: [:method| method methodClassAssociation: aBinding]!

Item was removed:
- ----- Method: SpurBootstrap class>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes squeak') -----
- ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
- 	"This is the standard initialization message for creating a new
- 	 immediate class as a subclass of an existing class (the receiver)."
- 	^ClassBuilder new
- 		superclass: self
- 		immediateSubclass: t
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodPROTOTYPEencoderClass (in category 'method prototypes squeak 4.3') -----
- CompiledMethodPROTOTYPEencoderClass
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEnumLiterals
- 	"Answer the number of literals used by the receiver."
- 	^self header bitAnd: 65535!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodPROTOTYPEprimitive (in category 'method prototypes') -----
- CompiledMethodPROTOTYPEprimitive
- 	"Answer the primitive index associated with the receiver.
- 	 Zero indicates that this is not a primitive method."
- 	| initialPC |
- 	^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
- 		ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
- 		ifFalse: [0]!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod: numberOfBytes header: headerWord
- 	"This newMethod:header: gets sent after handleFailingBasicNew: has done a full
- 	 garbage collection and possibly grown memory.  If this basicNew: fails then the
- 	 system really is low on space, so raise the OutOfMemory signal.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable variables
- 	 specified by the argument, headerWord, and the number of bytecodes specified
- 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
- 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- 	 memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79>
- 	"space must be low."
- 	OutOfMemory signal.
- 	"retry if user proceeds"
- 	^self newMethod: numberOfBytes header: headerWord!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEhandleFailingNewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEhandleFailingNewMethod: numberOfBytes header: headerWord
- 	"This newMethod:header: gets sent after newMethod:header: has failed
- 	 and allowed a scavenging garbage collection to occur.  The scavenging
- 	 collection will have happened as the VM is activating the (failing) basicNew:.
- 	 If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
- 	 space and a global garbage collection is required.  Retry after garbage
- 	 collecting and growing memory if necessary.
- 
- 	 Primitive. Answer an instance of this class with the number of indexable variables
- 	 specified by the argument, headerWord, and the number of bytecodes specified
- 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
- 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
- 	 memory available. Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79>
- 	| bytesRequested |
- 	bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
- 	Smalltalk garbageCollect < bytesRequested ifTrue:
- 		[Smalltalk growMemoryByAtLeast: bytesRequested].
- 	"retry after global garbage collect and possible grow"
- 	^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinitialize    "CompiledMethod initialize"
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
- 	"Since this method refers to ClassVariables things are easier if it lives in the actual class."
- 
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
- 	"Since this method refers to ClassVariables things are easier if it lives in the actual class."
- 
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEnewMethod:header: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEnewMethod: numberOfBytes header: headerWord
- 	"Primitive. Answer an instance of me. The number of literals (and other 
- 	 information) is specified by the headerWord (see my class comment).
- 	 The first argument specifies the number of fields for bytecodes in the
- 	 method. Fail if either argument is not a SmallInteger, or if numberOfBytes
- 	 is negative, or if memory is low. Once the header of a method is set by
- 	 this primitive, it cannot be changed to change the number of literals.
- 	 Essential. See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 79 error: ec>
- 	ec == #'insufficient object memory' ifTrue:
- 		[^self handleFailingNewMethod: numberOfBytes header: headerWord].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEtoReturnConstant:trailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnConstant: index trailerBytes: trailer
- 	"Answer an instance of me that is a quick return of the constant
- 	indexed in (true false nil -1 0 1 2)."
- 
- 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEtoReturnField:trailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnField: field trailerBytes: trailer
- 	"Answer an instance of me that is a quick return of the instance variable 
- 	indexed by the argument, field."
- 
- 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!

Item was removed:
- ----- Method: SpurBootstrap class>>CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: (in category 'method prototypes') -----
- CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: trailer
- 	"Answer an instance of me that is a quick return of the instance (^self)."
- 
- 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
- ContextPartPROTOTYPEactivateReturn: aContext value: value
- 	"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
- 
- 	^MethodContext 
- 		sender: self
- 		receiver: aContext
- 		method: MethodContext theReturnMethod
- 		arguments: {value}!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
- ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments 
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
- ContextPartPROTOTYPEisPrimFailToken: anObject
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
- 	"Simulate the action of sending a message with selector and arguments
- 	 to rcvr. The argument, lookupClass, is the class in which to lookup the
- 	 message.  This is the receiver's class for normal messages, but for super
- 	 messages it will be some specific class related to the source method."
- 
- 	| meth primIndex val ctxt |
- 	(meth := lookupClass lookupSelector: selector) ifNil:
- 		[^self send: #doesNotUnderstand:
- 				to: rcvr
- 				with: {Message selector: selector arguments: arguments}
- 				lookupIn: lookupClass].
- 	(primIndex := meth primitive) > 0 ifTrue:
- 		[val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
- 		 (self isPrimFailToken: val) ifFalse:
- 			[^val]].
- 	(selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
- 		[^self error: 'Simulated message ', arguments first selector, ' not understood'].
- 	ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments.
- 	primIndex > 0 ifTrue:
- 		[ctxt failPrimitiveWith: val].
- 	^ctxt!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
- ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag 
- 	"Simulate the action of sending a message with selector arguments
- 	 to rcvr. The argument, superFlag, tells whether the receiver of the
- 	 message was specified with 'super' in the source method."
- 
- 	^self send: selector
- 		to: rcvr
- 		with: arguments
- 		lookupIn: (superFlag
- 					ifTrue: [self method methodClassAssociation value superclass]
- 					ifFalse: [self objectClass: rcvr])!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
- ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
- 	"Invoke the named primitive for aCompiledMethod, answering its result, or,
- 	 if the primiitve fails, answering the error code."
- 	<primitive: 218 error: ec>
- 	ec ifNotNil:
- 		["If ec is an integer other than -1 there was a problem with primitive 218,
- 		  not with the external primitive itself.  -1 indicates a generic failure (where
- 		  ec should be nil) but ec = nil means primitive 218 is not implemented.  So
- 		  interpret -1 to mean the external primitive failed with a nil error code."
- 		 ec isInteger ifTrue:
- 			[ec = -1
- 				ifTrue: [ec := nil]
- 				ifFalse: [self primitiveFailed]]].
- 	^self class primitiveFailTokenFor: ec!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextclassPROTOTYPEallInstances (in category 'method prototypes pharo') -----
- ContextclassPROTOTYPEallInstances
- 	"Answer all instances of the receiver."
- 	<primitive: 177>
- 	"The primitive can fail because memory is low.  If so, fall back on the old
- 	 enumeration code, which gives the system a chance to GC and/or grow.
- 	 Because aBlock might change the class of inst (for example, using become:),
- 	 it is essential to compute next before aBlock value: inst.
- 	 Only count until thisContext since this context has been created only to
- 	 compute the existing instances."
- 	| inst insts next |
- 	insts := WriteStream on: (Array new: 64).
- 	inst := self someInstance.
- 	[inst == thisContext or: [inst == nil]] whileFalse:
- 		[next := inst nextInstance.
- 		 insts nextPut: inst.
- 		 inst := next].
- 	^insts contents!

Item was removed:
- ----- Method: SpurBootstrap class>>ContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes pharo') -----
- ContextclassPROTOTYPEallInstancesDo: aBlock
- 	"Evaluate aBlock with each of the current instances of the receiver."
- 	| instances inst next |
- 	instances := self allInstancesOrNil.
- 	instances ifNotNil:
- 		[instances do: aBlock.
- 		 ^self].
- 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
- 	 enumeration code.  Because aBlock might change the class of inst (for example,
- 	 using become:), it is essential to compute next before aBlock value: inst.
- 	 Only count until thisContext since evaluation of aBlock will create new contexts."
- 	inst := self someInstance.
- 	[inst == thisContext or: [inst == nil]] whileFalse:
- 		[next := inst nextInstance.
- 		 aBlock value: inst.
- 		 inst := next]!

Item was removed:
- ----- Method: SpurBootstrap class>>DecompilerPROTOTYPEdecompile:in:method:using: (in category 'method prototypes squeak 4.3') -----
- DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
- EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
- 	<remove>!

Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category 'method prototypes') -----
- EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex
- 	"Since this method has inst var refs the prototype must live in the actual class."
- 
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: (in category 'method prototypes') -----
- EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: bytecode
- 	"Answer the number of bytes in the bytecode."
- 	bytecode <= 125 ifTrue:
- 		[^1].
- 	bytecode >= 176 ifTrue:
- 		[^1].
- 	bytecode >= 160 ifTrue: "long jumps"
- 		[^2].
- 	bytecode >= 144 ifTrue: "short jumps"
- 		[^1].
- 	"extensions"
- 	bytecode >= 128 ifTrue:
- 		[^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127].
- 	^nil!

Item was removed:
- ----- Method: SpurBootstrap class>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
- EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
- 	"139	11101111	iiiiiiii jjjjjjjj	Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
- 	^139!

Item was removed:
- ----- Method: SpurBootstrap class>>InstructionClientPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
- InstructionClientPROTOTYPEcallPrimitive: pimIndex
- 	"V3PlusClosures:	139 10001011	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- 	 NewsqueakV4:		249 11111001	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
- 	 SistaV1:			248 11111000 iiiiiiii mjjjjjjj  Call Primitive #iiiiiiii + ( jjjjjjj * 256)
- 							m=1 means inlined primitive, no hard return after execution."!

Item was removed:
- ----- Method: SpurBootstrap class>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
- InstructionPrinterPROTOTYPEcallPrimitive: index
- 	"Print the callPrimitive."
- 
- 	self print: 'callPrimtive: ' , index printString!

Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes squeak 4.3') -----
- InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
- 	^self interpretV3ClosuresExtension: offset in: method for: client!

Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes') -----
- InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
- 	"Since this method has inst var refs the prototype must live in the actual class."
- 
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEnextPc: (in category 'method prototypes squeak 4.3') -----
- InstructionStreamPROTOTYPEnextPc: currentByte
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEskipCallPrimitive (in category 'method prototypes squeak 4.3') -----
- InstructionStreamPROTOTYPEskipCallPrimitive
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes squeak') -----
- IntegerclassPROTOTYPEinitialize
- 	"Integer initialize"	
- 	self initializeLowBitPerByteTable!

Item was removed:
- ----- Method: SpurBootstrap class>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category 'method prototypes squeak 4.3') -----
- MCClassDefinitionPROTOTYPEkindOfSubclass
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'method prototypes squeak 4.3') -----
- MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString classIsMeta: metaBoolean selector: selectorString category: catString timeStamp: timeString source: sourceString
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
- MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes squeak') -----
- MethodContextclassPROTOTYPEallInstances
- 	"Answer all instances of the receiver."
- 	<primitive: 177>
- 	"The primitive can fail because memory is low.  If so, fall back on the old
- 	 enumeration code, which gives the system a chance to GC and/or grow.
- 	 Because aBlock might change the class of inst (for example, using become:),
- 	 it is essential to compute next before aBlock value: inst.
- 	 Only count until thisContext since this context has been created only to
- 	 compute the existing instances."
- 	| inst insts next |
- 	insts := WriteStream on: (Array new: 64).
- 	inst := self someInstance.
- 	[inst == thisContext or: [inst == nil]] whileFalse:
- 		[next := inst nextInstance.
- 		 insts nextPut: inst.
- 		 inst := next].
- 	^insts contents!

Item was removed:
- ----- Method: SpurBootstrap class>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes squeak') -----
- MethodContextclassPROTOTYPEallInstancesDo: aBlock
- 	"Evaluate aBlock with each of the current instances of the receiver."
- 	| instances inst next |
- 	instances := self allInstancesOrNil.
- 	instances ifNotNil:
- 		[instances do: aBlock.
- 		 ^self].
- 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
- 	 enumeration code.  Because aBlock might change the class of inst (for example,
- 	 using become:), it is essential to compute next before aBlock value: inst.
- 	 Only count until thisContext since evaluation of aBlock will create new contexts."
- 	inst := self someInstance.
- 	[inst == thisContext or: [inst == nil]] whileFalse:
- 		[next := inst nextInstance.
- 		 aBlock value: inst.
- 		 inst := next]!

Item was removed:
- ----- Method: SpurBootstrap class>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes') -----
- MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer 
- 	"The receiver is the root of a parse tree. Answer a CompiledMethod.
- 	 The argument, trailer, is arbitrary but is typically either the reference
- 	 to the source code that is stored with every CompiledMethod, or an
- 	 encoding of the method's temporary names."
- 
- 	^self generate: trailer using: CompiledMethod!

Item was removed:
- ----- Method: SpurBootstrap class>>MethodNodePROTOTYPEgenerate:using: (in category 'method prototypes') -----
- MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
- 	"Since this method has inst var refs the prototype must live in the actual class."
- 
- 	<indirect>!

Item was removed:
- ----- Method: SpurBootstrap class>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes pharo') -----
- ProtoObjectPROTOTYPEidentityHash
- 	"Answer a SmallInteger whose value is related to the receiver's identity.
- 	 This method must not be overridden, except by SmallInteger.  As of
- 	 2014, the 32-bit Spur VM has 22 bits of hash and 31-bit SmallIntegers
- 	 (30 bits + 1 sign bit).  Shifting by 8 will not create large integers.
- 	
- 	 Do not override."
- 
- 	^self basicIdentityHash bitShift: 8!

Item was removed:
- ----- Method: SpurBootstrap class>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes squeak') -----
- ProtoObjectPROTOTYPEscaledIdentityHash
- 	"For identityHash values returned by primitive 75, answer
- 	 such values times 2^8.  Otherwise, match the existing
- 	 identityHash implementation"
- 
- 	^self identityHash * 256 "bitShift: 8"!

Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
- 	"Compute the new format for making oldClass a subclass of newSuper.
- 	 Answer the format or nil if there is any problem."
- 	| instSize isVar isWords isPointers isWeak |
- 	type == #compiledMethod ifTrue:
- 		[newInstSize > 0 ifTrue:
- 			[self error: 'A compiled method class cannot have named instance variables'.
- 			^nil].
- 		^CompiledMethod format].
- 	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
- 	instSize > 65535 ifTrue:
- 		[self error: 'Class has too many instance variables (', instSize printString,')'.
- 		^nil].
- 	type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
- 	type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
- 	type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
- 	type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
- 	type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
- 	type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
- 	type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
- 	(isPointers not and: [instSize > 0]) ifTrue:
- 		[self error: 'A non-pointer class cannot have named instance variables'.
- 		^nil].
- 	^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
- 	"Compute the format for the given instance specfication.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= reserved for 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := isWeak
- 					ifTrue:
- 						[isVar
- 							ifTrue: [4]
- 							ifFalse: [5]]
- 					ifFalse:
- 						[isPointers
- 							ifTrue:
- 								[isVar
- 									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
- 									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
- 							ifFalse:
- 								[isVar
- 									ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
- 									ifFalse: [7]]].
- 	^(instSpec bitShift: 16) + nInstVars!

Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEsuperclass: aClass
- 	immediateSubclass: t instanceVariableNames: f 
- 	classVariableNames: d poolDictionaries: s category: cat
- 	"This is the standard initialization message for creating a
- 	 new immediate class as a subclass of an existing class."
- 	| env |
- 	aClass instSize > 0
- 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
- 	aClass isVariable
- 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
- 	aClass isPointers
- 		ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
- 	"Cope with pre-environment and environment versions. Simplify asap."
- 	env := (Smalltalk classNamed: #EnvironmentRequest)
- 				ifNil: [aClass environment]
- 				ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
- 	^self 
- 		name: t
- 		inEnvironment: env
- 		subclassOf: aClass
- 		type: #immediate
- 		instanceVariableNames: f
- 		classVariableNames: d
- 		poolDictionaries: s
- 		category: cat!

Item was removed:
- ----- Method: SpurBootstrap class>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes pharo') -----
- SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass
- 	"Convert oldClass, all its instances and possibly its meta class into newClass,
- 	 instances of newClass and possibly its meta class. The process is surprisingly
- 	 simple in its implementation and surprisingly complex in its nuances and potentially
- 	 bad side effects.
- 	 We can rely on two assumptions (which are critical):
- 		#1: The method #updateInstancesFrom: will not create any lasting pointers to
- 			 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
- 			 a become of the old vs. the new instances and therefore it will not create
- 			 pointers to *new* instances before the #become: which are *old* afterwards)
- 		#2: The non-preemptive execution of the critical piece of code guarantees that
- 			 nobody can get a hold by 'other means' (such as process interruption and
- 			 reflection) on the old instances.
- 	 Given the above two, we know that after #updateInstancesFrom: there are no pointers
- 	 to any old instances. After the forwarding become there will be no pointers to the old
- 	 class or meta class either.
- 	 Andreas Raab, 2/27/2003 23:42"
- 	| meta |
- 	meta := oldClass isMeta.
- 	"Note: Everything from here on will run without the ability to get interrupted
- 	to prevent any other process to create new instances of the old class."
- 	["Note: The following removal may look somewhat obscure and needs an explanation.
- 	  When we mutate the class hierarchy we create new classes for any existing subclass.
- 	  So it may look as if we don't have to remove the old class from its superclass. However,
- 	  at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
- 	  created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
- 	  subclasses. Since the #become: below will transparently replace the pointers to oldClass
- 	  with newClass the superclass would have newClass in its subclasses TWICE. With rather
- 	  unclear effects if we consider that we may convert the meta-class hierarchy itself (which
- 	  is derived from the non-meta class hierarchy).
- 	  Due to this problem ALL classes are removed from their superclass just prior to converting
- 	  them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
- 	  effectively remove the oldClass (becomeForward:) just a few lines below."
- 
- 		oldClass superclass removeSubclass: oldClass.
- 		oldClass superclass removeObsoleteSubclass: oldClass.
- 
- 		"make sure that the VM cache is clean"
- 		oldClass methodDict do: [:cm | cm flushCache].
- 		
- 		"Convert the instances of oldClass into instances of newClass"
- 		newClass updateInstancesFrom: oldClass.
- 
- 		meta
- 			ifTrue:
- 				[oldClass becomeForward: newClass.
- 				 oldClass updateMethodBindingsTo: oldClass binding]
- 			ifFalse:
- 				[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
- 				 oldClass updateMethodBindingsTo: oldClass binding.
- 				 oldClass class updateMethodBindingsTo: oldClass class binding].
- 
- 		"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
- 		 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
- 		 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
- 		 updated references from the old objects to new objects but didn't destroy the old objects.
- 		 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
- 			valueUnpreemptively!

Item was removed:
- ----- Method: SpurBootstrap class>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
- SmallIntegerPROTOTYPEasCharacter
- 	<primitive: 170>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEcompactClassesArray
- 	"Smalltalk compactClassesArray"
- 	"Backward-compatibility support.  Spur does not have compact classes."
- 	^{}!

Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: numBytes
- 	"Grow memory by at least the requested number of bytes.
- 	 Primitive.  Essential. Fail if no memory is available."
- 	<primitive: 180>
- 	(numBytes isInteger and: [numBytes > 0]) ifTrue:
- 		[OutOfMemory signal].
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
- SmalltalkImagePROTOTYPEmaxIdentityHash
- 	"Answer the maximum identityHash value supported by the VM."
- 	<primitive: 176>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEnewSpecialObjectsArray (in category 'method prototypes pharo') -----
- SmalltalkImagePROTOTYPEnewSpecialObjectsArray
- 	"Smalltalk recreateSpecialObjectsArray"
- 	
- 	"To external package developers:
- 	**** DO NOT OVERRIDE THIS METHOD.  *****
- 	If you are writing a plugin and need additional special object(s) for your own use, 
- 	use addGCRoot() function and use own, separate special objects registry "
- 	
- 	"The Special Objects Array is an array of objects used by the Squeak virtual machine.
- 	 Its contents are critical and accesses to it by the VM are unchecked, so don't even
- 	 think of playing here unless you know what you are doing."
- 	| newArray |
- 	newArray := Array new: 60.
- 	"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: (self globals 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: ByteString.
- 	newArray at: 8 put: Array.
- 	newArray at: 9 put: Smalltalk.
- 	newArray at: 10 put: Float.
- 	newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
- 	newArray at: 12 put: nil. "was 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 primitiveGetSpecialObjectsArray at: 18) ifNil: [Semaphore new]). "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. "This is the process signalling low space."
- 	"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.
- 	 Cog inlines table into machine code at: prim so do not regenerate it.
- 	 This is nil in Spur, which has immediate Characters."
- 	newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25).
- 	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; an empty array in Spur"
- 	newArray at: 29 put: self compactClassesArray.
- 	newArray at: 30 put: ((self primitiveGetSpecialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
- 	newArray at: 31 put: ((self primitiveGetSpecialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- 	"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
- 	newArray at: 32 put: nil. "was the prototype Float"
- 	newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
- 	newArray at: 34 put: nil. "was the prototype Point"
- 	newArray at: 35 put: #cannotInterpret:.
- 	newArray at: 36 put: nil. "was the prototype MethodContext"
- 	newArray at: 37 put: BlockClosure.
- 	newArray at: 38 put: nil. "was the prototype BlockContext"
- 	"array of objects referred to by external code"
- 	newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39).	"external semaphores"
- 	newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
- 	newArray at: 41 put: ((self primitiveGetSpecialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
- 	newArray at: 42 put: ((self primitiveGetSpecialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- 	newArray at: 43 put: LargeNegativeInteger.
- 	"External objects for callout.
- 	 Note: Written so that one can actually completely remove the FFI."
- 	newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
- 	newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
- 	newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
- 	newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
- 	newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
- 	newArray at: 49 put: #aboutToReturn:through:.
- 	newArray at: 50 put: #run:with:in:.
- 	"51 reserved for immutability message"
- 	newArray at: 51 put: #attemptToAssign:withIndex:.
- 	newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
- 							#'bad argument' #'bad index'
- 							#'bad number of arguments'
- 							#'inappropriate operation'  #'unsupported operation'
- 							#'no modification' #'insufficient object memory'
- 							#'insufficient C memory' #'not found' #'bad method'
- 							#'internal error in named primitive machinery'
- 							#'object may move' #'resource limit exceeded'
- 							#'object is pinned' #'primitive write beyond end of object').
- 	"53 to 55 are for Alien"
- 	newArray at: 53 put: (self at: #Alien ifAbsent: []).
- 	newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- 	newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
- 
- 	"Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
- 	newArray at: 56 put: nil.
- 
- 	"reserved for foreign callback process"
- 	newArray at: 57 put: (self primitiveGetSpecialObjectsArray at: 57 ifAbsent: []).
- 
- 	newArray at: 58 put: #unusedBytecode.
- 	"59 reserved for Sista counter tripped message"
- 	newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
- 	"60 reserved for Sista class trap message"
- 	newArray at: 60 put: #classTrapFor:.
- 
- 	^newArray!

Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes squeak') -----
- SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
- 	"Smalltalk recreateSpecialObjectsArray"
- 	
- 	"To external package developers:
- 	**** DO NOT OVERRIDE THIS METHOD.  *****
- 	If you are writing a plugin and need additional special object(s) for your own use, 
- 	use addGCRoot() function and use own, separate special objects registry "
- 	
- 	"The Special Objects Array is an array of objects used by the Squeak virtual machine.
- 	 Its contents are critical and accesses to it by the VM are unchecked, so don't even
- 	 think of playing here unless you know what you are doing."
- 	| newArray |
- 	newArray := Array new: 60.
- 	"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: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
- 	"Numerous classes below used for type checking and instantiation"
- 	newArray at: 5 put: Bitmap.
- 	newArray at: 6 put: SmallInteger.
- 	newArray at: 7 put: ByteString.
- 	newArray at: 8 put: Array.
- 	newArray at: 9 put: Smalltalk.
- 	newArray at: 10 put: Float.
- 	newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
- 	newArray at: 12 put: nil. "was 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) ifNil: [Semaphore new]). "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. "This is the process signalling low space."
- 	"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.
- 	 Cog inlines table into machine code at: prim so do not regenerate it.
- 	 This is nil in Spur, which has immediate Characters."
- 	newArray at: 25 put: (self specialObjectsArray at: 25).
- 	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; an empty array in Spur"
- 	newArray at: 29 put: self compactClassesArray.
- 	newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
- 	newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
- 	"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
- 	newArray at: 32 put: nil. "was the prototype Float"
- 	newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
- 	newArray at: 34 put: nil. "was the prototype Point"
- 	newArray at: 35 put: #cannotInterpret:.
- 	newArray at: 36 put: nil. "was the prototype MethodContext"
- 	newArray at: 37 put: BlockClosure.
- 	newArray at: 38 put: nil. "was the prototype BlockContext"
- 	"array of objects referred to by external code"
- 	newArray at: 39 put: (self specialObjectsArray at: 39).	"external semaphores"
- 	newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
- 	newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
- 	newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
- 	newArray at: 43 put: LargeNegativeInteger.
- 	"External objects for callout.
- 	 Note: Written so that one can actually completely remove the FFI."
- 	newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
- 	newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
- 	newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
- 	newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
- 	newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
- 	newArray at: 49 put: #aboutToReturn:through:.
- 	newArray at: 50 put: #run:with:in:.
- 	"51 reserved for immutability message"
- 	newArray at: 51 put: #attemptToAssign:withIndex:.
- 	newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
- 							#'bad argument' #'bad index'
- 							#'bad number of arguments'
- 							#'inappropriate operation'  #'unsupported operation'
- 							#'no modification' #'insufficient object memory'
- 							#'insufficient C memory' #'not found' #'bad method'
- 							#'internal error in named primitive machinery'
- 							#'object may move' #'resource limit exceeded'
- 							#'object is pinned' #'primitive write beyond end of object').
- 	"53 to 55 are for Alien"
- 	newArray at: 53 put: (self at: #Alien ifAbsent: []).
- 	newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
- 	newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
- 
- 	"Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
- 	newArray at: 56 put: nil.
- 
- 	"reserved for foreign callback process"
- 	newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
- 
- 	newArray at: 58 put: #unusedBytecode.
- 	"59 reserved for Sista counter tripped message"
- 	newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
- 	"60 reserved for Sista class trap message"
- 	newArray at: 60 put: #classTrapFor:.
- 
- 	"Now replace the interpreter's reference in one atomic operation"
- 	self specialObjectsArray becomeForward: newArray!

Item was removed:
- ----- Method: SpurBootstrap class>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes squeak') -----
- SmalltalkImagePROTOTYPEsetGCParameters
- 	"Adjust the VM's default GC parameters to avoid too much tenuring.
- 	 Maybe this should be left to the VM?"
- 
- 	| proportion edenSize survivorSize averageObjectSize numObjects |
- 	proportion := 0.9. "tenure when 90% of pastSpace is full"
- 	edenSize := SmalltalkImage current vmParameterAt: 44.
- 	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- 	averageObjectSize := 8 * self wordSize. "a good approximation"
- 	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- 	SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

Item was removed:
- ----- Method: SpurBootstrap class>>SpaceTallyPROTOTYPEspaceForInstancesOf: (in category 'method prototypes') -----
- SpaceTallyPROTOTYPEspaceForInstancesOf: aClass
- 	"Answer a pair of the number of bytes consumed by all instances of the
- 	 given class, including their object headers, and the number of instances."
- 
- 	| instances total |
- 	instances := aClass allInstances.
- 	instances isEmpty ifTrue: [^#(0 0)].
- 	total := 0.
- 	aClass isVariable
- 		ifTrue:
- 			[instances do:
- 				[:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
- 		ifFalse:
- 			[total := instances size * aClass byteSizeOfInstance].
- 	^{ total. instances size }!

Item was removed:
- ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: numBytes
- 	"Grow memory by at least the requested number of bytes.
- 	 Primitive.  Fail if no memory is available.  Essential."
- 	<primitive: 180>
- 	^(numBytes isInteger and: [numBytes > 0])
- 		ifTrue: [OutOfMemory signal]
- 		ifFalse: [self primitiveFailed]!

Item was removed:
- ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
- SystemDictionaryPROTOTYPEmaxIdentityHash
- 	"Answer the maximum identityHash value supported by the VM."
- 	<primitive: 176>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes squeak') -----
- SystemDictionaryPROTOTYPEsetGCParameters
- 	"Adjust the VM's default GC parameters to avoid too much tenuring.
- 	 Maybe this should be left to the VM?"
- 
- 	| proportion edenSize survivorSize averageObjectSize numObjects |
- 	proportion := 0.9. "tenure when 90% of pastSpace is full"
- 	edenSize := SmalltalkImage current vmParameterAt: 44.
- 	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- 	averageObjectSize := 8 * self wordSize. "a good approximation"
- 	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- 	SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

Item was removed:
- ----- Method: SpurBootstrap class>>SystemNavigationPROTOTYPEallObjects (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjects
- 	"Answer an Array of all objects in the system.  Fail if
- 	 there isn't enough memory to instantiate the result."
- 	<primitive: 178>
- 	^self primitiveFailed!

Item was removed:
- ----- Method: SpurBootstrap class>>SystemNavigationPROTOTYPEallObjectsDo: (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjectsDo: aBlock 
- 	"Evaluate the argument, aBlock, for each object in the system, excluding immediates
- 	 such as SmallInteger and Character."
- 	self allObjectsOrNil
- 		ifNotNil: [:allObjects| allObjects do: aBlock]
- 		ifNil:
- 			["Fall back on the old single object primitive code.  With closures, this needs
- 			  to use an end marker (lastObject) since activation of the block will create
- 			  new contexts and cause an infinite loop.  The lastObject must be created
- 			  before calling someObject, so that the VM can settle the enumeration (e.g.
- 			  by flushing new space) as a side effect of  someObject"
- 			| object lastObject |
- 			lastObject := Object new.
- 			object := self someObject.
- 			[lastObject == object or: [0 == object]] whileFalse:
- 				[aBlock value: object.
- 				 object := object nextObject]]!

Item was removed:
- ----- Method: SpurBootstrap class>>SystemNavigationPROTOTYPEallObjectsOrNil (in category 'method prototypes') -----
- SystemNavigationPROTOTYPEallObjectsOrNil
- 	"Answer an Array of all objects in the system.  Fail if there isn't
- 	 enough memory to instantiate the result and answer nil."
- 	<primitive: 178>
- 	^nil!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEallInstances
- 	"Answer all instances of the receiver."
- 	self error: 'Traits does not have instances.'!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEallInstancesDo: aBlock
- 	"Evaluate aBlock with each of the current instances of the receiver."
- 	self error: 'Traits does not have instances.'!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEinstSpec (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEinstSpec
- 	"Answer the instance specification part of the format that defines what kind of object
- 	 an instance of the receiver is.  The formats are
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^(format bitShift: -16) bitAnd: 16r1F!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisBits
- 	"Answer whether the receiver contains just bits (not pointers).
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec >= 7!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisBytes
- 	"Answer whether the receiver has 8-bit instance variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	^self instSpec >= 16!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisEphemeronClass
- 	"Answer whether the receiver has ephemeral instance variables.  The garbage collector will
- 	 fire (queue for finalization) any ephemeron whose first instance variable is not referenced
- 	 other than from the transitive closure of references from ephemerons. Hence referring to
- 	 an object from the first inst var of an ephemeron will cause the ephemeron to fire when
- 	 the rest of the system does not refer to the object and that object is ready to be collected.
- 	 Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
- 	 from firing, ephemerons may act as the associations in weak dictionaries such that the value
- 	 (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
- 	 other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
- 	 pre-mortem finalization."
- 	^self instSpec = 5!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisImmediateClass
- 	"Answer whether the receiver has immediate instances.  Immediate instances
- 	 store their value in their object pointer, not in an object body.  Hence immediates
- 	 take no space and are immutable.  The immediates are distinguished by tag bits
- 	 in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
- 	 system SmallIntegers are 31-bit signed integers and Characters are 30-bit
- 	 unsigned character codes."
- 	^self instSpec = 7!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEisVariable
- 	"Answer whether the receiver has indexable variables.
- 	 Above Cog Spur the class format is
- 		<5 bits inst spec><16 bits inst size>
- 	 where the 5-bit inst spec is
- 			0	= 0 sized objects (UndefinedObject True False et al)
- 			1	= non-indexable objects with inst vars (Point et al)
- 			2	= indexable objects with no inst vars (Array et al)
- 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
- 			4	= weak indexable objects with inst vars (WeakArray et al)
- 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
- 			6	= unused
- 			7	= immediates (SmallInteger, Character)
- 			8	= unused
- 			9	= 64-bit indexable
- 		10-11	= 32-bit indexable (Bitmap)
- 		12-15	= 16-bit indexable
- 		16-23	= 8-bit indexable
- 		24-31	= compiled methods (CompiledMethod)"
- 	| instSpec |
- 	instSpec := self instSpec.
- 	^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

Item was removed:
- ----- Method: SpurBootstrap class>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes pharo') -----
- TraitBehaviorPROTOTYPEkindOfSubclass
- 	"Answer a String that is the keyword that describes the receiver's kind of subclass,
- 	 either a regular subclass, a variableSubclass, a variableByteSubclass,
- 	 a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
- 	 c.f. typeOfClass"
- 	^self isVariable
- 		ifTrue:
- 			[self isBits
- 				ifTrue:
- 					[self isBytes
- 						ifTrue: [' variableByteSubclass: ']
- 						ifFalse: [' variableWordSubclass: ']]
- 				ifFalse:
- 					[self isWeak
- 						ifTrue: [' weakSubclass: ']
- 						ifFalse: [' variableSubclass: ']]]
- 		ifFalse:
- 			[self isImmediateClass
- 				ifTrue: [' immediateSubclass: ']
- 				ifFalse:
- 					[self isEphemeronClass
- 						ifTrue: [' ephemeronSubclass: ']
- 						ifFalse: [' subclass: ']]]!

Item was removed:
- ----- Method: SpurBootstrap class>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes pharo') -----
- VirtualMachinePROTOTYPEsetGCParameters
- 	"Adjust the VM's default GC parameters to avoid too much tenuring.
- 	 Maybe this should be left to the VM?"
- 
- 	| proportion edenSize survivorSize averageObjectSize numObjects |
- 	proportion := 0.9. "tenure when 90% of pastSpace is full"
- 	edenSize := self parameterAt: 44.
- 	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
- 	averageObjectSize := 8 * self wordSize. "a good approximation"
- 	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
- 	self tenuringThreshold: numObjects  "tenure when more than this many objects survive the GC"!

Item was removed:
- ----- Method: SpurBootstrap class>>WideStringPROTOTYPEat: (in category 'method prototypes') -----
- WideStringPROTOTYPEat: index
- 	"Answer the Character stored in the field of the receiver indexed by the
- 	 argument.  Primitive.  Fail if the index argument is not an Integer or is out
- 	 of bounds.  Essential.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 63>
- 	^index isInteger
- 		ifTrue:
- 			[self errorSubscriptBounds: index]
- 		ifFalse:
- 			[index isNumber
- 				ifTrue: [self at: index asInteger]
- 				ifFalse: [self errorNonIntegerIndex]]!

Item was removed:
- ----- Method: SpurBootstrap class>>WideStringPROTOTYPEat:put: (in category 'method prototypes') -----
- WideStringPROTOTYPEat: index put: aCharacter
- 	"Store the Character into the field of the receiver indicated by the index.
- 	 Primitive.  Fail if the index is not an Integer or is out of bounds, or if the
- 	 argument is not a Character.  Essential.  See Object documentation whatIsAPrimitive."
- 
- 	<primitive: 64>
- 	^aCharacter isCharacter
- 		ifTrue:
- 			[index isInteger
- 				ifTrue: [self errorSubscriptBounds: index]
- 				ifFalse: [self errorNonIntegerIndex]]
- 		ifFalse:
- 			[self errorImproperStore]!

Item was changed:
  ----- Method: SpurBootstrap class>>bootstrapPharoImage: (in category 'utilities') -----
  bootstrapPharoImage: imageFileBaseName
+ 	| oldCompilerClass |
+ 	
+ 	oldCompilerClass := SmalltalkImage compilerClass.
+ 	[ 
+ 		SmalltalkImage compilerClass: Compiler. 
+ 		self bootstrapImage: imageFileBaseName type: 'pharo' ]
+ 	ensure: [ SmalltalkImage compilerClass: oldCompilerClass ].
+ 	!
- 	self bootstrapImage: imageFileBaseName type: 'pharo'!

Item was removed:
- ----- Method: SpurBootstrap class>>categoryForClass:meta:selector: (in category 'method prototype categorization') -----
- categoryForClass: className meta: isMeta selector: selector 
- 	^(isMeta
- 			ifTrue: [{ className. #class. selector }]
- 			ifFalse: [{ className. selector }])
- 		caseOf: {
- 			[#(Behavior allInstancesOrNil)]					-> [#enumerating].
- 			[#(Behavior byteSizeOfInstance)]				-> [#'accessing instances and variables'].
- 			[#(Behavior byteSizeOfInstanceOfSize:)]		-> [#'accessing instances and variables'].
- 			[#(Behavior elementSize)]						-> [#'accessing instances and variables'].
- 			[#(Behavior handleFailingBasicNew)]			-> [#private].
- 			[#(Behavior handleFailingBasicNew:)]			-> [#private].
- 			[#(Behavior handleFailingFailingBasicNew)]		-> [#private].
- 			[#(Behavior handleFailingFailingBasicNew:)]		-> [#private].
- 			[#(Behavior identityHash)]						-> [#comparing].
- 			[#(Behavior isEphemeronClass)]				-> [#testing].
- 			[#(Behavior isImmediateClass)]					-> [#testing].
- 			[#(Character identityHash)]						-> [#comparing].
- 			[#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
- 															-> [#'subclass creation'].
- 			[#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
- 															-> [#public].
- 			[#(CompiledMethod class handleFailingFailingNewMethod:header:)]
- 															-> [#private].
- 			[#(CompiledMethod class handleFailingNewMethod:header:)]
- 															-> [#private].
- 			[#(Context class allInstances)]					-> [#enumerating].
- 			[#(Context class allInstancesDo:)]				-> [#enumerating].
- 			[#(Context failPrimitiveWith:)]					-> [#'system simulation'].
- 			[#(Context isPrimFailToken:)]					-> [#private].
- 			[#(Context send:to:with:lookupIn:)]				-> [#controlling].
- 			[#(ContextPart isPrimFailToken:)]				-> [#private].
- 			[#(ContextPart send:to:with:lookupIn:)]			-> [#controlling].
- 			[#(CompiledMethod class headerFlagForEncoder:)]
- 															-> [#'method encoding'].
- 			[#(CompiledMethod class installPrimaryBytecodeSet:)]
- 															-> [#'class initialization'].
- 			[#(CompiledMethod class installSecondaryBytecodeSet:)]
- 															-> [#'class initialization'].
- 			[#(EncoderForV3PlusClosures genCallPrimitive:)]
- 															-> [#'bytecode generation'].
- 			[#(EncoderForV3PlusClosures class callPrimitiveCode)]
- 															-> [#'bytecode decoding'].
- 			[#(MethodContext failPrimitiveWith:)]			-> [#'system simulation'].
- 			[#(MethodContext class allInstances)]			-> [#enumerating].
- 			[#(MethodContext class allInstancesDo:)]		-> [#enumerating].
- 			[#(SmallInteger asCharacter)]					-> [#converting].
- 			[#(SmalltalkImage growMemoryByAtLeast:)]	-> [#'memory space'].
- 			[#(SmalltalkImage maxIdentityHash)]			-> [#'system attributes'].
- 			[#(SystemDictionary growMemoryByAtLeast:)]	-> [#'memory space'].
- 			[#(SystemDictionary maxIdentityHash)]			-> [#'system attributes'].
- 			[#(SystemDictionary setGCParameters)]		-> [#'snapshot and quit'].
- 			[#(SystemNavigation allObjects)]				-> [#query].
- 			[#(SystemNavigation allObjectsOrNil)]			-> [#query].
- 			 }
- 		otherwise:
- 			[Transcript nextPutAll: className.
- 			 isMeta ifTrue: [Transcript nextPutAll: ' class'].
- 			 Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush.
- 			 ^Categorizer default]!

Item was added:
+ ----- Method: SpurBootstrap>>allMethodPrototypes (in category 'method prototypes') -----
+ allMethodPrototypes
+ 	"Answer all prototype selectors, including those marked <remove>"
+ 	^imageTypes 
+ 		inject: Set new 
+ 		into: [:prototypes :type |
+ 				prototypes 
+ 					addAll: ((SpurBootstrapPrototypes prototypesFor: type) allMethodPrototypes);
+ 					yourself ]!

Item was changed:
  ----- Method: SpurBootstrap>>allPrototypeMethodSymbols (in category 'method prototypes') -----
  allPrototypeMethodSymbols
  	"self basicNew allPrototypeMethodSymbols"
  	| symbols |
+ 	"self assert: SpurBootstrap isolatedPrototypes isEmpty."
- 	self assert: SpurBootstrap isolatedPrototypes isEmpty.
  	symbols := Set new.
  	self prototypeClassNameMetaSelectorMethodDo:
  		[:className :isMeta :selector :method | | adder |
  		symbols
  			add: className;
  			add: selector.	
  		adder := [:lit|
  				   (lit isSymbol and: [lit ~~ method selector]) ifTrue: [symbols add: lit].
  				   lit isArray ifTrue: [lit do: adder]].
  		method literals do: adder].
  	^symbols!

Item was removed:
- ----- Method: SpurBootstrap>>allPrototypeSelectors (in category 'method prototypes') -----
- allPrototypeSelectors
- 	"Answer all prototype selectors, including those marked <remove>"
- 	^imageTypes
- 		inject: (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes')
- 		into: [:prototypes :type|
- 				prototypes, (SpurBootstrap class organization listAtCategoryNamed: #'method prototypes ', type)]!

Item was changed:
  ----- Method: SpurBootstrap>>bootstrapImageUsingFileReference: (in category 'public access') -----
  bootstrapImageUsingFileReference: imageName
  	| dirName baseName dir |
  	dirName := imageName asFileReference parent fullName.
  	baseName := (imageName endsWith: '.image')
  		ifTrue: [ imageName asFileReference base ]
  		ifFalse: [ (imageName, '.image') asFileReference base ].
  	dir := dirName asFileReference.
  	self on: (dir / (baseName, '.image')) fullName.
  	[self transform]
  		on: Halt
  		do: [:ex|
  			"suppress halts from the usual suspects (development time halts)"
  			(#(fullGC compactImage) includes: ex signalerContext sender selector)
  				ifTrue: [ex resume]
  				ifFalse: [ex pass]].
  	self writeSnapshot: (dir / (baseName, '-spur.image')) fullName
  		ofTransformedImage: newHeap
  		headerFlags: oldInterpreter getImageHeaderFlags
  		screenSize: oldInterpreter savedWindowSize.
  	(dir / (baseName, '.changes')) copyTo: (dir / (baseName, '-spur.changes'))!

Item was changed:
  ----- Method: SpurBootstrap>>findRequiredGlobals (in category 'bootstrap image') -----
  findRequiredGlobals
  	"Look for the necessary gobal bindings in the prototype methods in the old image.
  	 This has to be done early by sending bindingOf: to Smalltalk.  Collect the class
  	 hierarchy of all prototypes that access inst vars (non-local prototypes) to check
  	 their shapes.  Also find out Metaclass, needed for identifying classes."
  	| globals ourMethodClasses classVars bindingOfSym |
  	globals := Set new.
  	ourMethodClasses := Set new.
  	classVars := Dictionary new.
  	self prototypeClassNameMetaSelectorMethodDo:
  		[:c :m :s :method| | allNonMetaSupers |
  		(Smalltalk classNamed: c) ifNotNil:
  			[ :nonMetaClass|
  			allNonMetaSupers := nonMetaClass withAllSuperclasses.
+ 			(method methodClass includesBehavior: SpurBootstrapPrototypes) ifFalse:
+ 				[ourMethodClasses addAll: allNonMetaSupers.
+ 				 globals addAll: (allNonMetaSupers collect: [:sc| sc binding])].
- 			method methodClass ~= SpurBootstrap class ifTrue:
- 				[ourMethodClasses addAll: allNonMetaSupers].
- 			globals addAll: (allNonMetaSupers collect: [:sc| sc binding]).
  			method literals do:
  				[:l|
+ 				(l isVariableBinding and: [l key isSymbol and: [((SpurBootstrapPrototypes withAllSubclasses collect: #name) includes: l key) not]]) ifTrue:
- 				(l isVariableBinding and: [l key isSymbol]) ifTrue:
  					[(Smalltalk bindingOf: l key) == l
+ 						ifTrue: [ globals add: l]
- 						ifTrue: [globals add: l]
  						ifFalse:
  							[self assert: (nonMetaClass bindingOf: l key) == l.
  							classVars at: l put: nonMetaClass]]]]].
  	globals add: Compiler binding. "For potential reshaping in checkReshapeOf:"
  	bindingOfSym := self findSymbol: #bindingOf:.
  	self withExecutableInterpreter: oldInterpreter
  		do:	[| toBeAdded |
  			globals do:
  				[:global| | bindingOop |
  				bindingOop := self interpreter: oldInterpreter
  									object: (oldHeap splObj: 8) "Smalltalk"
  									perform: bindingOfSym
  									withArguments: {self findSymbol: global key}.
  				bindingOop ~= oldHeap nilObject ifTrue:
  					[literalMap at: global put: bindingOop]].
  			 toBeAdded := Dictionary new.
  			 classVars keysAndValuesDo:
  				[:var :class| | val |
  				(self findSymbol: var key) "New class inst vars may not yet be interned."
  					ifNil: [toBeAdded at: var put: class]
  					ifNotNil:
  						[:varName|
  						val := self interpreter: oldInterpreter
  									object: (self oldClassOopFor: class)
  									perform: bindingOfSym
  									withArguments: {varName}.
  						val ~= oldHeap nilObject
  							ifTrue: [literalMap at: var put: val]
  							ifFalse: [toBeAdded at: var put: class]]].
  			"May have to redefine to add missing inst vars and/or add any missing class vars."
  			self checkReshapeOf: ourMethodClasses.
  			self addMissingClassVars: toBeAdded]!

Item was changed:
  ----- Method: SpurBootstrap>>prototypeClassNameMetaSelectorMethodDo: (in category 'method prototypes') -----
  prototypeClassNameMetaSelectorMethodDo: quaternaryBlock
  	"Evaluate aBlock with class name, class is meta, method and selector.
  	 For now find methods in class-side category #'method prototypes'.
  	 Scheme could be extended to have different protocols for different
  	 Squeak/Pharo versions."
+ 	self allMethodPrototypes do:
+ 		[:method| | className isMeta |
- 	self allPrototypeSelectors do:
- 		[:protoSelector| | method className isMeta |
- 		method := SpurBootstrap class >> protoSelector.
  		className := self classNameForPrototypeMethod: method.
  		(isMeta := className endsWith: 'class') ifTrue:
  			[className := (className allButLast: 5) asSymbol].
  		(method pragmaAt: #indirect) ifNotNil:
  			[method := (isMeta
  							ifTrue: [(Smalltalk classNamed: className) class]
+ 							ifFalse: [Smalltalk classNamed: className]) >> method selector].
- 							ifFalse: [Smalltalk classNamed: className]) >> protoSelector].
  		quaternaryBlock
  			value: className
  			value: isMeta
  			value: (self selectorForPrototypeMethod: method)
  			value: method]!

Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapOldSqueakPrototypes
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurBootstrapOldSqueakPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ 	^ 'old squeak'!

Item was added:
+ ----- Method: SpurBootstrapOldSqueakPrototypes>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEinterpretV3ClosuresExtension: offset in: method for: client
+ 	| type offset2 byte2 byte3 byte4 |
+ 	offset <= 6 ifTrue: 
+ 		["Extended op codes 128-134"
+ 		byte2 := method at: pc. pc := pc + 1.
+ 		offset <= 2 ifTrue:
+ 			["128-130:  extended pushes and pops"
+ 			type := byte2 // 64.
+ 			offset2 := byte2 \\ 64.
+ 			offset = 0 ifTrue: 
+ 				[type = 0 ifTrue: [^client pushReceiverVariable: offset2].
+ 				type = 1 ifTrue: [^client pushTemporaryVariable: offset2].
+ 				type = 2  ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)].
+ 				type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]].
+ 			offset = 1 ifTrue: 
+ 				[type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2].
+ 				type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2].
+ 				type = 2 ifTrue: [self error: 'illegalStore'].
+ 				type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]].
+ 			offset = 2 ifTrue: 
+ 				[type = 0 ifTrue: [^client popIntoReceiverVariable: offset2].
+ 				type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2].
+ 				type = 2 ifTrue: [self error: 'illegalStore'].
+ 				type = 3  ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]].
+ 		"131-134: extended sends"
+ 		offset = 3 ifTrue:  "Single extended send"
+ 			[^client send: (method literalAt: byte2 \\ 32 + 1)
+ 					super: false numArgs: byte2 // 32].
+ 		offset = 4 ifTrue:    "Double extended do-anything"
+ 			[byte3 := method at: pc. pc := pc + 1.
+ 			type := byte2 // 32.
+ 			type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1)
+ 									super: false numArgs: byte2 \\ 32].
+ 			type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1)
+ 									super: true numArgs: byte2 \\ 32].
+ 			type = 2 ifTrue: [^client pushReceiverVariable: byte3].
+ 			type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)].
+ 			type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)].
+ 			type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3].
+ 			type = 6 ifTrue: [^client popIntoReceiverVariable: byte3].
+ 			type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]].
+ 		offset = 5 ifTrue:  "Single extended send to super"
+ 			[^client send: (method literalAt: byte2 \\ 32 + 1)
+ 					super: true
+ 					numArgs: byte2 // 32].
+ 		offset = 6 ifTrue:   "Second extended send"
+ 			[^client send: (method literalAt: byte2 \\ 64 + 1)
+ 					super: false
+ 					numArgs: byte2 // 64]].
+ 	offset = 7 ifTrue: [^client doPop].
+ 	offset = 8 ifTrue: [^client doDup].
+ 	offset = 9 ifTrue: [^client pushActiveContext].
+ 	byte2 := method at: pc. pc := pc + 1.
+ 	offset = 10 ifTrue:
+ 		[^byte2 < 128
+ 			ifTrue: [client pushNewArrayOfSize: byte2]
+ 			ifFalse: [client pushConsArrayWithElements: byte2 - 128]].
+ 	byte3 := method at: pc.  pc := pc + 1.
+ 	offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)].
+ 	offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3].
+ 	offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3].
+ 	offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3].
+ 	"offset = 15"
+ 	byte4 := method at: pc.  pc := pc + 1.
+ 	^client
+ 		pushClosureCopyNumCopiedValues: (byte2 bitShift: -4)
+ 		numArgs: (byte2 bitAnd: 16rF)
+ 		blockSize: (byte3 * 256) + byte4!

Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapPharoPrototypes
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ 	^ 'pharo'!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPEbasicIdentityHash (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbasicIdentityHash
+ 	"Answer a SmallInteger whose value is related to the receiver's identity.
+ 	 Behavior implements identityHash to allow the VM to use an object representation which
+ 	 does not include a direct reference to an object's class in an object.  If the VM is using
+ 	 this implementation then classes are held in a class table and instances contain the index
+ 	 of their class in the table.  A class's class table index is its identityHash so that an instance
+ 	 can be created without searching the table for a class's index.  The VM uses this primitive
+ 	 to enter the class into the class table, assigning its identityHash with an as yet unused
+ 	 class table index. If this primitive fails it means that the class table is full.  In Spur as of
+ 	 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+ 
+ 	 Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 175>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>BehaviorPROTOTYPElargeIdentityHash (in category 'method prototypes') -----
+ BehaviorPROTOTYPElargeIdentityHash
+ 	"Answer a SmallInteger whose value is related to the receiver's identity.
+ 	 Behavior implements identityHash to allow the VM to use an object representation which
+ 	 does not include a direct reference to an object's class in an object.  If the VM is using
+ 	 this implementation then classes are held in a class table and instances contain the index
+ 	 of their class in the table.  A class's class table index is its identityHash so that an instance
+ 	 can be created without searching the table for a class's index.  The VM uses this primitive
+ 	 to enter the class into the class table, assigning its identityHash with an as yet unused
+ 	 class table index. If this primitive fails it means that the class table is full.  In Spur as of
+ 	 2014 there are 22 bits of classTable index and 22 bits of identityHash per object."
+ 
+ 	<primitive: 175>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEcodePoint (in category 'method prototypes') -----
+ CharacterPROTOTYPEcodePoint
+ 	"Just for ANSI Compliance"	
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEsetValue: (in category 'method prototypes') -----
+ CharacterPROTOTYPEsetValue: newValue
+ 	self error: 'Characters are immutable'!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
+ CharacterPROTOTYPEshallowCopy
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
+ ContextPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: aReceiver args: arguments 
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
+ ContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
+ ContextPROTOTYPEisPrimFailToken: anObject
+ 	<indirect>
+ !

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
+ ContextclassPROTOTYPEallInstances
+ 	"Answer all instances of the receiver."
+ 	<primitive: 177>
+ 	"The primitive can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code, which gives the system a chance to GC and/or grow.
+ 	 Because aBlock might change the class of inst (for example, using become:),
+ 	 it is essential to compute next before aBlock value: inst.
+ 	 Only count until thisContext since this context has been created only to
+ 	 compute the existing instances."
+ 	| inst insts next |
+ 	insts := WriteStream on: (Array new: 64).
+ 	inst := self someInstance.
+ 	[inst == thisContext or: [inst == nil]] whileFalse:
+ 		[next := inst nextInstance.
+ 		 insts nextPut: inst.
+ 		 inst := next].
+ 	^insts contents!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ ContextclassPROTOTYPEallInstancesDo: aBlock
+ 	"Evaluate aBlock with each of the current instances of the receiver."
+ 	| instances inst next |
+ 	instances := self allInstancesOrNil.
+ 	instances ifNotNil:
+ 		[instances do: aBlock.
+ 		 ^self].
+ 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code.  Because aBlock might change the class of inst (for example,
+ 	 using become:), it is essential to compute next before aBlock value: inst.
+ 	 Only count until thisContext since evaluation of aBlock will create new contexts."
+ 	inst := self someInstance.
+ 	[inst == thisContext or: [inst == nil]] whileFalse:
+ 		[next := inst nextInstance.
+ 		 aBlock value: inst.
+ 		 inst := next]!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>ProtoObjectPROTOTYPEidentityHash (in category 'method prototypes') -----
+ ProtoObjectPROTOTYPEidentityHash
+ 	"Answer a SmallInteger whose value is related to the receiver's identity.
+ 	 This method must not be overridden, except by SmallInteger.  As of
+ 	 2014, the 32-bit Spur VM has 22 bits of hash and 31-bit SmallIntegers
+ 	 (30 bits + 1 sign bit).  Shifting by 8 will not create large integers.
+ 	
+ 	 Do not override."
+ 
+ 	^self basicIdentityHash bitShift: 8!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
+ 	"Compute the new format for making oldClass a subclass of newSuper.
+ 	 Answer the format or nil if there is any problem."
+ 	| instSize isVar isWords isPointers isWeak |
+ 	type == #compiledMethod ifTrue:
+ 		[newInstSize > 0 ifTrue:
+ 			[self error: 'A compiled method class cannot have named instance variables'.
+ 			^nil].
+ 		^CompiledMethod format].
+ 	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ 	instSize > 65535 ifTrue:
+ 		[self error: 'Class has too many instance variables (', instSize printString,')'.
+ 		^nil].
+ 	type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
+ 	type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
+ 	type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
+ 	type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
+ 	type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ 	type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ 	type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ 	(isPointers not and: [instSize > 0]) ifTrue:
+ 		[self error: 'A non-pointer class cannot have named instance variables'.
+ 		^nil].
+ 	^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
+ 	"Compute the format for the given instance specfication.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= reserved for 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	| instSpec |
+ 	instSpec := isWeak
+ 					ifTrue:
+ 						[isVar
+ 							ifTrue: [4]
+ 							ifFalse: [5]]
+ 					ifFalse:
+ 						[isPointers
+ 							ifTrue:
+ 								[isVar
+ 									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
+ 									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
+ 							ifFalse:
+ 								[isVar
+ 									ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
+ 									ifFalse: [7]]].
+ 	^(instSpec bitShift: 16) + nInstVars!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEsuperclass: aClass
+ 	immediateSubclass: t instanceVariableNames: f 
+ 	classVariableNames: d poolDictionaries: s category: cat
+ 	"This is the standard initialization message for creating a
+ 	 new immediate class as a subclass of an existing class."
+ 	| env |
+ 	aClass instSize > 0
+ 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ 	aClass isVariable
+ 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ 	aClass isPointers
+ 		ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ 	"Cope with pre-environment and environment versions. Simplify asap."
+ 	env := (Smalltalk classNamed: #EnvironmentRequest)
+ 				ifNil: [aClass environment]
+ 				ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ 	^self 
+ 		name: t
+ 		inEnvironment: env
+ 		subclassOf: aClass
+ 		type: #immediate
+ 		instanceVariableNames: f
+ 		classVariableNames: d
+ 		poolDictionaries: s
+ 		category: cat!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SlotClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
+ SlotClassBuilderPROTOTYPEupdate: oldClass to: newClass
+ 	"Convert oldClass, all its instances and possibly its meta class into newClass,
+ 	 instances of newClass and possibly its meta class. The process is surprisingly
+ 	 simple in its implementation and surprisingly complex in its nuances and potentially
+ 	 bad side effects.
+ 	 We can rely on two assumptions (which are critical):
+ 		#1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 			 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ 			 a become of the old vs. the new instances and therefore it will not create
+ 			 pointers to *new* instances before the #become: which are *old* afterwards)
+ 		#2: The non-preemptive execution of the critical piece of code guarantees that
+ 			 nobody can get a hold by 'other means' (such as process interruption and
+ 			 reflection) on the old instances.
+ 	 Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ 	 to any old instances. After the forwarding become there will be no pointers to the old
+ 	 class or meta class either.
+ 	 Andreas Raab, 2/27/2003 23:42"
+ 	| meta |
+ 	meta := oldClass isMeta.
+ 	"Note: Everything from here on will run without the ability to get interrupted
+ 	to prevent any other process to create new instances of the old class."
+ 	["Note: The following removal may look somewhat obscure and needs an explanation.
+ 	  When we mutate the class hierarchy we create new classes for any existing subclass.
+ 	  So it may look as if we don't have to remove the old class from its superclass. However,
+ 	  at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ 	  created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ 	  subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ 	  with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ 	  unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ 	  is derived from the non-meta class hierarchy).
+ 	  Due to this problem ALL classes are removed from their superclass just prior to converting
+ 	  them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ 	  effectively remove the oldClass (becomeForward:) just a few lines below."
+ 
+ 		oldClass superclass removeSubclass: oldClass.
+ 		oldClass superclass removeObsoleteSubclass: oldClass.
+ 
+ 		"make sure that the VM cache is clean"
+ 		oldClass methodDict do: [:cm | cm flushCache].
+ 		
+ 		"Convert the instances of oldClass into instances of newClass"
+ 		newClass updateInstancesFrom: oldClass.
+ 
+ 		meta
+ 			ifTrue:
+ 				[oldClass becomeForward: newClass.
+ 				 oldClass updateMethodBindingsTo: oldClass binding]
+ 			ifFalse:
+ 				[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
+ 				 oldClass updateMethodBindingsTo: oldClass binding.
+ 				 oldClass class updateMethodBindingsTo: oldClass class binding].
+ 
+ 		"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ 		 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
+ 		 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
+ 		 updated references from the old objects to new objects but didn't destroy the old objects.
+ 		 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ 			valueUnpreemptively!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>SmalltalkImagePROTOTYPEnewSpecialObjectsArray (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEnewSpecialObjectsArray
+ 	"Smalltalk recreateSpecialObjectsArray"
+ 	
+ 	"To external package developers:
+ 	**** DO NOT OVERRIDE THIS METHOD.  *****
+ 	If you are writing a plugin and need additional special object(s) for your own use, 
+ 	use addGCRoot() function and use own, separate special objects registry "
+ 	
+ 	"The Special Objects Array is an array of objects used by the Squeak virtual machine.
+ 	 Its contents are critical and accesses to it by the VM are unchecked, so don't even
+ 	 think of playing here unless you know what you are doing."
+ 	| newArray |
+ 	newArray := Array new: 60.
+ 	"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: (self globals 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: ByteString.
+ 	newArray at: 8 put: Array.
+ 	newArray at: 9 put: Smalltalk.
+ 	newArray at: 10 put: Float.
+ 	newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
+ 	newArray at: 12 put: nil. "was 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 primitiveGetSpecialObjectsArray at: 18) ifNil: [Semaphore new]). "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. "This is the process signalling low space."
+ 	"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.
+ 	 Cog inlines table into machine code at: prim so do not regenerate it.
+ 	 This is nil in Spur, which has immediate Characters."
+ 	newArray at: 25 put: (self primitiveGetSpecialObjectsArray at: 25).
+ 	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; an empty array in Spur"
+ 	newArray at: 29 put: self compactClassesArray.
+ 	newArray at: 30 put: ((self primitiveGetSpecialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
+ 	newArray at: 31 put: ((self primitiveGetSpecialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
+ 	"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
+ 	newArray at: 32 put: nil. "was the prototype Float"
+ 	newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
+ 	newArray at: 34 put: nil. "was the prototype Point"
+ 	newArray at: 35 put: #cannotInterpret:.
+ 	newArray at: 36 put: nil. "was the prototype MethodContext"
+ 	newArray at: 37 put: BlockClosure.
+ 	newArray at: 38 put: nil. "was the prototype BlockContext"
+ 	"array of objects referred to by external code"
+ 	newArray at: 39 put: (self primitiveGetSpecialObjectsArray at: 39).	"external semaphores"
+ 	newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
+ 	newArray at: 41 put: ((self primitiveGetSpecialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ 	newArray at: 42 put: ((self primitiveGetSpecialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
+ 	newArray at: 43 put: LargeNegativeInteger.
+ 	"External objects for callout.
+ 	 Note: Written so that one can actually completely remove the FFI."
+ 	newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
+ 	newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
+ 	newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
+ 	newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
+ 	newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
+ 	newArray at: 49 put: #aboutToReturn:through:.
+ 	newArray at: 50 put: #run:with:in:.
+ 	"51 reserved for immutability message"
+ 	newArray at: 51 put: #attemptToAssign:withIndex:.
+ 	newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
+ 							#'bad argument' #'bad index'
+ 							#'bad number of arguments'
+ 							#'inappropriate operation'  #'unsupported operation'
+ 							#'no modification' #'insufficient object memory'
+ 							#'insufficient C memory' #'not found' #'bad method'
+ 							#'internal error in named primitive machinery'
+ 							#'object may move' #'resource limit exceeded'
+ 							#'object is pinned' #'primitive write beyond end of object').
+ 	"53 to 55 are for Alien"
+ 	newArray at: 53 put: (self at: #Alien ifAbsent: []).
+ 	newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
+ 	newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
+ 
+ 	"Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
+ 	newArray at: 56 put: nil.
+ 
+ 	"reserved for foreign callback process"
+ 	newArray at: 57 put: (self primitiveGetSpecialObjectsArray at: 57 ifAbsent: []).
+ 
+ 	newArray at: 58 put: #unusedBytecode.
+ 	"59 reserved for Sista counter tripped message"
+ 	newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
+ 	"60 reserved for Sista class trap message"
+ 	newArray at: 60 put: #classTrapFor:.
+ 
+ 	^newArray!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEallInstances
+ 	"Answer all instances of the receiver."
+ 	self error: 'Traits does not have instances.'!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEallInstancesDo: aBlock
+ 	"Evaluate aBlock with each of the current instances of the receiver."
+ 	self error: 'Traits does not have instances.'!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEinstSpec
+ 	"Answer the instance specification part of the format that defines what kind of object
+ 	 an instance of the receiver is.  The formats are
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^(self format bitShift: -16) bitAnd: 16r1F!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBits (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisBits
+ 	"Answer whether the receiver contains just bits (not pointers).
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^self instSpec >= 7!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisBytes
+ 	"Answer whether the receiver has 8-bit instance variables.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^self instSpec >= 16!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisEphemeronClass
+ 	"Answer whether the receiver has ephemeral instance variables.  The garbage collector will
+ 	 fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ 	 other than from the transitive closure of references from ephemerons. Hence referring to
+ 	 an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ 	 the rest of the system does not refer to the object and that object is ready to be collected.
+ 	 Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ 	 from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ 	 (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ 	 other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
+ 	 pre-mortem finalization."
+ 	^self instSpec = 5!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisImmediateClass
+ 	"Answer whether the receiver has immediate instances.  Immediate instances
+ 	 store their value in their object pointer, not in an object body.  Hence immediates
+ 	 take no space and are immutable.  The immediates are distinguished by tag bits
+ 	 in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
+ 	 system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ 	 unsigned character codes."
+ 	^self instSpec = 7!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEisVariable
+ 	"Answer whether the receiver has indexable variables.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	| instSpec |
+ 	instSpec := self instSpec.
+ 	^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>TraitBehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
+ TraitBehaviorPROTOTYPEkindOfSubclass
+ 	"Answer a String that is the keyword that describes the receiver's kind of subclass,
+ 	 either a regular subclass, a variableSubclass, a variableByteSubclass,
+ 	 a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ 	 c.f. typeOfClass"
+ 	^self isVariable
+ 		ifTrue:
+ 			[self isBits
+ 				ifTrue:
+ 					[self isBytes
+ 						ifTrue: [' variableByteSubclass: ']
+ 						ifFalse: [' variableWordSubclass: ']]
+ 				ifFalse:
+ 					[self isWeak
+ 						ifTrue: [' weakSubclass: ']
+ 						ifFalse: [' variableSubclass: ']]]
+ 		ifFalse:
+ 			[self isImmediateClass
+ 				ifTrue: [' immediateSubclass: ']
+ 				ifFalse:
+ 					[self isEphemeronClass
+ 						ifTrue: [' ephemeronSubclass: ']
+ 						ifFalse: [' subclass: ']]]!

Item was added:
+ ----- Method: SpurBootstrapPharoPrototypes>>VirtualMachinePROTOTYPEsetGCParameters (in category 'method prototypes') -----
+ VirtualMachinePROTOTYPEsetGCParameters
+ 	"Adjust the VM's default GC parameters to avoid too much tenuring.
+ 	 Maybe this should be left to the VM?"
+ 
+ 	| proportion edenSize survivorSize averageObjectSize numObjects |
+ 	proportion := 0.9. "tenure when 90% of pastSpace is full"
+ 	edenSize := self parameterAt: 44.
+ 	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ 	averageObjectSize := 8 * self wordSize. "a good approximation"
+ 	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ 	self tenuringThreshold: numObjects  "tenure when more than this many objects survive the GC"!

Item was added:
+ Object subclass: #SpurBootstrapPrototypes
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurBootstrapPrototypes class>>imageType (in category 'accessing') -----
+ imageType 
+ 	^ self subclassResponsibility!

Item was added:
+ ----- Method: SpurBootstrapPrototypes class>>prototypesFor: (in category 'instance creation') -----
+ prototypesFor: type 
+ 	^ (self allSubclasses 
+ 		detect: [ :aClass | aClass imageType = type ])
+ 		new
+ 	!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstances (in category 'method prototypes') -----
+ BehaviorPROTOTYPEallInstances
+ 	"Answer all instances of the receiver."
+ 	<primitive: 177>
+ 	"The primitive can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code, which gives the system a chance to GC and/or grow.
+ 	 Because aBlock might change the class of inst (for example, using become:),
+ 	 it is essential to compute next before aBlock value: inst."
+ 	| inst insts next |
+ 	insts := WriteStream on: (Array new: 64).
+ 	inst := self someInstance.
+ 	[inst == nil] whileFalse:
+ 		[next := inst nextInstance.
+ 		 (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst].
+ 		 inst := next].
+ 	^insts contents!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEallInstancesDo: aBlock
+ 	"Evaluate aBlock with each of the current instances of the receiver."
+ 	| instances inst next |
+ 	instances := self allInstancesOrNil.
+ 	instances ifNotNil:
+ 		[instances do: aBlock.
+ 		 ^self].
+ 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code.  Because aBlock might change the class of inst (for example,
+ 	 using become:), it is essential to compute next before aBlock value: inst."
+ 	inst := self someInstance.
+ 	[inst == nil] whileFalse:
+ 		[next := inst nextInstance.
+ 		 aBlock value: inst.
+ 		 inst := next]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEallInstancesOrNil (in category 'method prototypes') -----
+ BehaviorPROTOTYPEallInstancesOrNil
+ 	"Answer all instances of the receiver, or nil if the primitive
+ 	 fails, which it may be due to being out of memory."
+ 	<primitive: 177>
+ 	^nil!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbasicNew
+ 	"Primitive. Answer an instance of the receiver (which is a class) with no 
+ 	 indexable variables. Fail if the class is indexable. Essential. See Object 
+ 	 documentation whatIsAPrimitive.
+ 	
+ 	 If the primitive fails because space is low then the scavenger will run
+ 	 before the method is activated.  Check that space was low and retry
+ 	 via handleFailingBasicNew if so."
+ 
+ 	<primitive: 70 error: ec>
+ 	ec == #'insufficient object memory' ifTrue:
+ 		[^self handleFailingBasicNew].
+ 	self isVariable ifTrue: [^self basicNew: 0].
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbasicNew: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbasicNew: sizeRequested
+ 	"Primitive. Answer an instance of this class with the number of indexable
+ 	 variables specified by the argument, sizeRequested.  Fail if this class is not
+ 	 indexable or if the argument is not a positive Integer, or if there is not
+ 	 enough memory available. Essential. See Object documentation whatIsAPrimitive.
+ 	
+ 	 If the primitive fails because space is low then the scavenger will run before the
+ 	 method is activated.  Check args and retry via handleFailingBasicNew: if they're OK."
+ 
+ 	<primitive: 71 error: ec>
+ 	ec == #'insufficient object memory' ifTrue:
+ 		[^self handleFailingBasicNew: sizeRequested].
+ 	self isVariable ifFalse:
+ 		[self error: self printString, ' cannot have variable sized instances'].
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstance (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbyteSizeOfInstance
+ 	"Answer the total memory size of an instance of the receiver."
+ 
+ 	<primitive: 181 error: ec>
+ 	self isVariable ifTrue:
+ 		[^self byteSizeOfInstanceOfSize: 0].
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEbyteSizeOfInstanceOfSize: basicSize
+ 	"Answer the total memory size of an instance of the receiver
+ 	 with the given number of indexable instance variables."
+ 
+ 	<primitive: 181 error: ec>
+ 	self isVariable
+ 		ifTrue: "If the primitive overflowed answer a close approximation"
+ 			[(basicSize isInteger
+ 			  and: [basicSize >= 16r1000000]) ifTrue:
+ 				[^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2)
+ 				   - (self byteSizeOfInstanceOfSize: 0)]]
+ 		ifFalse:
+ 			[basicSize = 0 ifTrue:
+ 				[^self byteSizeOfInstance]].
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEelementSize (in category 'method prototypes') -----
+ BehaviorPROTOTYPEelementSize
+ 	"Answer the size in bytes of an element in the receiver.  The formats are
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	| instSpec |
+ 	instSpec := self instSpec.
+ 	instSpec < 9 ifTrue: [^Smalltalk wordSize].
+ 	instSpec >= 16 ifTrue: [^1].
+ 	instSpec >= 12 ifTrue: [^2].
+ 	instSpec >= 10 ifTrue: [^4].
+ 	^8!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingBasicNew
+ 	"handleFailingBasicNew gets sent after basicNew has failed and allowed
+ 	 a scavenging garbage collection to occur.  The scavenging collection
+ 	 will have happened as the VM is activating the (failing) basicNew.  If
+ 	 handleFailingBasicNew fails then the scavenge failed to reclaim sufficient
+ 	 space and a global garbage collection is required.  Retry after garbage
+ 	 collecting and growing memory if necessary.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable
+ 	 variables specified by the argument, sizeRequested.  Fail if this class is not
+ 	 indexable or if the argument is not a positive Integer, or if there is not
+ 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 70>
+ 	Smalltalk garbageCollect < 1048576 ifTrue:
+ 		[Smalltalk growMemoryByAtLeast: 1048576].
+ 	^self handleFailingFailingBasicNew "retry after global garbage collect"!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingBasicNew: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingBasicNew: sizeRequested
+ 	"handleFailingBasicNew: gets sent after basicNew: has failed and allowed
+ 	 a scavenging garbage collection to occur.  The scavenging collection
+ 	 will have happened as the VM is activating the (failing) basicNew:.  If
+ 	 handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
+ 	 space and a global garbage collection is required.  Retry after garbage
+ 	 collecting and growing memory if necessary.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable
+ 	 variables specified by the argument, sizeRequested.  Fail if this class is not
+ 	 indexable or if the argument is not a positive Integer, or if there is not
+ 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 71>
+ 	| bytesRequested |
+ 	bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested.
+ 	Smalltalk garbageCollect < bytesRequested ifTrue:
+ 		[Smalltalk growMemoryByAtLeast: bytesRequested].
+ 	"retry after global garbage collect and possible grow"
+ 	^self handleFailingFailingBasicNew: sizeRequested!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingFailingBasicNew
+ 	"This basicNew gets sent after handleFailingBasicNew: has done a full
+ 	 garbage collection and possibly grown memory.  If this basicNew fails
+ 	 then the system really is low on space, so raise the OutOfMemory signal.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable
+ 	 variables specified by the argument, sizeRequested.  Fail if this class is not
+ 	 indexable or if the argument is not a positive Integer, or if there is not
+ 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 70>
+ 	"space must be low"
+ 	OutOfMemory signal.
+ 	^self basicNew  "retry if user proceeds"!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEhandleFailingFailingBasicNew: (in category 'method prototypes') -----
+ BehaviorPROTOTYPEhandleFailingFailingBasicNew: sizeRequested
+ 	"This basicNew: gets sent after handleFailingBasicNew: has done a full
+ 	 garbage collection and possibly grown memory.  If this basicNew: fails
+ 	 then the system really is low on space, so raise the OutOfMemory signal.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable
+ 	 variables specified by the argument, sizeRequested.  Fail if this class is not
+ 	 indexable or if the argument is not a positive Integer, or if there is not
+ 	 enough memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 71>
+ 	"space must be low."
+ 	OutOfMemory signal.
+ 	^self basicNew: sizeRequested  "retry if user proceeds"!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEindexIfCompact (in category 'method prototypes') -----
+ BehaviorPROTOTYPEindexIfCompact
+ 	"Backward compatibility with the Squeak V3 object format.
+ 	 Spur does not have a distinction between compact and non-compact classes."
+ 	^0!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSize (in category 'method prototypes') -----
+ BehaviorPROTOTYPEinstSize
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEinstSpec (in category 'method prototypes') -----
+ BehaviorPROTOTYPEinstSpec
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBits (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisBits
+ 	"Answer whether the receiver contains just bits (not pointers).
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^self instSpec >= 7!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisBytes (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisBytes
+ 	"Answer whether the receiver has 8-bit instance variables.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	^self instSpec >= 16!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisEphemeronClass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisEphemeronClass
+ 	"Answer whether the receiver has ephemeral instance variables.  The garbage collector will
+ 	 fire (queue for finalization) any ephemeron whose first instance variable is not referenced
+ 	 other than from the transitive closure of references from ephemerons. Hence referring to
+ 	 an object from the first inst var of an ephemeron will cause the ephemeron to fire when
+ 	 the rest of the system does not refer to the object and that object is ready to be collected.
+ 	 Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron
+ 	 from firing, ephemerons may act as the associations in weak dictionaries such that the value
+ 	 (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced
+ 	 other than from ephemerons.  Ephemerons can therefore be used to implement instance-based
+ 	 pre-mortem finalization."
+ 	^self instSpec = 5!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisImmediateClass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisImmediateClass
+ 	"Answer whether the receiver has immediate instances.  Immediate instances
+ 	 store their value in their object pointer, not in an object body.  Hence immediates
+ 	 take no space and are immutable.  The immediates are distinguished by tag bits
+ 	 in the pointer. They include SmallIntegers and Characters.  Hence in the 32-bit
+ 	 system SmallIntegers are 31-bit signed integers and Characters are 30-bit
+ 	 unsigned character codes."
+ 	^self instSpec = 7!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEisVariable (in category 'method prototypes') -----
+ BehaviorPROTOTYPEisVariable
+ 	"Answer whether the receiver has indexable variables.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	| instSpec |
+ 	instSpec := self instSpec.
+ 	^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEkindOfSubclass
+ 	"Answer a String that is the keyword that describes the receiver's kind of subclass,
+ 	 either a regular subclass, a variableSubclass, a variableByteSubclass,
+ 	 a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass.
+ 	 c.f. typeOfClass"
+ 	^self isVariable
+ 		ifTrue:
+ 			[self isBits
+ 				ifTrue:
+ 					[self isBytes
+ 						ifTrue: [' variableByteSubclass: ']
+ 						ifFalse: [' variableWordSubclass: ']]
+ 				ifFalse:
+ 					[self isWeak
+ 						ifTrue: [' weakSubclass: ']
+ 						ifFalse: [' variableSubclass: ']]]
+ 		ifFalse:
+ 			[self isImmediateClass
+ 				ifTrue: [' immediateSubclass: ']
+ 				ifFalse:
+ 					[self isEphemeronClass
+ 						ifTrue: [' ephemeronSubclass: ']
+ 						ifFalse: [' subclass: ']]]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEshouldNotBeRedefined (in category 'method prototypes') -----
+ BehaviorPROTOTYPEshouldNotBeRedefined
+ 	"Answer if the receiver should not be redefined.
+ 	 The assumption is that classes in Smalltalk specialObjects and 
+ 	 instance-specific Behaviors should not be redefined"
+ 
+ 	^(Smalltalk specialObjectsArray
+ 		identityIndexOf: self
+ 		ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BehaviorPROTOTYPEtypeOfClass (in category 'method prototypes') -----
+ BehaviorPROTOTYPEtypeOfClass
+ 	"Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass"
+ 	self isBytes ifTrue:
+ 		[^self instSpec = CompiledMethod instSpec
+ 			ifTrue: [#compiledMethod] "Very special!!"
+ 			ifFalse: [#bytes]].
+ 	(self isWords and: [self isPointers not]) ifTrue:
+ 		[^self instSpec = SmallInteger instSpec
+ 			ifTrue: [#immediate] "Very special!!"
+ 			ifFalse: [#words]].
+ 	self isWeak ifTrue: [^#weak].
+ 	self isVariable ifTrue: [^#variable].
+ 	self isEphemeronClass ifTrue: [^#ephemeron].
+ 	^#normal!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BlockClosurePROTOTYPEsimulateValueWithArguments:caller: (in category 'method prototypes') -----
+ BlockClosurePROTOTYPEsimulateValueWithArguments: anArray caller: aContext
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
+ BytecodeEncoderPROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
+ 	numArgs > 15 ifTrue:
+ 		[^self error: 'Cannot compile -- too many arguments'].
+ 	numTemps > 63 ifTrue:
+ 		[^self error: 'Cannot compile -- too many temporary variables'].	
+ 	numLits > 65535 ifTrue:
+ 		[^self error: 'Cannot compile -- too many literals'].
+ 	^(CompiledMethod headerFlagForEncoder: self)
+ 	+ (numArgs bitShift: 24)
+ 	+ (numTemps bitShift: 18)
+ 	"+ (largeBit bitShift: 17)" "largeBit gets filled in later"
+ 	+ (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0])
+ 	+ numLits!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>BytecodeEncoderPROTOTYPEsizeCallPrimitive: (in category 'method prototypes') -----
+ BytecodeEncoderPROTOTYPEsizeCallPrimitive: primitiveIndex
+ 	^self sizeOpcodeSelector: #genCallPrimitive: withArguments: {primitiveIndex}!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEDollarEquals: (in category 'method prototypes') -----
+ CharacterPROTOTYPEDollarEquals: aCharacter 
+ 	"Primitive. Answer if the receiver and the argument are the
+ 	 same object (have the same object pointer). Optional. See
+ 	 Object documentation whatIsAPrimitive."
+ 	<primitive: 110>
+ 	^self == aCharacter!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasInteger (in category 'method prototypes') -----
+ CharacterPROTOTYPEasInteger
+ 	"Answer the receiver's character code."
+ 	<primitive: 171>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEasciiValue (in category 'method prototypes') -----
+ CharacterPROTOTYPEasciiValue
+ 	"Answer the receiver's character code.
+ 	 This will be ascii for characters with value <= 127,
+ 	 and Unicode for those with higher values."
+ 	<primitive: 171>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEcopy (in category 'method prototypes') -----
+ CharacterPROTOTYPEcopy
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEdeepCopy (in category 'method prototypes') -----
+ CharacterPROTOTYPEdeepCopy
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEhash (in category 'method prototypes') -----
+ CharacterPROTOTYPEhash
+ 	"Hash is reimplemented because = is implemented.
+ 	 Answer the receiver's character code."
+ 	<primitive: 171>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEidentityHash (in category 'method prototypes') -----
+ CharacterPROTOTYPEidentityHash
+ 	"Answer the receiver's character code."
+ 	<primitive: 171>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterPROTOTYPEveryDeepCopyWith: (in category 'method prototypes') -----
+ CharacterPROTOTYPEveryDeepCopyWith: deepCopier
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEdigitValue: (in category 'method prototypes') -----
+ CharacterclassPROTOTYPEdigitValue: x 
+ 	"Answer the Character whose digit value is x. For example,
+ 	 answer $9 for x=9, $0 for x=0, $A for x=10, $Z for x=35."
+ 
+ 	| n |
+ 	n := x asInteger.
+ 	^self value: (n < 10 ifTrue: [n + 48] ifFalse: [n + 55])!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ CharacterclassPROTOTYPEinitialize
+ 	"Create the DigitsValues table."
+ 	"Character initialize"
+ 	self initializeDigitValues!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CharacterclassPROTOTYPEvalue: (in category 'method prototypes') -----
+ CharacterclassPROTOTYPEvalue: anInteger
+ 	"Answer the Character whose value is anInteger."
+ 	<primitive: 170>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEcomputeFormat:instSize:forSuper:ccIndex: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEcomputeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
+ 	"Compute the new format for making oldClass a subclass of newSuper.
+ 	 Answer the format or nil if there is any problem."
+ 	| instSize isVar isWords isPointers isWeak |
+ 	type == #compiledMethod ifTrue:
+ 		[newInstSize > 0 ifTrue:
+ 			[self error: 'A compiled method class cannot have named instance variables'.
+ 			^nil].
+ 		^CompiledMethod format].
+ 	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
+ 	instSize > 65535 ifTrue:
+ 		[self error: 'Class has too many instance variables (', instSize printString,')'.
+ 		^nil].
+ 	type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
+ 	type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
+ 	type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
+ 	type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
+ 	type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
+ 	type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true].
+ 	type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true].
+ 	(isPointers not and: [instSize > 0]) ifTrue:
+ 		[self error: 'A non-pointer class cannot have named instance variables'.
+ 		^nil].
+ 	^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEformat:variable:words:pointers:weak: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEformat: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak
+ 	"Compute the format for the given instance specfication.
+ 	 Above Cog Spur the class format is
+ 		<5 bits inst spec><16 bits inst size>
+ 	 where the 5-bit inst spec is
+ 			0	= 0 sized objects (UndefinedObject True False et al)
+ 			1	= non-indexable objects with inst vars (Point et al)
+ 			2	= indexable objects with no inst vars (Array et al)
+ 			3	= indexable objects with inst vars (MethodContext AdditionalMethodState et al)
+ 			4	= weak indexable objects with inst vars (WeakArray et al)
+ 			5	= weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
+ 			6	= unused
+ 			7	= immediates (SmallInteger, Character)
+ 			8	= unused
+ 			9	= reserved for 64-bit indexable
+ 		10-11	= 32-bit indexable (Bitmap)
+ 		12-15	= 16-bit indexable
+ 		16-23	= 8-bit indexable
+ 		24-31	= compiled methods (CompiledMethod)"
+ 	| instSpec |
+ 	instSpec := isWeak
+ 					ifTrue:
+ 						[isVar
+ 							ifTrue: [4]
+ 							ifFalse: [5]]
+ 					ifFalse:
+ 						[isPointers
+ 							ifTrue:
+ 								[isVar
+ 									ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]]
+ 									ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]]
+ 							ifFalse:
+ 								[isVar
+ 									ifTrue: [isWords ifTrue: [12] ifFalse: [16]]
+ 									ifFalse: [7]]].
+ 	^(instSpec bitShift: 16) + nInstVars!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEsuperclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEsuperclass: aClass
+ 	immediateSubclass: t instanceVariableNames: f 
+ 	classVariableNames: d poolDictionaries: s category: cat
+ 	"This is the standard initialization message for creating a
+ 	 new immediate class as a subclass of an existing class."
+ 	| env |
+ 	aClass instSize > 0
+ 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields'].
+ 	aClass isVariable
+ 		ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables'].
+ 	aClass isPointers
+ 		ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields'].
+ 	"Cope with pre-environment and environment versions. Simplify asap."
+ 	env := (Smalltalk classNamed: #EnvironmentRequest)
+ 				ifNil: [aClass environment]
+ 				ifNotNil: [:erc| erc signal ifNil: [aClass environment]].
+ 	^self 
+ 		name: t
+ 		inEnvironment: env
+ 		subclassOf: aClass
+ 		type: #immediate
+ 		instanceVariableNames: f
+ 		classVariableNames: d
+ 		poolDictionaries: s
+ 		category: cat!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>ClassBuilderPROTOTYPEupdate:to: (in category 'method prototypes') -----
+ ClassBuilderPROTOTYPEupdate: oldClass to: newClass
+ 	"Convert oldClass, all its instances and possibly its meta class into newClass,
+ 	 instances of newClass and possibly its meta class. The process is surprisingly
+ 	 simple in its implementation and surprisingly complex in its nuances and potentially
+ 	 bad side effects.
+ 	 We can rely on two assumptions (which are critical):
+ 		#1: The method #updateInstancesFrom: will not create any lasting pointers to
+ 			 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do
+ 			 a become of the old vs. the new instances and therefore it will not create
+ 			 pointers to *new* instances before the #become: which are *old* afterwards)
+ 		#2: The non-preemptive execution of the critical piece of code guarantees that
+ 			 nobody can get a hold by 'other means' (such as process interruption and
+ 			 reflection) on the old instances.
+ 	 Given the above two, we know that after #updateInstancesFrom: there are no pointers
+ 	 to any old instances. After the forwarding become there will be no pointers to the old
+ 	 class or meta class either.
+ 	 Andreas Raab, 2/27/2003 23:42"
+ 	| meta |
+ 	meta := oldClass isMeta.
+ 	"Note: Everything from here on will run without the ability to get interrupted
+ 	to prevent any other process to create new instances of the old class."
+ 	["Note: The following removal may look somewhat obscure and needs an explanation.
+ 	  When we mutate the class hierarchy we create new classes for any existing subclass.
+ 	  So it may look as if we don't have to remove the old class from its superclass. However,
+ 	  at the top of the hierarchy (the first class we reshape) that superclass itself is not newly
+ 	  created so therefore it will hold both the oldClass and newClass in its (obsolete or not)
+ 	  subclasses. Since the #become: below will transparently replace the pointers to oldClass
+ 	  with newClass the superclass would have newClass in its subclasses TWICE. With rather
+ 	  unclear effects if we consider that we may convert the meta-class hierarchy itself (which
+ 	  is derived from the non-meta class hierarchy).
+ 	  Due to this problem ALL classes are removed from their superclass just prior to converting
+ 	  them. Here, breaking the superclass/subclass invariant really doesn't matter since we will
+ 	  effectively remove the oldClass (becomeForward:) just a few lines below."
+ 
+ 		oldClass superclass removeSubclass: oldClass.
+ 		oldClass superclass removeObsoleteSubclass: oldClass.
+ 
+ 		"make sure that the VM cache is clean"
+ 		oldClass methodDict do: [:cm | cm flushCache].
+ 		
+ 		"Convert the instances of oldClass into instances of newClass"
+ 		newClass updateInstancesFrom: oldClass.
+ 
+ 		meta
+ 			ifTrue:
+ 				[oldClass becomeForward: newClass.
+ 				 oldClass updateMethodBindingsTo: oldClass binding]
+ 			ifFalse:
+ 				[{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}.
+ 				 oldClass updateMethodBindingsTo: oldClass binding.
+ 				 oldClass class updateMethodBindingsTo: oldClass class binding].
+ 
+ 		"eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was
+ 		 to ensure no old instances existed after the becomeForward:.  Without the GC it was possible
+ 		 to resurrect old instances using e.g. allInstancesDo:.  This was because the becomeForward:
+ 		 updated references from the old objects to new objects but didn't destroy the old objects.
+ 		 But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."]
+ 			valueUnpreemptively!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEnumLiterals (in category 'method prototypes') -----
+ CompiledMethodPROTOTYPEnumLiterals
+ 	"Answer the number of literals used by the receiver."
+ 	^self header bitAnd: 65535!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodPROTOTYPEprimitive (in category 'method prototypes') -----
+ CompiledMethodPROTOTYPEprimitive
+ 	"Answer the primitive index associated with the receiver.
+ 	 Zero indicates that this is not a primitive method."
+ 	| initialPC |
+ 	^(self header anyMask: 65536) "Is the hasPrimitive? flag set?"
+ 		ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)]
+ 		ifFalse: [0]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod:header: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEhandleFailingFailingNewMethod: numberOfBytes header: headerWord
+ 	"This newMethod:header: gets sent after handleFailingBasicNew: has done a full
+ 	 garbage collection and possibly grown memory.  If this basicNew: fails then the
+ 	 system really is low on space, so raise the OutOfMemory signal.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable variables
+ 	 specified by the argument, headerWord, and the number of bytecodes specified
+ 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
+ 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
+ 	 memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 79>
+ 	"space must be low."
+ 	OutOfMemory signal.
+ 	"retry if user proceeds"
+ 	^self newMethod: numberOfBytes header: headerWord!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEhandleFailingNewMethod:header: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEhandleFailingNewMethod: numberOfBytes header: headerWord
+ 	"This newMethod:header: gets sent after newMethod:header: has failed
+ 	 and allowed a scavenging garbage collection to occur.  The scavenging
+ 	 collection will have happened as the VM is activating the (failing) basicNew:.
+ 	 If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient
+ 	 space and a global garbage collection is required.  Retry after garbage
+ 	 collecting and growing memory if necessary.
+ 
+ 	 Primitive. Answer an instance of this class with the number of indexable variables
+ 	 specified by the argument, headerWord, and the number of bytecodes specified
+ 	 by numberOfBytes.  Fail if this if the arguments are not Integers, or if numberOfBytes
+ 	 is negative, or if the receiver is not a CompiledMethod class, or if there is not enough
+ 	 memory available. Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 79>
+ 	| bytesRequested |
+ 	bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16.
+ 	Smalltalk garbageCollect < bytesRequested ifTrue:
+ 		[Smalltalk growMemoryByAtLeast: bytesRequested].
+ 	"retry after global garbage collect and possible grow"
+ 	^self handleFailingFailingNewMethod: numberOfBytes header: headerWord!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEheaderFlagForEncoder: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEheaderFlagForEncoder: anEncoder
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEinitialize    "CompiledMethod initialize"
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEinstallPrimaryBytecodeSet: aBytecodeEncoderSubclass
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEinstallSecondaryBytecodeSet: aBytecodeEncoderSubclass
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex
+ 	"Since this method refers to ClassVariables things are easier if it lives in the actual class."
+ 
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEnewBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag
+ 	"Since this method refers to ClassVariables things are easier if it lives in the actual class."
+ 
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEnewMethod:header: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEnewMethod: numberOfBytes header: headerWord
+ 	"Primitive. Answer an instance of me. The number of literals (and other 
+ 	 information) is specified by the headerWord (see my class comment).
+ 	 The first argument specifies the number of fields for bytecodes in the
+ 	 method. Fail if either argument is not a SmallInteger, or if numberOfBytes
+ 	 is negative, or if memory is low. Once the header of a method is set by
+ 	 this primitive, it cannot be changed to change the number of literals.
+ 	 Essential. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 79 error: ec>
+ 	ec == #'insufficient object memory' ifTrue:
+ 		[^self handleFailingNewMethod: numberOfBytes header: headerWord].
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnConstant:trailerBytes: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEtoReturnConstant: index trailerBytes: trailer
+ 	"Answer an instance of me that is a quick return of the constant
+ 	indexed in (true false nil -1 0 1 2)."
+ 
+ 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnField:trailerBytes: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEtoReturnField: field trailerBytes: trailer
+ 	"Answer an instance of me that is a quick return of the instance variable 
+ 	indexed by the argument, field."
+ 
+ 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: (in category 'method prototypes') -----
+ CompiledMethodclassPROTOTYPEtoReturnSelfTrailerBytes: trailer
+ 	"Answer an instance of me that is a quick return of the instance (^self)."
+ 
+ 	^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs:numTemps:numLits:primitive: (in category 'method prototypes') -----
+ EncoderForV3PROTOTYPEcomputeMethodHeaderForNumArgs: numArgs numTemps: numTemps numLits: numLits primitive: primitiveIndex
+ 	<remove>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: (in category 'method prototypes') -----
+ EncoderForV3PlusClosuresPROTOTYPEgenCallPrimitive: primitiveIndex
+ 	"Since this method has inst var refs the prototype must live in the actual class."
+ 
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: (in category 'method prototypes') -----
+ EncoderForV3PlusClosuresclassPROTOTYPEbytecodeSize: bytecode
+ 	"Answer the number of bytes in the bytecode."
+ 	bytecode <= 125 ifTrue:
+ 		[^1].
+ 	bytecode >= 176 ifTrue:
+ 		[^1].
+ 	bytecode >= 160 ifTrue: "long jumps"
+ 		[^2].
+ 	bytecode >= 144 ifTrue: "short jumps"
+ 		[^1].
+ 	"extensions"
+ 	bytecode >= 128 ifTrue:
+ 		[^#(2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4) at: bytecode - 127].
+ 	^nil!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode (in category 'method prototypes') -----
+ EncoderForV3PlusClosuresclassPROTOTYPEcallPrimitiveCode
+ 	"139	11101111	iiiiiiii jjjjjjjj	Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
+ 	^139!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>InstructionClientPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
+ InstructionClientPROTOTYPEcallPrimitive: pimIndex
+ 	"V3PlusClosures:	139 10001011	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ 	 NewsqueakV4:		249 11111001	iiiiiiii   jjjjjjjj  Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ 	 SistaV1:			248 11111000 iiiiiiii mjjjjjjj  Call Primitive #iiiiiiii + ( jjjjjjj * 256)
+ 							m=1 means inlined primitive, no hard return after execution."!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>InstructionPrinterPROTOTYPEcallPrimitive: (in category 'method prototypes') -----
+ InstructionPrinterPROTOTYPEcallPrimitive: index
+ 	"Print the callPrimitive."
+ 
+ 	self print: 'callPrimtive: ' , index printString!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>MethodNodeOLDSQUEAKPROTOTYPEgenerate: (in category 'method prototypes') -----
+ MethodNodeOLDSQUEAKPROTOTYPEgenerate: trailer 
+ 	"The receiver is the root of a parse tree. Answer a CompiledMethod.
+ 	 The argument, trailer, is arbitrary but is typically either the reference
+ 	 to the source code that is stored with every CompiledMethod, or an
+ 	 encoding of the method's temporary names."
+ 
+ 	^self generate: trailer using: CompiledMethod!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>MethodNodePROTOTYPEgenerate:using: (in category 'method prototypes') -----
+ MethodNodePROTOTYPEgenerate: trailer using: aCompiledMethodClass
+ 	"Since this method has inst var refs the prototype must live in the actual class."
+ 
+ 	<indirect>!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmallIntegerPROTOTYPEasCharacter (in category 'method prototypes') -----
+ SmallIntegerPROTOTYPEasCharacter
+ 	<primitive: 170>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEcompactClassesArray (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEcompactClassesArray
+ 	"Smalltalk compactClassesArray"
+ 	"Backward-compatibility support.  Spur does not have compact classes."
+ 	^{}!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEgrowMemoryByAtLeast: numBytes
+ 	"Grow memory by at least the requested number of bytes.
+ 	 Primitive.  Essential. Fail if no memory is available."
+ 	<primitive: 180>
+ 	(numBytes isInteger and: [numBytes > 0]) ifTrue:
+ 		[OutOfMemory signal].
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SmalltalkImagePROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEmaxIdentityHash
+ 	"Answer the maximum identityHash value supported by the VM."
+ 	<primitive: 176>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SpaceTallyPROTOTYPEspaceForInstancesOf: (in category 'method prototypes') -----
+ SpaceTallyPROTOTYPEspaceForInstancesOf: aClass
+ 	"Answer a pair of the number of bytes consumed by all instances of the
+ 	 given class, including their object headers, and the number of instances."
+ 
+ 	| instances total |
+ 	instances := aClass allInstances.
+ 	instances isEmpty ifTrue: [^#(0 0)].
+ 	total := 0.
+ 	aClass isVariable
+ 		ifTrue:
+ 			[instances do:
+ 				[:i| total := total + (aClass byteSizeOfInstanceOfSize: i basicSize)]]
+ 		ifFalse:
+ 			[total := instances size * aClass byteSizeOfInstance].
+ 	^{ total. instances size }!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: (in category 'method prototypes') -----
+ SystemDictionaryPROTOTYPEgrowMemoryByAtLeast: numBytes
+ 	"Grow memory by at least the requested number of bytes.
+ 	 Primitive.  Fail if no memory is available.  Essential."
+ 	<primitive: 180>
+ 	^(numBytes isInteger and: [numBytes > 0])
+ 		ifTrue: [OutOfMemory signal]
+ 		ifFalse: [self primitiveFailed]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemDictionaryPROTOTYPEmaxIdentityHash (in category 'method prototypes') -----
+ SystemDictionaryPROTOTYPEmaxIdentityHash
+ 	"Answer the maximum identityHash value supported by the VM."
+ 	<primitive: 176>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjects (in category 'method prototypes') -----
+ SystemNavigationPROTOTYPEallObjects
+ 	"Answer an Array of all objects in the system.  Fail if
+ 	 there isn't enough memory to instantiate the result."
+ 	<primitive: 178>
+ 	^self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsDo: (in category 'method prototypes') -----
+ SystemNavigationPROTOTYPEallObjectsDo: aBlock 
+ 	"Evaluate the argument, aBlock, for each object in the system, excluding immediates
+ 	 such as SmallInteger and Character."
+ 	self allObjectsOrNil
+ 		ifNotNil: [:allObjects| allObjects do: aBlock]
+ 		ifNil:
+ 			["Fall back on the old single object primitive code.  With closures, this needs
+ 			  to use an end marker (lastObject) since activation of the block will create
+ 			  new contexts and cause an infinite loop.  The lastObject must be created
+ 			  before calling someObject, so that the VM can settle the enumeration (e.g.
+ 			  by flushing new space) as a side effect of  someObject"
+ 			| object lastObject |
+ 			lastObject := Object new.
+ 			object := self someObject.
+ 			[lastObject == object or: [0 == object]] whileFalse:
+ 				[aBlock value: object.
+ 				 object := object nextObject]]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>SystemNavigationPROTOTYPEallObjectsOrNil (in category 'method prototypes') -----
+ SystemNavigationPROTOTYPEallObjectsOrNil
+ 	"Answer an Array of all objects in the system.  Fail if there isn't
+ 	 enough memory to instantiate the result and answer nil."
+ 	<primitive: 178>
+ 	^nil!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat: (in category 'method prototypes') -----
+ WideStringPROTOTYPEat: index
+ 	"Answer the Character stored in the field of the receiver indexed by the
+ 	 argument.  Primitive.  Fail if the index argument is not an Integer or is out
+ 	 of bounds.  Essential.  See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 63>
+ 	^index isInteger
+ 		ifTrue:
+ 			[self errorSubscriptBounds: index]
+ 		ifFalse:
+ 			[index isNumber
+ 				ifTrue: [self at: index asInteger]
+ 				ifFalse: [self errorNonIntegerIndex]]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>WideStringPROTOTYPEat:put: (in category 'method prototypes') -----
+ WideStringPROTOTYPEat: index put: aCharacter
+ 	"Store the Character into the field of the receiver indicated by the index.
+ 	 Primitive.  Fail if the index is not an Integer or is out of bounds, or if the
+ 	 argument is not a Character.  Essential.  See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 64>
+ 	^aCharacter isCharacter
+ 		ifTrue:
+ 			[index isInteger
+ 				ifTrue: [self errorSubscriptBounds: index]
+ 				ifFalse: [self errorNonIntegerIndex]]
+ 		ifFalse:
+ 			[self errorImproperStore]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>allMethodPrototypes (in category 'accessing') -----
+ allMethodPrototypes 
+ 	^ self class allMethods
+ 		select: [ :each | each category = 'method prototypes' ]!

Item was added:
+ ----- Method: SpurBootstrapPrototypes>>categoryForClass:meta:selector: (in category 'method prototype categorization') -----
+ categoryForClass: className meta: isMeta selector: selector 
+ 	^(isMeta
+ 			ifTrue: [{ className. #class. selector }]
+ 			ifFalse: [{ className. selector }])
+ 		caseOf: {
+ 			[#(Behavior allInstancesOrNil)]					-> [#enumerating].
+ 			[#(Behavior byteSizeOfInstance)]				-> [#'accessing instances and variables'].
+ 			[#(Behavior byteSizeOfInstanceOfSize:)]		-> [#'accessing instances and variables'].
+ 			[#(Behavior elementSize)]						-> [#'accessing instances and variables'].
+ 			[#(Behavior handleFailingBasicNew)]			-> [#private].
+ 			[#(Behavior handleFailingBasicNew:)]			-> [#private].
+ 			[#(Behavior handleFailingFailingBasicNew)]		-> [#private].
+ 			[#(Behavior handleFailingFailingBasicNew:)]		-> [#private].
+ 			[#(Behavior identityHash)]						-> [#comparing].
+ 			[#(Behavior isEphemeronClass)]				-> [#testing].
+ 			[#(Behavior isImmediateClass)]					-> [#testing].
+ 			[#(Character identityHash)]						-> [#comparing].
+ 			[#(Class immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
+ 															-> [#'subclass creation'].
+ 			[#(ClassBuilder superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category:)]
+ 															-> [#public].
+ 			[#(CompiledMethod class handleFailingFailingNewMethod:header:)]
+ 															-> [#private].
+ 			[#(CompiledMethod class handleFailingNewMethod:header:)]
+ 															-> [#private].
+ 			[#(Context class allInstances)]					-> [#enumerating].
+ 			[#(Context class allInstancesDo:)]				-> [#enumerating].
+ 			[#(Context failPrimitiveWith:)]					-> [#'system simulation'].
+ 			[#(Context isPrimFailToken:)]					-> [#private].
+ 			[#(Context send:to:with:lookupIn:)]				-> [#controlling].
+ 			[#(Context isPrimFailToken:)]				-> [#private].
+ 			[#(Context send:to:with:lookupIn:)]			-> [#controlling].
+ 			[#(CompiledMethod class headerFlagForEncoder:)]
+ 															-> [#'method encoding'].
+ 			[#(CompiledMethod class installPrimaryBytecodeSet:)]
+ 															-> [#'class initialization'].
+ 			[#(CompiledMethod class installSecondaryBytecodeSet:)]
+ 															-> [#'class initialization'].
+ 			[#(EncoderForV3PlusClosures genCallPrimitive:)]
+ 															-> [#'bytecode generation'].
+ 			[#(EncoderForV3PlusClosures class callPrimitiveCode)]
+ 															-> [#'bytecode decoding'].
+ 			[#(Context failPrimitiveWith:)]			-> [#'system simulation'].
+ 			[#(Context class allInstances)]			-> [#enumerating].
+ 			[#(Context class allInstancesDo:)]		-> [#enumerating].
+ 			[#(SmallInteger asCharacter)]					-> [#converting].
+ 			[#(SmalltalkImage growMemoryByAtLeast:)]	-> [#'memory space'].
+ 			[#(SmalltalkImage maxIdentityHash)]			-> [#'system attributes'].
+ 			[#(SystemDictionary growMemoryByAtLeast:)]	-> [#'memory space'].
+ 			[#(SystemDictionary maxIdentityHash)]			-> [#'system attributes'].
+ 			[#(SystemDictionary setGCParameters)]		-> [#'snapshot and quit'].
+ 			[#(SystemNavigation allObjects)]				-> [#query].
+ 			[#(SystemNavigation allObjectsOrNil)]			-> [#query].
+ 			 }
+ 		otherwise:
+ 			[Transcript nextPutAll: className.
+ 			 isMeta ifTrue: [Transcript nextPutAll: ' class'].
+ 			 Transcript nextPutAll: '>>'; store: selector; nextPutAll: ' is unclassified'; cr; flush.
+ 			 ^Categorizer default]!

Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapSqueak43Prototypes
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes class>>imageType (in category 'accessing') -----
+ imageType
+ 	^ 'squeak 4.3'!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>CompiledMethodPROTOTYPEencoderClass (in category 'method prototypes') -----
+ CompiledMethodPROTOTYPEencoderClass
+ 	"Answer the encoder class that encoded the bytecodes in this method.
+ 	 The sign flag bit is used by the VM to select a bytecode set.  This formulation
+ 	 may seem odd but this has to be fast, so no property probe unless needed."
+ 
+ 	^self header >= 0
+ 		ifTrue: 
+ 			[PrimaryBytecodeSetEncoderClass]
+ 		ifFalse:
+ 			[PrimaryBytecodeSetEncoderClass == SecondaryBytecodeSetEncoderClass
+ 				ifTrue: "Support for testing prior to installing another set"
+ 					[(self propertyValueAt: #encoderClass) ifNil: [SecondaryBytecodeSetEncoderClass]]
+ 				ifFalse:
+ 					[SecondaryBytecodeSetEncoderClass]]!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>DecompilerPROTOTYPEdecompile:in:method:using: (in category 'method prototypes') -----
+ DecompilerPROTOTYPEdecompile: aSelector in: aClass method: aMethod using: aConstructor
+ 
+ 	| block node |
+ 	constructor := aConstructor.
+ 	method := aMethod.
+ 	self initSymbols: aClass.  "create symbol tables"
+ 	method isQuick
+ 		ifTrue: [block := self quickMethod]
+ 		ifFalse: 
+ 			[stack := OrderedCollection new: method frameSize.
+ 			lastJumpIfPcStack := OrderedCollection new.
+ 			caseExits := OrderedCollection new.
+ 			statements := OrderedCollection new: 20.
+ 			numLocalTemps := 0.
+ 			super method: method pc: method initialPC.
+ 			"skip primitive error code store if necessary"
+ 			(method primitive ~= 0 and: [self skipCallPrimitive; willStore]) ifTrue:
+ 				[pc := pc + (method encoderClass bytecodeSize: self firstByte).
+ 				 tempVars := tempVars asOrderedCollection].
+ 			block := self blockTo: method endPC + 1.
+ 			stack isEmpty ifFalse: [self error: 'stack not empty']].
+ 	node := constructor
+ 				codeMethod: aSelector
+ 				block: block
+ 				tempVars: tempVars
+ 				primitive: method primitive
+ 				class: aClass.
+ 	method primitive > 0 ifTrue:
+ 		[node removeAndRenameLastTempIfErrorCode].
+ 	^node preen!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEinterpretExtension:in:for: (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEinterpretExtension: offset in: method for: client
+ 	^self interpretV3ClosuresExtension: offset in: method for: client!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEnextPc: (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEnextPc: currentByte
+ 	"Answer the pc of the next bytecode following the current one, given the current bytecode.."
+ 
+ 	^pc + (self method encoderClass bytecodeSize: currentByte)!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>InstructionStreamPROTOTYPEskipCallPrimitive (in category 'method prototypes') -----
+ InstructionStreamPROTOTYPEskipCallPrimitive
+ 	"If the receiver's method starts with a callPrimitive: bytecode, skip it."
+ 	| method encoderClass callPrimitiveCode |
+ 	method := self method.
+ 	encoderClass := method  encoderClass.
+ 	callPrimitiveCode := encoderClass callPrimitiveCode.
+ 	(method byteAt: pc) = callPrimitiveCode ifTrue:
+ 		[pc := pc + (encoderClass bytecodeSize: callPrimitiveCode)]!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>MCClassDefinitionPROTOTYPEkindOfSubclass (in category 'method prototypes') -----
+ MCClassDefinitionPROTOTYPEkindOfSubclass
+ 	type = #normal ifTrue: [^' subclass: '].
+ 	type = #variable ifTrue: [^' variableSubclass: '].
+ 	type = #bytes ifTrue: [^' variableByteSubclass: '].
+ 	type = #compiledMethod ifTrue: [^' variableByteSubclass: ' ].
+ 	type = #words ifTrue: [^' variableWordSubclass: '].
+ 	type = #weak ifTrue: [^' weakSubclass: ' ].
+ 	type = #ephemeron ifTrue: [^' ephemeronSubclass: ' ].
+ 	type = #immediate ifTrue: [^' immediateSubclass: ' ].
+ 	self error: 'Unrecognized class type'!

Item was added:
+ ----- Method: SpurBootstrapSqueak43Prototypes>>MCMethodDefinitionPROTOTYPEinitializeWithClassName:classIsMeta:selector:category:timeStamp:source: (in category 'method prototypes') -----
+ MCMethodDefinitionPROTOTYPEinitializeWithClassName: classString
+ classIsMeta: metaBoolean
+ selector: selectorString
+ category: catString
+ timeStamp: timeString
+ source: sourceString
+ 	className := classString asSymbol.
+ 	selector := selectorString asSymbol.
+ 	category := catString ifNil: [Categorizer default] ifNotNil: [catString asSymbol].
+ 	timeStamp := timeString.
+ 	classIsMeta := metaBoolean.
+ 	source := sourceString withSqueakLineEndings!

Item was added:
+ SpurBootstrapPrototypes subclass: #SpurBootstrapSqueakPrototypes
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'Cog-Bootstrapping'!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes class>>imageType (in category 'accessing') -----
+ imageType
+ 	^ 'squeak'!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>BehaviorPROTOTYPEidentityHash (in category 'method prototypes') -----
+ BehaviorPROTOTYPEidentityHash
+ 	"Answer a SmallInteger whose value is related to the receiver's identity.
+ 	 Behavior implements identityHash to allow the VM to use an object representation which
+ 	 does not include a direct reference to an object's class in an object.  If the VM is using
+ 	 this implementation then classes are held in a class table and instances contain the index
+ 	 of their class in the table.  A class's class table index is its identityHash so that an instance
+ 	 can be created without searching the table for a class's index.  The VM uses this primitive
+ 	 to enter the class into the class table, assigning its identityHash with an as yet unused
+ 	 class table index. If this primitive fails it means that the class table is full.  In Spur as of
+ 	 2014 there are 22 bits of classTable index and 22 bits of identityHash per object.
+ 
+ 	 Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive."
+ 
+ 	<primitive: 175>
+ 	self primitiveFailed!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>CharacterPROTOTYPEclone (in category 'method prototypes') -----
+ CharacterPROTOTYPEclone
+ 	"Answer the receiver, because Characters are unique."
+ 	^self!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ClassDescriptionPROTOTYPEupdateMethodBindingsTo: (in category 'method prototypes') -----
+ ClassDescriptionPROTOTYPEupdateMethodBindingsTo: aBinding
+ 	"ClassBuilder support for maintaining valid method bindings."
+ 	methodDict do: [:method| method methodClassAssociation: aBinding]!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ClassPROTOTYPEimmediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'method prototypes') -----
+ ClassPROTOTYPEimmediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat 
+ 	"This is the standard initialization message for creating a new
+ 	 immediate class as a subclass of an existing class (the receiver)."
+ 	^ClassBuilder new
+ 		superclass: self
+ 		immediateSubclass: t
+ 		instanceVariableNames: f
+ 		classVariableNames: d
+ 		poolDictionaries: s
+ 		category: cat!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEactivateReturn: aContext value: value
+ 	"Activate 'aContext return: value' in place of self, so execution will return to aContext's sender"
+ 
+ 	^ContextPart 
+ 		sender: self
+ 		receiver: aContext
+ 		method: ContextPart theReturnMethod
+ 		arguments: {value}!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments 
+ 	"Simulate a primitive method whose index is primitiveIndex.  The simulated receiver and
+ 	 arguments are given as arguments to this message. If successful, push result and return
+ 	 resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes
+ 	 execution needs to be intercepted and simulated to avoid execution running away."
+ 
+ 	| value |
+ 	"Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents
+ 	 the debugger from entering various run-away activities such as spawning a new
+ 	 process, etc.  Injudicious use results in the debugger not being able to debug
+ 	 interesting code, such as the debugger itself.  hence use primitive 19 with care :-)"
+ 	"SystemNavigation new browseAllSelect: [:m| m primitive = 19]"
+ 	primitiveIndex = 19 ifTrue:
+ 		[ Smalltalk tools debugger 
+ 			openContext: self
+ 			label:'Code simulation error'
+ 			contents: nil].
+ 
+ 	((primitiveIndex between: 201 and: 222)
+ 	 and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue:
+ 		[((primitiveIndex between: 201 and: 205)			 "BlockClosure>>value[:value:...]"
+ 		  or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]"
+ 			[^receiver simulateValueWithArguments: arguments caller: self].
+ 		 primitiveIndex = 206 ifTrue:						"BlockClosure>>valueWithArguments:"
+ 			[^receiver simulateValueWithArguments: arguments first caller: self]].
+ 
+ 	primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]"
+ 		[^self send: arguments first to: receiver with: arguments allButFirst super: false].
+ 	primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:"
+ 		[^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)].
+ 	primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:"
+ 		[^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)].
+ 
+ 	"Mutex>>primitiveEnterCriticalSection
+ 	 Mutex>>primitiveTestAndSetOwnershipOfCriticalSection"
+ 	(primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue:
+ 		[| active effective |
+ 		 active := Processor activeProcess.
+ 		 effective := active effectiveProcess.
+ 		 "active == effective"
+ 		 value := primitiveIndex = 186
+ 					ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective]
+ 					ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective].
+ 		 ^(self isPrimFailToken: value)
+ 			ifTrue: [value]
+ 			ifFalse: [self push: value]].
+ 
+ 	primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:"
+ 		[^Context
+ 			sender: self
+ 			receiver: receiver
+ 			method: (arguments at: 2)
+ 			arguments: (arguments at: 1)].
+ 
+ 	"Closure primitives"
+ 	(primitiveIndex = 200 and: [self == receiver]) ifTrue:
+ 		"ContextPart>>closureCopy:copiedValues:; simulated to get startpc right"
+ 		[^self push: (BlockClosure
+ 						outerContext: receiver
+ 						startpc: pc + 2
+ 						numArgs: arguments first
+ 						copiedValues: arguments last)].
+ 
+ 	primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM"
+ 		[(arguments size = 2
+ 		 and: [arguments first isInteger
+ 		 and: [(self objectClass: arguments last) == Array]]) ifFalse:
+ 			[^Context primitiveFailTokenFor: nil].
+ 		 ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last].
+ 
+ 	value := primitiveIndex = 120 "FFI method"
+ 				ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments]
+ 				ifFalse:
+ 					[primitiveIndex = 117 "named primitives"
+ 						ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments]
+ 						ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]].
+ 
+ 	^(self isPrimFailToken: value)
+ 		ifTrue: [value]
+ 		ifFalse: [self push: value]!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEisPrimFailToken: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEisPrimFailToken: anObject
+ 	^(self objectClass: anObject) == Array
+ 	  and: [anObject size = 2
+ 	  and: [anObject first == PrimitiveFailToken]]!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEsend: selector to: rcvr with: arguments lookupIn: lookupClass
+ 	"Simulate the action of sending a message with selector and arguments
+ 	 to rcvr. The argument, lookupClass, is the class in which to lookup the
+ 	 message.  This is the receiver's class for normal messages, but for super
+ 	 messages it will be some specific class related to the source method."
+ 
+ 	| meth primIndex val ctxt |
+ 	(meth := lookupClass lookupSelector: selector) ifNil:
+ 		[^self send: #doesNotUnderstand:
+ 				to: rcvr
+ 				with: {Message selector: selector arguments: arguments}
+ 				lookupIn: lookupClass].
+ 	(primIndex := meth primitive) > 0 ifTrue:
+ 		[val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments.
+ 		 (self isPrimFailToken: val) ifFalse:
+ 			[^val]].
+ 	(selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue:
+ 		[^self error: 'Simulated message ', arguments first selector, ' not understood'].
+ 	ctxt := Context sender: self receiver: rcvr method: meth arguments: arguments.
+ 	primIndex > 0 ifTrue:
+ 		[ctxt failPrimitiveWith: val].
+ 	^ctxt!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEsend: selector to: rcvr with: arguments super: superFlag 
+ 	"Simulate the action of sending a message with selector arguments
+ 	 to rcvr. The argument, superFlag, tells whether the receiver of the
+ 	 message was specified with 'super' in the source method."
+ 
+ 	^self send: selector
+ 		to: rcvr
+ 		with: arguments
+ 		lookupIn: (superFlag
+ 					ifTrue: [self method methodClassAssociation value superclass]
+ 					ifFalse: [self objectClass: rcvr])!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes') -----
+ ContextPartPROTOTYPEtryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments
+ 	"Invoke the named primitive for aCompiledMethod, answering its result, or,
+ 	 if the primiitve fails, answering the error code."
+ 	<primitive: 218 error: ec>
+ 	ec ifNotNil:
+ 		["If ec is an integer other than -1 there was a problem with primitive 218,
+ 		  not with the external primitive itself.  -1 indicates a generic failure (where
+ 		  ec should be nil) but ec = nil means primitive 218 is not implemented.  So
+ 		  interpret -1 to mean the external primitive failed with a nil error code."
+ 		 ec isInteger ifTrue:
+ 			[ec = -1
+ 				ifTrue: [ec := nil]
+ 				ifFalse: [self primitiveFailed]]].
+ 	^self class primitiveFailTokenFor: ec!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>IntegerclassPROTOTYPEinitialize (in category 'method prototypes') -----
+ IntegerclassPROTOTYPEinitialize
+ 	"Integer initialize"	
+ 	self initializeLowBitPerByteTable!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextPROTOTYPEfailPrimitiveWith: (in category 'method prototypes') -----
+ MethodContextPROTOTYPEfailPrimitiveWith: maybePrimFailToken
+ 	"The receiver is a freshly-created context on a primitive method.  Skip the callPrimitive:
+ 	 bytecode and store the primitive fail code if there is one and the method consumes it."
+ 	self skipCallPrimitive.
+ 	((self isPrimFailToken: maybePrimFailToken)
+ 	  and: [method encoderClass isStoreAt: pc in: method]) ifTrue:
+ 		[self at: stackp put: maybePrimFailToken last]!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstances (in category 'method prototypes') -----
+ MethodContextclassPROTOTYPEallInstances
+ 	"Answer all instances of the receiver."
+ 	<primitive: 177>
+ 	"The primitive can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code, which gives the system a chance to GC and/or grow.
+ 	 Because aBlock might change the class of inst (for example, using become:),
+ 	 it is essential to compute next before aBlock value: inst.
+ 	 Only count until thisContext since this context has been created only to
+ 	 compute the existing instances."
+ 	| inst insts next |
+ 	insts := WriteStream on: (Array new: 64).
+ 	inst := self someInstance.
+ 	[inst == thisContext or: [inst == nil]] whileFalse:
+ 		[next := inst nextInstance.
+ 		 insts nextPut: inst.
+ 		 inst := next].
+ 	^insts contents!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>MethodContextclassPROTOTYPEallInstancesDo: (in category 'method prototypes') -----
+ MethodContextclassPROTOTYPEallInstancesDo: aBlock
+ 	"Evaluate aBlock with each of the current instances of the receiver."
+ 	| instances inst next |
+ 	instances := self allInstancesOrNil.
+ 	instances ifNotNil:
+ 		[instances do: aBlock.
+ 		 ^self].
+ 	"allInstancesOrNil can fail because memory is low.  If so, fall back on the old
+ 	 enumeration code.  Because aBlock might change the class of inst (for example,
+ 	 using become:), it is essential to compute next before aBlock value: inst.
+ 	 Only count until thisContext since evaluation of aBlock will create new contexts."
+ 	inst := self someInstance.
+ 	[inst == thisContext or: [inst == nil]] whileFalse:
+ 		[next := inst nextInstance.
+ 		 aBlock value: inst.
+ 		 inst := next]!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>ProtoObjectPROTOTYPEscaledIdentityHash (in category 'method prototypes') -----
+ ProtoObjectPROTOTYPEscaledIdentityHash
+ 	"For identityHash values returned by primitive 75, answer
+ 	 such values times 2^8.  Otherwise, match the existing
+ 	 identityHash implementation"
+ 
+ 	^self identityHash * 256 "bitShift: 8"!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPErecreateSpecialObjectsArray (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPErecreateSpecialObjectsArray
+ 	"Smalltalk recreateSpecialObjectsArray"
+ 	
+ 	"To external package developers:
+ 	**** DO NOT OVERRIDE THIS METHOD.  *****
+ 	If you are writing a plugin and need additional special object(s) for your own use, 
+ 	use addGCRoot() function and use own, separate special objects registry "
+ 	
+ 	"The Special Objects Array is an array of objects used by the Squeak virtual machine.
+ 	 Its contents are critical and accesses to it by the VM are unchecked, so don't even
+ 	 think of playing here unless you know what you are doing."
+ 	| newArray |
+ 	newArray := Array new: 60.
+ 	"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: (self specialObjectsArray at: 4) "(self bindingOf: #Processor) but it answers an Alias".
+ 	"Numerous classes below used for type checking and instantiation"
+ 	newArray at: 5 put: Bitmap.
+ 	newArray at: 6 put: SmallInteger.
+ 	newArray at: 7 put: ByteString.
+ 	newArray at: 8 put: Array.
+ 	newArray at: 9 put: Smalltalk.
+ 	newArray at: 10 put: Float.
+ 	newArray at: 11 put: (self globals at: #MethodContext ifAbsent: [self globals at: #Context]).
+ 	newArray at: 12 put: nil. "was 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) ifNil: [Semaphore new]). "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. "This is the process signalling low space."
+ 	"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.
+ 	 Cog inlines table into machine code at: prim so do not regenerate it.
+ 	 This is nil in Spur, which has immediate Characters."
+ 	newArray at: 25 put: (self specialObjectsArray at: 25).
+ 	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; an empty array in Spur"
+ 	newArray at: 29 put: self compactClassesArray.
+ 	newArray at: 30 put: ((self specialObjectsArray at: 30) ifNil: [Semaphore new]). "delay Semaphore"
+ 	newArray at: 31 put: ((self specialObjectsArray at: 31) ifNil: [Semaphore new]). "user interrupt Semaphore"
+ 	"Entries 32 - 34 unreferenced. Previously these contained prototype instances to be copied for fast initialization"
+ 	newArray at: 32 put: nil. "was the prototype Float"
+ 	newArray at: 33 put: nil. "was the prototype 4-byte LargePositiveInteger"
+ 	newArray at: 34 put: nil. "was the prototype Point"
+ 	newArray at: 35 put: #cannotInterpret:.
+ 	newArray at: 36 put: nil. "was the prototype MethodContext"
+ 	newArray at: 37 put: BlockClosure.
+ 	newArray at: 38 put: nil. "was the prototype BlockContext"
+ 	"array of objects referred to by external code"
+ 	newArray at: 39 put: (self specialObjectsArray at: 39).	"external semaphores"
+ 	newArray at: 40 put: nil. "Reserved for Mutex in Cog VMs"
+ 	newArray at: 41 put: ((self specialObjectsArray at: 41) ifNil: [LinkedList new]). "Reserved for a LinkedList instance for overlapped calls in CogMT"
+ 	newArray at: 42 put: ((self specialObjectsArray at: 42) ifNil: [Semaphore new]). "finalization Semaphore"
+ 	newArray at: 43 put: LargeNegativeInteger.
+ 	"External objects for callout.
+ 	 Note: Written so that one can actually completely remove the FFI."
+ 	newArray at: 44 put: (self at: #ExternalAddress ifAbsent: []).
+ 	newArray at: 45 put: (self at: #ExternalStructure ifAbsent: []).
+ 	newArray at: 46 put: (self at: #ExternalData ifAbsent: []).
+ 	newArray at: 47 put: (self at: #ExternalFunction ifAbsent: []).
+ 	newArray at: 48 put: (self at: #ExternalLibrary ifAbsent: []).
+ 	newArray at: 49 put: #aboutToReturn:through:.
+ 	newArray at: 50 put: #run:with:in:.
+ 	"51 reserved for immutability message"
+ 	newArray at: 51 put: #attemptToAssign:withIndex:.
+ 	newArray at: 52 put: #(nil "nil => generic error" #'bad receiver'
+ 							#'bad argument' #'bad index'
+ 							#'bad number of arguments'
+ 							#'inappropriate operation'  #'unsupported operation'
+ 							#'no modification' #'insufficient object memory'
+ 							#'insufficient C memory' #'not found' #'bad method'
+ 							#'internal error in named primitive machinery'
+ 							#'object may move' #'resource limit exceeded'
+ 							#'object is pinned' #'primitive write beyond end of object').
+ 	"53 to 55 are for Alien"
+ 	newArray at: 53 put: (self at: #Alien ifAbsent: []).
+ 	newArray at: 54 put: #invokeCallbackContext::. "use invokeCallback:stack:registers:jmpbuf: for old Alien callbacks."
+ 	newArray at: 55 put: (self at: #UnsafeAlien ifAbsent: []).
+ 
+ 	"Used to be WeakFinalizationList for WeakFinalizationList hasNewFinalization, obsoleted by ephemeron support."
+ 	newArray at: 56 put: nil.
+ 
+ 	"reserved for foreign callback process"
+ 	newArray at: 57 put: (self specialObjectsArray at: 57 ifAbsent: []).
+ 
+ 	newArray at: 58 put: #unusedBytecode.
+ 	"59 reserved for Sista counter tripped message"
+ 	newArray at: 59 put: #conditionalBranchCounterTrippedOn:.
+ 	"60 reserved for Sista class trap message"
+ 	newArray at: 60 put: #classTrapFor:.
+ 
+ 	"Now replace the interpreter's reference in one atomic operation"
+ 	self specialObjectsArray becomeForward: newArray!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>SmalltalkImagePROTOTYPEsetGCParameters (in category 'method prototypes') -----
+ SmalltalkImagePROTOTYPEsetGCParameters
+ 	"Adjust the VM's default GC parameters to avoid too much tenuring.
+ 	 Maybe this should be left to the VM?"
+ 
+ 	| proportion edenSize survivorSize averageObjectSize numObjects |
+ 	proportion := 0.9. "tenure when 90% of pastSpace is full"
+ 	edenSize := SmalltalkImage current vmParameterAt: 44.
+ 	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ 	averageObjectSize := 8 * self wordSize. "a good approximation"
+ 	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ 	SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!

Item was added:
+ ----- Method: SpurBootstrapSqueakPrototypes>>SystemDictionaryPROTOTYPEsetGCParameters (in category 'method prototypes') -----
+ SystemDictionaryPROTOTYPEsetGCParameters
+ 	"Adjust the VM's default GC parameters to avoid too much tenuring.
+ 	 Maybe this should be left to the VM?"
+ 
+ 	| proportion edenSize survivorSize averageObjectSize numObjects |
+ 	proportion := 0.9. "tenure when 90% of pastSpace is full"
+ 	edenSize := SmalltalkImage current vmParameterAt: 44.
+ 	survivorSize := edenSize / 5.0. "David's paper uses 140Kb eden + 2 x 28kb survivor spaces; Spur uses the same ratios :-)"
+ 	averageObjectSize := 8 * self wordSize. "a good approximation"
+ 	numObjects := (proportion * survivorSize / averageObjectSize) rounded.
+ 	SmalltalkImage current vmParameterAt: 6 put: numObjects  "tenure when more than this many objects survive the GC"!



More information about the Vm-dev mailing list