[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