[Vm-dev] VM Maker: eneraiton.

commits at source.squeak.org commits at source.squeak.org
Fri Apr 13 01:38:13 UTC 2012


VMMaker.oscog-eem.156.mcz

Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/eneraiton.

VMMaker.oscog-eem.156.mcz

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

Name: eneraiton.

VMMaker.oscog-eem.156
Author: eem
Time: 12 April 2012, 6:35:41.665 pm
UUID: f03602f8-cb8a-4ae7-9a2e-921b5b77cf01
Ancestors: VMMaker.oscog-eem.155

CoInterpreter:
Provide a thorough flush primitive for CompiledMethods that discards
all machine code and makes sure that any contexts using the method
have bytecode pcs.  Primitive #215 (same as 116 in the Stack VM).
This is much slower than 116 (flushCache) since it has to enumerate
over all heap contexts.

Provide an xray primitive for CompiledMethod that answers if a
method has machine code, and if so if it's machine code is frameless,
and/or refers to a young object.  No primitive number.  Used to test
the above.

Make printOopShort: print Association keys.  Useful for
longPrintOop:, and hence printReferencesTo: etc.

Nuke theFP ~= framePointer assert in externalDivorceFrame:
andContext: since both clients are careful enough to either avoid
or deal with this case.

Slang:
Avoid annoying objectRepresentation already removed warnings on
generation.

Reformat some Slang code in trying to understand mis-inlining
of [inlinedSend] whileTrue.  [I know, IIABDFI, but sometmes one has
	to format to read and comprehend].

Collapse generateWhileForeverBreakFalse/TrueLoop:on:indent:
methods  to one taking a parameter.

=============== Diff against VMMaker.oscog-eem.155 ===============

Item was changed:
  ----- Method: CCodeGenerator>>generateWhileFalse:on:indent: (in category 'C translation') -----
  generateWhileFalse: msgNode on: aStream indent: level
  	"Generate C code for a loop in one of the following formats, as appropriate:
  		while(!!(cond)) { stmtList }
  		do {stmtList} while(!!(cond))
  		while(1) {stmtListA; if (cond) break; stmtListB}"
  
  	msgNode receiver statements size <= 1
  		ifTrue: [^self generateWhileFalseLoop: msgNode on: aStream indent: level].
  	msgNode args first isNilStmtListNode
  		ifTrue: [^self generateDoWhileFalse: msgNode on: aStream indent: level].
+ 	^self generateWhileForeverBreakIf: true loop: msgNode on: aStream indent: level!
- 	^self generateWhileForeverBreakTrueLoop: msgNode on: aStream indent: level!

Item was removed:
- ----- Method: CCodeGenerator>>generateWhileForeverBreakFalseLoop:on:indent: (in category 'C translation') -----
- generateWhileForeverBreakFalseLoop: msgNode on: aStream indent: level
- 	"Generate while(1) {stmtListA; if(!!(cond)) break; stmtListB}."
- 
- 	| stmts testStmt |
- 	stmts := msgNode receiver statements asOrderedCollection.
- 	testStmt := stmts removeLast.
- 	msgNode receiver setStatements: stmts.
- 	level - 1 timesRepeat: [ aStream tab ].
- 	aStream nextPutAll: 'while (1) {'; cr.
- 	msgNode receiver emitCCodeOn: aStream level: level + 1 generator: self.
- 	(level + 1) timesRepeat: [ aStream tab ].
- 	aStream nextPutAll: 'if (!!('.
- 	testStmt emitCCodeOn: aStream level: 0 generator: self.
- 	aStream nextPutAll: ')) break;'; cr.
- 	msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
- 	level timesRepeat: [ aStream tab ].
- 	aStream nextPutAll: '}'.!

Item was added:
+ ----- Method: CCodeGenerator>>generateWhileForeverBreakIf:loop:on:indent: (in category 'C translation') -----
+ generateWhileForeverBreakIf: breakBoolean loop: msgNode on: aStream indent: level
+ 	"Generate either of
+ 		while(1) {stmtListA; if(cond) break; stmtListB}
+ 		while(1) {stmtListA; if(!!(cond)) break; stmtListB}."
+ 
+ 	| stmts testStmt |
+ 	stmts := msgNode receiver statements asOrderedCollection.
+ 	testStmt := stmts removeLast.
+ 	msgNode receiver setStatements: stmts.
+ 	aStream tab: level - 1.
+ 	aStream nextPutAll: 'while (1) {'; cr.
+ 	msgNode receiver emitCCodeOn: aStream level: level + 1 generator: self.
+ 	aStream tab: level + 1.
+ 	aStream nextPutAll: 'if ('.
+ 	breakBoolean ifFalse: [aStream nextPut: $!!; nextPut: $(].
+ 	testStmt emitCCodeOn: aStream level: 0 generator: self.
+ 	breakBoolean ifFalse: [aStream nextPut: $)].
+ 	aStream nextPutAll: ') break;'; cr.
+ 	msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
+ 	level timesRepeat: [ aStream tab ].
+ 	aStream nextPut: $}!

Item was removed:
- ----- Method: CCodeGenerator>>generateWhileForeverBreakTrueLoop:on:indent: (in category 'C translation') -----
- generateWhileForeverBreakTrueLoop: msgNode on: aStream indent: level
- 	"Generate while(1) {stmtListA; if(cond) break; stmtListB}."
- 
- 	| stmts testStmt |
- 	stmts := msgNode receiver statements asOrderedCollection.
- 	testStmt := stmts removeLast.
- 	msgNode receiver setStatements: stmts.
- 	level - 1 timesRepeat: [ aStream tab ].
- 	aStream nextPutAll: 'while (1) {'; cr.
- 	msgNode receiver emitCCodeOn: aStream level: level + 1 generator: self.
- 	(level + 1) timesRepeat: [ aStream tab ].
- 	aStream nextPutAll: 'if ('.
- 	testStmt emitCCodeOn: aStream level: 0 generator: self.
- 	aStream nextPutAll: ') break;'; cr.
- 	msgNode args first emitCCodeOn: aStream level: level + 1 generator: self.
- 	level timesRepeat: [ aStream tab ].
- 	aStream nextPutAll: '}'.!

Item was changed:
  ----- Method: CCodeGenerator>>generateWhileTrue:on:indent: (in category 'C translation') -----
  generateWhileTrue: msgNode on: aStream indent: level
  	"Generate C code for a loop in one of the following formats, as appropriate:
  		while(cond) { stmtList }
  		do {stmtList} while(cond)
  		while(1) {stmtListA; if (!!(cond)) break; stmtListB}"
  
  	msgNode receiver statements size <= 1
  		ifTrue: [^self generateWhileTrueLoop: msgNode on: aStream indent: level].
  	msgNode args first isNilStmtListNode
  		ifTrue: [^self generateDoWhileTrue: msgNode on: aStream indent: level].
+ 	^self generateWhileForeverBreakIf: false loop: msgNode on: aStream indent: level!
- 	^self generateWhileForeverBreakFalseLoop: msgNode on: aStream indent: level!

Item was changed:
  ----- Method: CCodeGenerator>>removeVariable: (in category 'utilities') -----
  removeVariable: aName
  	"Remove the given (instance) variable from the code base."
+ 	self removeVariable: aName
- 	self checkDeleteVariable: aName.
- 	variables
- 		remove: aName
  		ifAbsent:
  			[(vmClass notNil
  			  and: [vmClass isNonArgumentImplicitReceiverVariableName: aName]) ifFalse:
  				[logger
  					ensureCr;
  					show: 'warning, variable '
  						, aName
  						, ' doesn''t exist or has already been removed';
+ 						cr]]!
- 						cr]].
- 	variableDeclarations removeKey: aName ifAbsent: []!

Item was added:
+ ----- Method: CCodeGenerator>>removeVariable:ifAbsent: (in category 'utilities') -----
+ removeVariable: aName ifAbsent: ifAbsentBlock
+ 	"Remove the given (instance) variable from the code base."
+ 	self checkDeleteVariable: aName.
+ 	variableDeclarations removeKey: aName ifAbsent: [].
+ 	^variables remove: aName ifAbsent: ifAbsentBlock!

Item was changed:
  ----- Method: CoInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
  initializePrimitiveTable
  	super initializePrimitiveTable.
  	self assert: (PrimitiveTable at: 253 + 1) = #primitiveFail.
+ 	PrimitiveTable at: 253 + 1 put: #primitiveCollectCogCodeConstituents.
+ 	self assert: (PrimitiveTable at: 215 + 1) = #primitiveFlushCacheByMethod.
+ 	PrimitiveTable at: 215 + 1 put: #primitiveVoidVMStateForMethod!
- 	PrimitiveTable at: 253 + 1 put: #primitiveCollectCogCodeConstituents!

Item was added:
+ ----- Method: CoInterpreter>>divorceAMachineCodeFrameWithCogMethod:in: (in category 'frame access') -----
+ divorceAMachineCodeFrameWithCogMethod: cogMethod in: aStackPage
+ 	"Divorce at most one frame in the current page (since the divorce may cause the page to be split)
+ 	 and answer whether a frame was divorced."
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	<var: #aStackPage type: #'StackPage *'>
+ 	| theFP calleeFP theSP theContext |
+ 	<var: #aStackPage type: #'StackPage *'>
+ 	<var: #theFP type: #'char *'>
+ 	<var: #calleeFP type: #'char *'>
+ 	<var: #theSP type: #'char *'>
+ 
+ 	theFP := aStackPage headFP.
+ 	theSP := aStackPage headSP.
+ 	theSP := theSP + BytesPerWord. "theSP points at hottest item on frame's stack"
+ 
+ 	[((self isMachineCodeFrame: theFP)
+ 	  and: [cogMethod = (self mframeHomeMethod: theFP)]) ifTrue:
+ 		[theContext := self ensureFrameIsMarried: theFP SP: theSP.
+ 		 self externalDivorceFrame: theFP andContext: theContext.
+ 		 ^true].
+ 	 calleeFP := theFP.
+ 	 theFP := self frameCallerFP: theFP.
+ 	 theFP ~= 0] whileTrue:
+ 		["theSP points at stacked hottest item on frame's stack"
+ 		 theSP := self frameCallerSP: calleeFP].
+ 
+ 	^false!

Item was added:
+ ----- Method: CoInterpreter>>divorceMachineCodeFramesWithMethod: (in category 'frame access') -----
+ divorceMachineCodeFramesWithMethod: methodObj
+ 	| cogMethod divorcedSome |
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	cogMethod := self cogMethodOf: methodObj.
+ 	[stackPage ~= 0 ifTrue: "This is needed for the assert in externalDivorceFrame:andContext:"
+ 		[stackPages markStackPageMostRecentlyUsed: stackPage].
+ 	 "Slang can't currently cope with the lack of the variable here.
+ 	  Something to do with the preceeding statement.  Take it out
+ 	  and the code is good.  leave it in and we get do { ... } while(l1:)"
+ 	 divorcedSome := self divorceSomeMachineCodeFramesWithMethod: cogMethod.
+ 	 divorcedSome] whileTrue!

Item was added:
+ ----- Method: CoInterpreter>>divorceSomeMachineCodeFramesWithMethod: (in category 'frame access') -----
+ divorceSomeMachineCodeFramesWithMethod: cogMethod
+ 	"Divorce at most one frame (since the divorce may cause the containing
+ 	 page to be split) and answer whether a frame was divorced."
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	| divorcedSome |
+ 	<var: #aPage type: #'StackPage *'>
+ 	divorcedSome := false.
+ 	0 to: numStackPages - 1 do:
+ 		[:i| | aPage |
+ 		aPage := stackPages stackPageAt: i.
+ 		(stackPages isFree: aPage) ifFalse:
+ 			["this to avoid assert in externalDivorceFrame:andContext:"
+ 			 self markStackPageMostRecentlyUsed: stackPage.
+ 			 (self divorceAMachineCodeFrameWithCogMethod: cogMethod in: aPage) ifTrue:
+ 				[divorcedSome := true]]].
+ 	^divorcedSome!

Item was added:
+ ----- Method: CoInterpreter>>ensureAllContextsWithMethodHaveBytecodePCs: (in category 'frame access') -----
+ ensureAllContextsWithMethodHaveBytecodePCs: methodObj
+ 	"Map all native pcs to bytecoded pcs in all contexts on methodObj.
+ 	 Used to implement primitiveVoidVMStateForMethod."
+ 	| oop |
+ 	oop := objectMemory firstObject.
+ 	[oop < objectMemory freeStart] whileTrue:
+ 		[((objectMemory isFreeObject: oop) not
+ 		  and: [(objectMemory isContextNonInt: oop)
+ 		  and: [(objectMemory fetchPointer: MethodIndex ofObject: oop) = methodObj]]) ifTrue:
+ 			[(self isMarriedOrWidowedContext: oop)
+ 				ifTrue:
+ 					[(self checkIsStillMarriedContext: oop currentFP: stackPage headFP) ifTrue:
+ 						[self assert: (self isMachineCodeFrame: (self frameOfMarriedContext: oop)) not]]
+ 				ifFalse:
+ 					[self ensureContextHasBytecodePC: oop]].
+ 		 oop := objectMemory objectAfter: oop]!

Item was added:
+ ----- Method: CoInterpreter>>ensureContextHasBytecodePC: (in category 'frame access') -----
+ ensureContextHasBytecodePC: aContext
+ 	"Make sure the context has a byetcode pc.  Can only be used on single contexts."
+ 	| pc |
+ 	self assert: (self isMarriedOrWidowedContext: aContext) not.
+ 	pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
+ 	((objectMemory isIntegerObject: pc)
+ 	 and: [(pc := objectMemory integerValueOf: pc) < 0]) ifTrue:
+ 		[pc := self mustMapMachineCodePC: pc context: aContext.
+ 		 objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: aContext withValue: pc]!

Item was changed:
  ----- Method: CoInterpreter>>ensureContextIsExecutionSafeAfterAssignToStackPointer: (in category 'frame access') -----
  ensureContextIsExecutionSafeAfterAssignToStackPointer: aContext
  	"Safety to give the JIT lattitude in calling convention.  Conceptually, returning
  	 a value to a context involves pushing that value onto the stack.  This is used
  	 in Squeak methods such as ContextPart>>jump
  		jump
  			| top |
  			thisContext sender push: nil.
  			stackp = 0 ifTrue: [self stepToSendOrReturn].
  			stackp = 0 ifTrue: [self push: nil].
  			top := self pop.
  			thisContext privSender: self.
  			^top
  	 Here jump may pop the value of a temporary variable off the stack which will,
  	 conceptually and, in the interpreter, actually, get pushed back on return.  But
  	 if the JIT is mapping the stack to registers disaster may ensue since the value
  	 may not get pushed to the stack and code may access an invalid value (e.g. a pc).
  
  	 The solution is to fall back on the interpreter.  If the stack pointer is changed we
  	 also ensure the pc is a bytecode pc (+ive) which will cause makeBaseFrameFor:
  	 to create an interpreter frame if the context is executed again."
- 	| pc |
  	<inline: false>
+ 	self ensureContextHasBytecodePC: aContext!
- 	self assert: (self isMarriedOrWidowedContext: aContext) not.
- 	pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
- 	((objectMemory isIntegerObject: pc)
- 	 and: [(pc := objectMemory integerValueOf: pc) < 0]) ifTrue:
- 		[pc := self mustMapMachineCodePC: pc context: aContext.
- 		 objectMemory storePointerUnchecked: InstructionPointerIndex ofObject: aContext withValue: pc]!

Item was changed:
  ----- Method: CoInterpreter>>voidVMStateForSnapshot (in category 'frame access') -----
  voidVMStateForSnapshot
  	"Make sure that all VM state that affects the heap contents is voided so that the heap is ready
  	 to be snapshotted. Answer the activeContext object that should be stored in the snapshot."
+ 	<inline: false>
  	| activeContext |
  	instructionPointer := 0. "in case of code compactions."
  	activeContext := self divorceAllFrames.
  	self ensureAllContextsHaveBytecodePCsOrAreBereaved.
  	cogit voidCogCompiledCode.
  	^activeContext!

Item was changed:
  ----- Method: CoInterpreterPrimitives>>primitiveFlushCacheByMethod (in category 'system control primitives') -----
  primitiveFlushCacheByMethod
  	"The receiver is a compiledMethod.  Clear all entries in the method lookup cache that
  	 refer to this method, presumably because it has been redefined, overridden or removed.
  	 Override to flush appropriate machine code caches also."
  	super primitiveFlushCacheByMethod.
+ 	cogit unlinkSendsTo: self stackTop andFreeIf: false!
- 	cogit unlinkSendsTo: self stackTop!

Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveMethodXray (in category 'indexing primitives') -----
+ primitiveMethodXray
+ 	"Lift the veil from a method and answer an integer describing the interior state
+ 	 of its machine code.
+ 	 Used for e.g. VM tests so they can verify they're testing what they think they're testing.
+ 	 0 implies a vanilla method.
+ 	 Bit 0 = method is currently compiled to machine code
+ 	 Bit 1 = is compiled frameless.
+ 	 Bit 2 = method refers to young object"
+ 	<export: true>
+ 	| flags cogMethod |
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	(self maybeMethodHasCogMethod: self stackTop)
+ 		ifTrue:
+ 			[cogMethod := self cogMethodOf: self stackTop.
+ 			 flags := cogMethod stackCheckOffset = 0 ifTrue: [3] ifFalse: [1].
+ 			 cogMethod cmRefersToYoung ifTrue:
+ 				[flags := flags + 4]]
+ 		ifFalse: [flags := 0].
+ 	self pop: 1 thenPush: (objectMemory integerObjectOf: flags)!

Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveVoidVMStateForMethod (in category 'system control primitives') -----
+ primitiveVoidVMStateForMethod
+ 	"The receiver is a compiledMethod.  Clear all VM state associated with the method,
+ 	 including any machine code, or machine code pcs in context objects."
+ 	<var: #theFrame type: #'char *'>
+ 	<var: #thePage type: #'StackPage *'>
+ 	super primitiveFlushCacheByMethod.
+ 	(self methodHasCogMethod: self stackTop) ifTrue:
+ 		[| activeContext methodObj theFrame thePage |
+ 		methodObj := self stackTop.
+ 		self push: instructionPointer.
+ 		self externalWriteBackHeadFramePointers.
+ 		activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
+ 		self divorceMachineCodeFramesWithMethod: methodObj.
+ 		self ensureAllContextsWithMethodHaveBytecodePCs: methodObj.
+ 		cogit unlinkSendsTo: methodObj andFreeIf: true.
+ 		(self isStillMarriedContext: activeContext)
+ 			ifTrue:
+ 				[theFrame := self frameOfMarriedContext: activeContext.
+ 				 thePage := stackPages stackPageFor: theFrame.
+ 				 self assert: thePage headFP = theFrame.
+ 				 self setStackPageAndLimit: thePage.
+ 				 stackPointer := thePage headSP.
+ 				 framePointer := thePage headFP.
+ 				 instructionPointer := self popStack.
+ 				 self assert: methodObj = self stackTop]
+ 			ifFalse:
+ 				[stackPage := 0. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
+ 				 self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
+ 				 self popStack. "pop bogus machine-code instructionPointer"
+ 				 self assert: methodObj = self stackTop.
+ 				 self siglong: reenterInterpreter jmp: ReturnToInterpreter]]
+ !

Item was changed:
  ----- Method: CogMethodZone>>freeMethod: (in category 'compaction') -----
  freeMethod: cogMethod
  	<var: #cogMethod type: #'CogMethod *'>
+ 	<inline: false>
  	self assert: cogMethod cmType ~= CMFree.
  	self assert: (cogit cogMethodDoesntLookKosher: cogMethod) = 0.
  	cogMethod cmType = CMMethod ifTrue:
+ 		["For non-Newspeak there should ne a one-to-one mapping between bytecoded and
- 		["For non-Newspeak there should ne a one-to-one mapping metween bytecoded and
  		  cog methods. For Newspeak not necessarily, but only for anonymous accessors."
  		 self assert: ((coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger
  					or: [(cogit noAssertMethodClassAssociationOf: cogMethod methodObject) = objectMemory nilObject]).
  		"Only reset the original method's header if it is referring to this CogMethod."
  		 (coInterpreter rawHeaderOf: cogMethod methodObject) asInteger = cogMethod asInteger ifTrue:
  			[coInterpreter
  				rawHeaderOf: cogMethod methodObject
  				put: cogMethod methodHeader].
  		 cogMethod cmRefersToYoung: false].
  	cogMethod cmType = CMOpenPIC ifTrue:
  		[self removeFromOpenPICList: cogMethod.
  		 cogMethod cmRefersToYoung: false].
  	cogMethod cmType: CMFree.
  	methodBytesFreedSinceLastCompaction := methodBytesFreedSinceLastCompaction
  											+ cogMethod blockSize!

Item was changed:
  CoInterpreterMT subclass: #CogVMSimulator
  	instanceVariableNames: 'enableCog byteCount lastPollCount sendCount printSends traceOn myBitBlt displayForm imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes uniqueIndices uniqueIndex breakCount atEachStepBlock startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize debugStackDepthDictionary'
+ 	classVariableNames: ''
- 	classVariableNames: 'DebugStackPointers'
  	poolDictionaries: ''
  	category: 'VMMaker-JITSimulation'!
  
  !CogVMSimulator commentStamp: '<historical>' prior: 0!
  This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment.  It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
  
  To see the thing actually run, you could (after backing up this image and changes), execute
  
  	(CogVMSimulator new openOn: Smalltalk imageName) test
  
  and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be.  We usually do this with a small and simple benchmark image. You will probably have more luck using InterpreteSimulatorLSB or InterpreterSimulatorMSB as befits your machine.!

Item was changed:
  ----- Method: CogVMSimulator>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
  ceSendFromInLineCacheMiss: oPIC
  	"Override to map the address into a CogMethodSurrogate"
  	| surrogate |
+ 	surrogate := oPIC isInteger
+ 					ifTrue: [cogit cogMethodSurrogateAt: oPIC]
+ 					ifFalse: [oPIC].
- 	surrogate := cogit cogMethodSurrogateAt: oPIC.
  	self logSend: surrogate selector.
  	^super ceSendFromInLineCacheMiss: surrogate!

Item was removed:
- ----- Method: Cogit>>unlinkSendsTo: (in category 'jit - api') -----
- unlinkSendsTo: targetMethodObject
- 	<api>
- 	"Unlink all sends in cog methods to a particular target method.
- 	 If targetMethodObject isn't actually a method (perhaps being
- 	 used via invokeAsMethod) then flush all sends since anything
- 	 could be affected."
- 	| cogMethod targetMethod freedPIC |
- 	<var: #cogMethod type: #'CogMethod *'>
- 	<var: #targetMethod type: #'CogMethod *'>
- 	((objectMemory isOopCompiledMethod: targetMethodObject)
- 	and: [coInterpreter methodHasCogMethod: targetMethodObject]) ifFalse:
- 		[^self].
- 	targetMethod := coInterpreter cogMethodOf: targetMethodObject.
- 	methodZoneBase isNil ifTrue: [^self].
- 	codeModified := freedPIC := false.
- 	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
- 	[cogMethod < methodZone limitZony] whileTrue:
- 		[cogMethod cmType = CMMethod
- 			ifTrue:
- 				[self mapFor: cogMethod
- 					 performUntil: #unlinkIfLinkedSend:pc:to: asSymbol
- 					 arg: targetMethod asInteger]
- 			ifFalse:
- 				[(cogMethod cmType = CMClosedPIC
- 				  and: [self cPIC: cogMethod HasTarget: targetMethod]) ifTrue:
- 					[methodZone freeMethod: cogMethod.
- 					 freedPIC := true]].
- 		cogMethod := methodZone methodAfter: cogMethod].
- 	freedPIC
- 		ifTrue: [self unlinkSendsToFree]
- 		ifFalse:
- 			[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
- 				[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]]!

Item was added:
+ ----- Method: Cogit>>unlinkSendsTo:andFreeIf: (in category 'jit - api') -----
+ unlinkSendsTo: targetMethodObject andFreeIf: freeIfTrue
+ 	<api>
+ 	"Unlink all sends in cog methods to a particular target method.
+ 	 If targetMethodObject isn't actually a method (perhaps being
+ 	 used via invokeAsMethod) then flush all sends since anything
+ 	 could be affected."
+ 	| cogMethod targetMethod freedPIC |
+ 	<var: #cogMethod type: #'CogMethod *'>
+ 	<var: #targetMethod type: #'CogMethod *'>
+ 	((objectMemory isOopCompiledMethod: targetMethodObject)
+ 	and: [coInterpreter methodHasCogMethod: targetMethodObject]) ifFalse:
+ 		[^self].
+ 	targetMethod := coInterpreter cogMethodOf: targetMethodObject.
+ 	methodZoneBase isNil ifTrue: [^self].
+ 	codeModified := freedPIC := false.
+ 	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
+ 	[cogMethod < methodZone limitZony] whileTrue:
+ 		[cogMethod cmType = CMMethod
+ 			ifTrue:
+ 				[self mapFor: cogMethod
+ 					 performUntil: #unlinkIfLinkedSend:pc:to: asSymbol
+ 					 arg: targetMethod asInteger]
+ 			ifFalse:
+ 				[(cogMethod cmType = CMClosedPIC
+ 				  and: [self cPIC: cogMethod HasTarget: targetMethod]) ifTrue:
+ 					[methodZone freeMethod: cogMethod.
+ 					 freedPIC := true]].
+ 		cogMethod := methodZone methodAfter: cogMethod].
+ 	freeIfTrue ifTrue: [self freeMethod: targetMethod].
+ 	freedPIC
+ 		ifTrue: [self unlinkSendsToFree]
+ 		ifFalse:
+ 			[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 				[processor flushICacheFrom: methodZoneBase to: methodZone limitZony asInteger]]!

Item was changed:
  ----- Method: StackInterpreter class>>initializeAssociationIndex (in category 'initialization') -----
  initializeAssociationIndex
+ 	KeyIndex := 0.
  	ValueIndex := 1!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: StackInterpreter>>externalDivorceFrame:andContext: (in category 'frame access') -----
  externalDivorceFrame: theFP andContext: ctxt
  	"Divorce a single frame and its context.  If it is not the top frame of a stack this means splitting its stack."
  	| thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP |
  	<inline: false>
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #theSP type: #'char *'>
  	<var: #newPage type: #'StackPage *'>
  	<var: #frameAbove type: #'char *'>
  	<var: #callerFP type: #'char *'>
  	<var: #callerSP type: #'char *'>
  	"stackPage needs to have current head pointers to avoid confusion."
- 	self assert: theFP ~= framePointer.
  	self assert: (stackPage = 0 or: [stackPage = stackPages mostRecentlyUsedPage]).
  	thePage := stackPages stackPageFor: theFP.
  	(onCurrent := thePage = stackPage) ifFalse:
  		[stackPages markStackPageNextMostRecentlyUsed: thePage].
  	theSP := self findSPOf: theFP on: thePage.
  	self updateStateOfSpouseContextForFrame: theFP WithSP: theSP.
  	callerCtx := self ensureCallerContext: theFP.
  	(frameAbove := self findFrameAbove: theFP inPage: thePage) == 0
  		ifTrue: "If we're divorcing the top frame we can simply peel it off."
  			[theIP := stackPages longAt: thePage headSP]
  		ifFalse: "othewise move all frames above to a new stack and then peel the frame off."
  			[newPage := self newStackPage.
  			 theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove).
  			 frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage.
  			 onCurrent
  				ifTrue:
  					[self setStackPageAndLimit: newPage.
  					 framePointer := stackPage headFP.
  					 stackPointer := stackPage headSP]
  				ifFalse:
  					[stackPages markStackPageMostRecentlyUsed: newPage].
  			 self assert: (self frameCallerContext: frameAbove) = ctxt].
  	objectMemory storePointerUnchecked: InstructionPointerIndex
  		ofObject: ctxt
  		withValue: (self contextInstructionPointer: theIP frame: theFP).
  	objectMemory storePointer: SenderIndex
  		ofObject: ctxt
  		withValue: callerCtx.
  	callerFP := self frameCallerFP: theFP.
  	callerFP == 0 "theFP is a base frame; it is now alone; free the entire page"
  		ifTrue: [stackPages freeStackPage: thePage]
  		ifFalse:
  			[callerIP := self oopForPointer: (self frameCallerSavedIP: theFP).
  			 callerSP := (self frameCallerSP: theFP) - BytesPerWord.
  			 stackPages longAt: callerSP put: callerIP.
  			 self setHeadFP: callerFP andSP: callerSP inPage: thePage]
  	!

Item was changed:
  ----- Method: StackInterpreter>>isWidowedContext: (in category 'frame access') -----
  isWidowedContext: aOnceMarriedContext
  	"See if the argument is connected with a live frame or not.
  	 If it is not, turn it into a bereaved single context."
  	| theFrame thePage shouldBeFrameCallerField |
  	<var: #theFrame type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #shouldBeFrameCallerField type: #'char *'>
+ 	self assert: ((self isContext: aOnceMarriedContext)
+ 				  and: [self isMarriedOrWidowedContext: aOnceMarriedContext]).
- 	self assert: (self isContext: aOnceMarriedContext).
  	theFrame := self frameOfMarriedContext: aOnceMarriedContext.
  	thePage := stackPages stackPageFor: theFrame.
  	((stackPages isFree: thePage)
  	 or: [theFrame < thePage headFP]) ifFalse:
  		["The frame pointer is within the bounds of a live page.
  		   Now check if it matches a frame."
  		 shouldBeFrameCallerField := self withoutSmallIntegerTags:
  										(objectMemory fetchPointer: InstructionPointerIndex
  											ofObject: aOnceMarriedContext).
  		 ((self frameCallerFP: theFrame) = shouldBeFrameCallerField
  		  and: [(self frameMethodObject: theFrame) = (objectMemory fetchPointer: MethodIndex
  													ofObject: aOnceMarriedContext)
  		  and: [(self frameHasContext: theFrame)
  		  and: [(self frameContext: theFrame) = aOnceMarriedContext]]]) ifTrue:
  			["It is still married!!"
  			^false]].
  	"It is out of range or doesn't match the frame's context.
  	 It is widowed. Time to wear black."
  	self markContextAsDead: aOnceMarriedContext.
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>marryContextInNewStackPageAndInitializeInterpreterRegisters: (in category 'frame access') -----
  marryContextInNewStackPageAndInitializeInterpreterRegisters: aContext
  	"Establish aContext at the base of a new stackPage, make the stackPage the
  	 active one and set-up the interreter registers.  This is used to boot the system
  	 and bring it back after a snapshot."
+ 	<inline: false>
  	| newPage |
  	<var: #newPage type: #'StackPage *'>
  	self assert: stackPage = 0.
  	newPage := self makeBaseFrameFor: aContext.
  	self setStackPageAndLimit: newPage.
  	framePointer := stackPage headFP.
  	stackPointer := stackPage headSP.
  	self setMethod: (self iframeMethod: stackPage headFP).
  	instructionPointer := self popStack!

Item was changed:
  ----- Method: StackInterpreter>>printContext: (in category 'debug printing') -----
  printContext: aContext
  	| sender ip sp |
  	<inline: false>
  	self shortPrintContext: aContext.
  	sender := objectMemory fetchPointer: SenderIndex ofObject: aContext.
  	ip := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  	(objectMemory isIntegerObject: sender)
  		ifTrue:
  			[(self checkIsStillMarriedContext: aContext currentFP: framePointer)
  				ifTrue: [self print: 'married (assuming framePointer valid)'; cr]
+ 				ifFalse: [self print: 'widowed (assuming framePointer valid)'; cr].
- 				ifFalse: [self print: 'widdowed (assuming framePointer valid)'; cr].
  			self print: 'sender   '; printNum: sender; print: ' (';
  				printHexPtr: (self withoutSmallIntegerTags: sender); printChar: $); cr.
  			 self print: 'ip       '; printNum: ip; print: ' (';
  				printHexPtr: (self withoutSmallIntegerTags: ip); printChar: $); cr]
  		ifFalse:
  			[self print: 'sender   '; shortPrintOop: sender.
  			 self print: 'ip       '.
  			 ip = objectMemory nilObject
  				ifTrue: [self shortPrintOop: ip]
  				ifFalse: [self printNum: ip; print: ' ('; printNum: (objectMemory integerValueOf: ip); space; printHex: (objectMemory integerValueOf: ip); printChar: $); cr]].
  	sp := objectMemory fetchPointer: StackPointerIndex ofObject: aContext.
  	sp := sp min: (objectMemory lengthOf: aContext) - ReceiverIndex.
  	self print: 'sp       '; printNum: sp; print: ' ('; printNum: (objectMemory integerValueOf: sp); printChar: $); cr.
  	self print: 'method   '; shortPrintOop: (objectMemory fetchPointer: MethodIndex ofObject: aContext).
  	self print: 'closure  '; shortPrintOop: (objectMemory fetchPointer: ClosureIndex ofObject: aContext).
  	self print: 'receiver '; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex ofObject: aContext).
  	sp := objectMemory integerValueOf: sp.
  	1 to: sp do:
  		[:i|
  		self print: '       '; printNum: i; space; shortPrintOop: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)]!

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  	| classOop name nameLen |
  	<var: #name type: #'char *'>
  	<inline: true>
  	(objectMemory isIntegerObject: oop) ifTrue:
  		[self printNum: (objectMemory integerValueOf: oop);
  			printChar: $(;
  			printHex: (objectMemory integerValueOf: oop);
  			printChar: $).
  		 ^nil].
  	(oop between: objectMemory startOfMemory and: objectMemory freeStart) ifFalse:
  		[self printHex: oop; print: ' is not on the heap'.
  		 ^nil].
  	(oop bitAnd: (BytesPerWord - 1)) ~= 0 ifTrue:
  		[self printHex: oop; print: ' is misaligned'.
  		 ^nil].
  	(self isFloatObject: oop) ifTrue:
  		[self printFloat: (self dbgFloatValueOf: oop).
  		 ^nil].
  	classOop := objectMemory fetchClassOfNonInt: oop.
  	(objectMemory addressCouldBeObj: classOop) ifFalse:
  		[self print: 'a ??'. ^nil].
  	(objectMemory sizeBitsOf: classOop) = metaclassSizeBytes ifTrue:
  		[self printNameOfClass: oop count: 5.
  		 ^nil].
  	oop = objectMemory nilObject ifTrue: [self print: 'nil'. ^nil].
  	oop = objectMemory trueObject ifTrue: [self print: 'true'. ^nil].
  	oop = objectMemory falseObject ifTrue: [self print: 'false'. ^nil].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [self print: 'a ??'. ^nil].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
  		[(self str: name n: 'ByteString' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $'; printStringOf: oop; printChar: $'.
  			 ^nil].
  		 (self str: name n: 'ByteSymbol' cmp: 10) not "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop.
  			 ^nil]].
  	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) not]) ifTrue:
  		[self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop)).
  		 ^nil].
  	self cCode: [self prin: 'a(n) %.*s' t: nameLen f: name]
+ 		inSmalltalk: [self print: 'a(n) '; print: name].
+ 	"Try to spot association-like things; they're all subclasses of LookupKey"
+ 	((objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
+ 	 and: [(self superclassOf: classOop) = (self superclassOf: (self fetchClassOfNonInt: (objectMemory splObj: SchedulerAssociation)))
+ 	 and: [self isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop)]]) ifTrue:
+ 		[self space;
+ 			printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
+ 			print: ' -> ';
+ 			printHex: (objectMemory fetchPointer: ValueIndex ofObject: oop)]!
- 		inSmalltalk: [self print: 'a(n) '; print: name]!

Item was changed:
  ----- Method: TGoToNode>>setLabel: (in category 'accessing') -----
  setLabel: aString
+ 	label := aString!
- 
- 	label := aString.!

Item was changed:
  ----- Method: TMethod>>exitVar:label: (in category 'inlining') -----
  exitVar: exitVar label: exitLabel
  	"Replace each return statement in this method with an assignment to the exit variable followed by a goto to the given label. Return true if a goto was generated."
  	"Optimization: If exitVar is nil, the return value of the inlined method is not being used, so don't add the assignment statement."
  
+ 	| labelUsed |
- 	| newStmts labelUsed |
  	labelUsed := false.
+ 	parseTree nodesDo:
+ 		[:node | | newStmts |
+ 		node isStmtList ifTrue:
+ 			[newStmts := OrderedCollection new: 100.
+ 			node statements do:
+ 				[:stmt |
+ 				stmt isReturn
+ 					ifTrue:
+ 						[exitVar
+ 							ifNil:
+ 								[stmt expression isLeaf ifFalse: "evaluate return expression even though value isn't used"
+ 									[newStmts add: stmt expression]]
+ 							ifNotNil: "assign return expression to exit variable"
+ 								[newStmts add:
+ 									(TAssignmentNode new
+ 										setVariable: (TVariableNode new setName: exitVar)
+ 										expression: stmt expression)].
+ 						stmt ~~ parseTree statements last ifTrue: "generate a goto (this return is NOT the last statement in the method)"
+ 							[newStmts add: (TGoToNode new setLabel: exitLabel).
+ 							labelUsed := true]]
+ 					ifFalse: [newStmts addLast: stmt]].
+ 			node setStatements: newStmts asArray]].
- 	parseTree nodesDo: [ :node |
- 		node isStmtList ifTrue: [
- 			newStmts := OrderedCollection new: 100.
- 			node statements do: [ :stmt |
- 				(stmt isReturn) ifTrue: [
- 					exitVar = nil ifTrue: [
- 						stmt expression isLeaf ifFalse: [
- 							"evaluate return expression even though value isn't used"
- 							newStmts add: stmt expression.
- 						].
- 					] ifFalse: [
- 						"assign return expression to exit variable"
- 						newStmts add:
- 							(TAssignmentNode new
- 								setVariable: (TVariableNode new setName: exitVar)
- 								expression: stmt expression).
- 					].
- 					(stmt == parseTree statements last) ifFalse: [
- 						"generate a goto (this return is NOT the last statement in the method)"
- 						newStmts add: (TGoToNode new setLabel: exitLabel).
- 						labelUsed := true.
- 					].
- 				] ifFalse: [
- 					newStmts addLast: stmt.
- 				].
- 			].
- 			node setStatements: newStmts asArray.
- 		].
- 	].
  	^labelUsed!

Item was changed:
  ----- Method: TMethod>>inlineCodeOrNilForStatement:in: (in category 'inlining') -----
  inlineCodeOrNilForStatement: aNode in: aCodeGen
  	"If the given statement node can be inlined, answer the statements that replace it. Otherwise, answer nil."
  
  	| stmts |
  	aNode isReturn ifTrue:
  		[(self inlineableSend: aNode expression in: aCodeGen) ifTrue:
  			[stmts := self inlineSend: aNode expression
  				directReturn: true exitVar: nil in: aCodeGen.
  			^stmts]].
  	(aNode isAssignment and: [aNode expression isSend])  ifTrue:
  		[(self inlineableSend: aNode expression in: aCodeGen) ifTrue:
  			[^self inlineSend: aNode expression
  				directReturn: false exitVar: aNode variable name in: aCodeGen]].
  	aNode isSend ifTrue:
  		[(self inlineableSend: aNode in: aCodeGen) ifTrue:
  			[^self inlineSend: aNode
  				directReturn: false exitVar: nil in: aCodeGen]].
  	^nil!

Item was changed:
  ----- Method: TMethod>>statementsListsForInlining (in category 'inlining') -----
  statementsListsForInlining
  	"Answer a collection of statement list nodes that are candidates for inlining.
  	 Currently, we cannot inline into the argument blocks of and: and or: messages.
  	 We do not want to inline code within cCode:inSmalltalk: blocks.
  	 We do not want to inline code within assert: sends"
  
  	| stmtLists |
  	stmtLists := OrderedCollection new: 10.
  	parseTree
  		nodesDo:
  			[ :node | 
  			node isStmtList ifTrue: [ stmtLists add: node ]]
  		unless:
  			[ :node |
  			node isSend and: [#(cCode:inSmalltalk: assert:) includes: node selector]].
  	parseTree nodesDo:
  		[ :node | 
  		node isSend ifTrue:
  			[node selector = #cCode:inSmalltalk: ifTrue:
  				[node nodesDo:
  					[:inStNode| stmtLists remove: inStNode ifAbsent: []]].
  			 node selector = #cppIf:ifTrue:ifFalse: ifTrue:
  				[node args first nodesDo:
  					[:inCondNode| stmtLists remove: inCondNode ifAbsent: []]].
  			((node selector = #and:) or: [node selector = #or:]) ifTrue:
  				"Note: the PP 2.3 compiler produces two arg nodes for these selectors"
  				[stmtLists remove: node args first ifAbsent: [].
  				stmtLists remove: node args last ifAbsent: []].
  			(#(	#ifTrue: #ifFalse: #ifTrue:ifFalse: #ifFalse:ifTrue:
  				#ifNil: #ifNotNil: #ifNil:ifNotNil: #ifNotNil:ifNil: ) includes: node selector) ifTrue:
  				[stmtLists remove: node receiver ifAbsent: []].
+ 			(#(whileTrue whileTrue: whilefalse whileFalse:) includes: node selector) ifTrue:
- 			((node selector = #whileFalse:) or: [node selector = #whileTrue:]) ifTrue:
  				"Allow inlining if it is a [...] whileTrue/whileFalse.
  				This is identified by having more than one statement in the 
  				receiver block in which case the C code wouldn't work anyways"
  				[node receiver statements size = 1 ifTrue:
  					[stmtLists remove: node receiver ifAbsent: []]].
  			(node selector = #to:do:) ifTrue:
  				[stmtLists remove: node receiver ifAbsent: [].
  				stmtLists remove: node args first ifAbsent: []].
+ 			(node selector = #to:by:do:) ifTrue:
+ 				[stmtLists remove: node receiver ifAbsent: [].
- 			(node selector = #to:by:do:) ifTrue: [
- 				stmtLists remove: node receiver ifAbsent: [].
  				stmtLists remove: node args first ifAbsent: [].
  				stmtLists remove: node args second ifAbsent: []]].
  		node isCaseStmt ifTrue: "don't inline cases"
  			[node cases do: [: case | stmtLists remove: case ifAbsent: []]]].
  	^stmtLists!

Item was changed:
  SharedPool subclass: #VMObjectIndices
  	instanceVariableNames: ''
+ 	classVariableNames: 'ActiveProcessIndex CharacterTable CharacterValueIndex ClassAlien ClassArray ClassBitmap ClassBlockClosure ClassBlockContext ClassByteArray ClassByteString ClassCharacter ClassCompiledMethod ClassExternalAddress ClassExternalData ClassExternalFunction ClassExternalLibrary ClassExternalStructure ClassFloat ClassInteger ClassLargeNegativeInteger ClassLargePositiveInteger ClassMessage ClassMethodContext ClassMutex ClassPoint ClassProcess ClassSemaphore ClassString ClassUnsafeAlien ClassWeakFinalizer ClosureCopiedValuesIndex ClosureFirstCopiedValueIndex ClosureIndex ClosureNumArgsIndex ClosureOuterContextIndex ClosureStartPCIndex CompactClasses ConstMinusOne ConstOne ConstTwo ConstZero ExcessSignalsIndex ExternalObjectsArray FalseObject FirstLinkIndex ForeignCallbackProcess HeaderIndex InstanceSpecificationIndex InstructionPointerIndex KeyIndex LastLinkIndex LiteralStart MessageArgumentsIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodDictionaryIndex MethodIndex MyListIndex NextLinkIndex NilObject PrimErrTableIndex PriorityIndex ProcessInExternalCodeTag ProcessListsIndex ProcessSignalingLowSpace ReceiverIndex SchedulerAssociation SelectorAboutToReturn SelectorAttemptToAssign SelectorCannotInterpret SelectorCannotReturn SelectorCounterTripped SelectorDoesNotUnderstand SelectorInvokeCallback SelectorMustBeBoolean SelectorRunWithIn SelectorStart SenderIndex SpecialSelectors StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TheDisplay TheFinalizationSemaphore TheInputSemaphore TheInterruptSemaphore TheLowSpaceSemaphore TheTimerSemaphore TrueObject ValueIndex XIndex YIndex'
- 	classVariableNames: 'ActiveProcessIndex CharacterTable CharacterValueIndex ClassAlien ClassArray ClassBitmap ClassBlockClosure ClassBlockContext ClassByteArray ClassByteString ClassCharacter ClassCompiledMethod ClassExternalAddress ClassExternalData ClassExternalFunction ClassExternalLibrary ClassExternalStructure ClassFloat ClassInteger ClassLargeNegativeInteger ClassLargePositiveInteger ClassMessage ClassMethodContext ClassMutex ClassPoint ClassProcess ClassSemaphore ClassString ClassUnsafeAlien ClassWeakFinalizer ClosureCopiedValuesIndex ClosureFirstCopiedValueIndex ClosureIndex ClosureNumArgsIndex ClosureOuterContextIndex ClosureStartPCIndex CompactClasses ConstMinusOne ConstOne ConstTwo ConstZero ExcessSignalsIndex ExternalObjectsArray FalseObject FirstLinkIndex ForeignCallbackProcess HeaderIndex InstanceSpecificationIndex InstructionPointerIndex LastLinkIndex LiteralStart MessageArgumentsIndex MessageLookupClassIndex MessageSelectorIndex MethodArrayIndex MethodDictionaryIndex MethodIndex MyListIndex NextLinkIndex NilObject PrimErrTableIndex PriorityIndex ProcessInExternalCodeTag ProcessListsIndex ProcessSignalingLowSpace ReceiverIndex SchedulerAssociation SelectorAboutToReturn SelectorAttemptToAssign SelectorCannotInterpret SelectorCannotReturn SelectorCounterTripped SelectorDoesNotUnderstand SelectorInvokeCallback SelectorMustBeBoolean SelectorRunWithIn SelectorStart SenderIndex SpecialSelectors StackPointerIndex StreamArrayIndex StreamIndexIndex StreamReadLimitIndex StreamWriteLimitIndex SuperclassIndex SuspendedContextIndex TheDisplay TheFinalizationSemaphore TheInputSemaphore TheInterruptSemaphore TheLowSpaceSemaphore TheTimerSemaphore TrueObject ValueIndex XIndex YIndex'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMObjectIndices commentStamp: '<historical>' prior: 0!
  I am a shared pool for the constants that define object layout and well-known objects shared between the object memories (e.g. ObjectMemory, NewObjectMemory), the interpreters (e.g. StackInterpreter, CoInterpreter) and the object representations (e.g. ObjectRepresentationForSqueakV3).
  
  self classPool declare: #Foo from: StackInterpreter classPool
  
  (ObjectMemory classPool keys select: [:k| (k beginsWith: 'Class') and: [(k endsWith: 'Index') not]]) do:
  	[:k| self classPool declare: k from: ObjectMemory classPool]!

Item was changed:
  ----- Method: VMStructType class>>prepareToBeAddedToCodeGenerator: (in category 'translation') -----
  prepareToBeAddedToCodeGenerator: aCodeGen
  	aCodeGen
  		removeVariable: 'coInterpreter';
  		removeVariable: 'cogit';
  		removeVariable: 'objectMemory';
+ 		removeVariable: 'objectRepresentation' ifAbsent: []!
- 		removeVariable: 'objectRepresentation'!



More information about the Vm-dev mailing list