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

commits at source.squeak.org commits at source.squeak.org
Tue Aug 26 11:58:34 UTC 2014


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

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

Name: Cog.pharo-EstebanLorenzano.199
Author: EstebanLorenzano
Time: 26 August 2014, 1:58:10.563781 pm
UUID: 900e8bda-7c0f-4468-9636-a6c2855c3b69
Ancestors: Cog-EstebanLorenzano.198

- merge
- last moment fixes

=============== Diff against Cog-eem.197 ===============

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 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 changed:
  ----- 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:
+ 		[ Smalltalk tools debugger 
+ 			openContext: self
- 		[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 changed:
+ ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes pharo') -----
- ----- Method: SpurBootstrap class>>CharacterPROTOTYPEshallowCopy (in category 'method prototypes') -----
  CharacterPROTOTYPEshallowCopy
  	"Answer the receiver, because Characters are unique."
  	^self!

Item was changed:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEactivateReturn:value: (in category 'method prototypes squeak') -----
- ----- 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 changed:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes squeak') -----
- ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEdoPrimitive:method:receiver:args: (in category 'method prototypes') -----
  ContextPartPROTOTYPEdoPrimitive: primitiveIndex method: meth receiver: receiver args: arguments 
  	<indirect>!

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

Item was changed:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEsend:to:with:lookupIn: (in category 'method prototypes squeak') -----
- ----- 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 changed:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEsend:to:with:super: (in category 'method prototypes squeak') -----
- ----- 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 changed:
+ ----- Method: SpurBootstrap class>>ContextPartPROTOTYPEtryNamedPrimitiveIn:for:withArgs: (in category 'method prototypes squeak') -----
- ----- 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 changed:
+ ----- Method: SpurBootstrap class>>InstructionStreamPROTOTYPEinterpretV3ClosuresExtension:in:for: (in category 'method prototypes old squeak') -----
- ----- 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 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 changed:
  ----- Method: SpurBootstrap>>addMissingClassVars: (in category 'bootstrap image') -----
  addMissingClassVars: classVars
  	"Add any missing class vars given classVars, a Dictionary from nonMetaClass to binding.
  	 Initialize any classes that get inst vars added."
  	| addClassVarNameSym bindingOfSym |
  	classVars isEmpty ifTrue:
  		[^self].
  	addClassVarNameSym := self findSymbol: #addClassVarName:.
+ 	addClassVarNameSym ifNil: 
+ 		[addClassVarNameSym := self findSymbol: #addClassVarNamed:].
  	bindingOfSym := self findSymbol: #bindingOf:.
  	classVars keysAndValuesDo:
  		[:binding :class| 
  		Transcript cr;  nextPutAll: 'ADDING CLASS VAR '; store: binding key; nextPutAll: ' TO '; print: class; flush.
  		self interpreter: oldInterpreter
  			object: (self oldClassOopFor: class)
  			perform: addClassVarNameSym
  			withArguments: {oldHeap stringForCString: binding key}.
  		literalMap
  			at: binding
  			put: (self interpreter: oldInterpreter
  					object: (self oldClassOopFor: class)
  					perform: bindingOfSym
  					withArguments: {self findSymbol: binding key})].
  	toBeInitialized := classVars asSet!

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>>checkReshapeOf: (in category 'bootstrap image') -----
  checkReshapeOf: ourMethodClasses
  	"Check the shape of all our method classes match the shape of those in the image to be bootstrapped.
  	 Use the simulator to redefine any that need it.  Does /not/ reshape metaclasses; these we assume are ok."
  	| toReshape |
  	toReshape := Set new.
  	ourMethodClasses do:
+ 		[:mc|
+ 		(literalMap at: mc binding ifAbsent: []) ifNotNil:
+ 			[:binding|
+ 			(mc ~~ Character "Character will reshape anyway"
+ 			 and: [mc instSize ~= (oldHeap instanceSizeOf: (oldHeap fetchPointer: ValueIndex ofObject: binding))]) ifTrue:
+ 				[toReshape add: mc]]].
- 		[:mc| | binding |
- 		binding := literalMap at: mc binding.
- 		self assert: binding ~= oldHeap nilObject.
- 		(mc ~~ Character "Character will reshape anyway"
- 		 and: [mc instSize ~= (oldHeap instanceSizeOf: (oldHeap fetchPointer: ValueIndex ofObject: binding))]) ifTrue:
- 			[toReshape add: mc]].
  	toReshape isEmpty ifTrue:
  		[^self].
  	"Assume only one class in any subtree needs reshaping.  Fast and loose but gets us there for now."
  	toReshape copy do:
  		[:class|
  		toReshape removeAll: (toReshape select: [:ea| ea inheritsFrom: class])].
  	toReshape do:
  		[:class|
  		Transcript cr;  nextPutAll: 'RESHAPING '; print: class; flush.
  		self interpreter: oldInterpreter
  			object: (self oldClassOopFor: Compiler)
  			perform: (self findSymbol: #evaluate:)
  			withArguments: {oldHeap stringForCString: class definition}]!

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 ~= SpurBootstrap class ifTrue:
+ 				[ourMethodClasses addAll: allNonMetaSupers].
+ 			globals addAll: (allNonMetaSupers collect: [:sc| sc binding]).
+ 			method literals do:
+ 				[:l|
+ 				(l isVariableBinding and: [l key isSymbol]) ifTrue:
+ 					[(Smalltalk bindingOf: l key) == l
+ 						ifTrue: [globals add: l]
+ 						ifFalse:
+ 							[self assert: (nonMetaClass bindingOf: l key) == l.
+ 							classVars at: l put: nonMetaClass]]]]].
- 		[:c :m :s :method| | nonMetaClass allNonMetaSupers |
- 		allNonMetaSupers := (nonMetaClass := Smalltalk classNamed: c) withAllSuperclasses.
- 		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]) ifTrue:
- 				[(Smalltalk bindingOf: l key) == 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]].
- 				self assert: bindingOop ~= oldHeap nilObject.
- 				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]!



More information about the Vm-dev mailing list