[Vm-dev] VM Maker: VMMaker.oscog-eem.571.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Jan 4 02:21:07 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.571.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.571
Author: eem
Time: 3 January 2014, 6:17:54.152 pm
UUID: be9dbbdd-7f8c-48f6-a820-a6b42ee3749b
Ancestors: VMMaker.oscog-eem.570
Implement "accessor depth" of internal plugin primitives for Spur.
The accessor depth is how much state to traverse to check for failure
due to lazy forwarders. Scheme analyses the parse trees of primitive
methods and computes depth automatically.
Hide the per-primitive information after the primitive name entry in
the exports table, hence maintaining compatibility between "classic"
and Spur, and allowing generated plugin files to continue to be
shared.
Add some simple equivalence comparison for TParseNodes (which
are compared by identity for #= & hash).
Don't merge with tpr.571 or dtl.572 yet. These mistakenly include
the experimental changes in eem.566.
=============== Diff against VMMaker.oscog-eem.570 ===============
Item was added:
+ ----- Method: CCodeGenerator>>accessorChainsForMethod:interpreterClass: (in category 'spur primitive compilation') -----
+ accessorChainsForMethod: method interpreterClass: interpreterClass
+ "Answer a set of access paths from arguments through objects, in the method, assuming
+ it is a primitive. This is in support of Spur's lazy become. A primitive may fail because it
+ may encounter a forwarder. The primitive failure code needs to know to what depth it
+ must follow arguments to follow forwarders and, if any are found and followed, retry the
+ primitive. This method determines that depth. It starts by collecting references to the
+ stack and then follows these through assignments to variables and use of accessor
+ methods such as fetchPointer:ofObject:. For example
+ | obj field |
+ obj := self stackTop.
+ field := objectMemory fetchPointer: 1 ofObject: obj.
+ self storePointer: 1 ofObject: field withValue: (self stackValue: 1)
+ has depth 2, since field is accessed, and field is an element of obj."
+
+ | accessors assignments roots chains extendedChains extended lastPass |
+ self accessorsAndAssignmentsForMethod: method
+ actuals: {}
+ depth: 0
+ interpreterClass: interpreterClass
+ into: [:theRoots :theAccessors :theAssignments|
+ roots := theRoots.
+ accessors := theAccessors.
+ assignments := theAssignments].
+ "Compute the transitive closure of assignments of accessor sends or variables to variables from the roots.
+ Start from the stack accesses (the roots).
+ On the last pass look only for accessors of the targets of the tip assignments."
+ chains := OrderedCollection new.
+ roots do: [:root| chains addAll: (assignments
+ select: [:assignment| assignment expression = root]
+ thenCollect: [:assignment| OrderedCollection with: assignment])].
+ lastPass := false.
+ [extended := false.
+ extendedChains := OrderedCollection new: chains size * 2.
+ chains do:
+ [:chain| | tip refs accessorRefs variableRefs |
+ tip := chain last variable.
+ refs := accessors select: [:send| send args anySatisfy: [:arg| tip isSameAs: arg]].
+ lastPass ifFalse:
+ [accessorRefs := refs collect: [:send|
+ assignments
+ detect: [:assignment|
+ assignment expression = send
+ and: [(chain includes: assignment) not]]
+ ifNone: []]
+ thenSelect: [:assignmentOrNil| assignmentOrNil notNil].
+ variableRefs := assignments select:
+ [:assignment|
+ (tip isSameAs: assignment expression)
+ and: [(tip isSameAs: assignment variable) not
+ and: [(chain includes: assignment) not]]].
+ refs := (Set withAll: accessorRefs) addAll: variableRefs; yourself].
+ refs isEmpty
+ ifTrue:
+ [extendedChains add: chain]
+ ifFalse:
+ [lastPass ifFalse: [extended := true].
+ self assert: (refs noneSatisfy: [:assignment| chain includes: assignment]).
+ extendedChains addAll: (refs collect: [:assignment| chain, {assignment}])]].
+ extended or: [lastPass not]] whileTrue:
+ [chains := extendedChains.
+ extended ifFalse: [lastPass := true]].
+ ^chains!
Item was added:
+ ----- Method: CCodeGenerator>>accessorDepthDeterminationFollowsSelfSends (in category 'spur primitive compilation') -----
+ accessorDepthDeterminationFollowsSelfSends
+ ^false!
Item was added:
+ ----- Method: CCodeGenerator>>accessorDepthForChain: (in category 'spur primitive compilation') -----
+ accessorDepthForChain: chain "OrderedCollection"
+ "Answer the actual number of accessors in the access chain, filtering out assignments of variables to variables."
+ | accessorDepth |
+ accessorDepth := 0.
+ chain do:
+ [:node|
+ (node isAssignment and: [node expression isVariable]) ifFalse:
+ [accessorDepth := accessorDepth + 1]].
+ ^accessorDepth!
Item was added:
+ ----- Method: CCodeGenerator>>accessorDepthForMethod: (in category 'spur primitive compilation') -----
+ accessorDepthForMethod: method
+ "Compute the depth the method traverses object structure, assuming it is a primitive.
+ This is in support of Spur's lazy become. A primitive may fail because it may encounter
+ a forwarder. The primitive failure code needs to know to what depth it must follow
+ arguments to follow forwarders and, if any are found and followed, retry the primitive.
+ This method determines that depth. It starts by collecting references to the stack and
+ then follows these through assignments to variables and use of accessor methods
+ such as fetchPointer:ofObject:. For example
+ | obj field |
+ obj := self stackTop.
+ field := objectMemory fetchPointer: 1 ofObject: obj.
+ self storePointer: 1 ofObject: field withValue: (self stackValue: 1)
+ has depth 2, since field is accessed, and field is an element of obj."
+
+ ^((self
+ accessorChainsForMethod: method
+ interpreterClass: (vmClass ifNil: [StackInterpreter]))
+ inject: 0
+ into: [:length :chain| length max: (self accessorDepthForChain: chain)]) - 1!
Item was added:
+ ----- Method: CCodeGenerator>>accessorDepthForSelector: (in category 'spur primitive compilation') -----
+ accessorDepthForSelector: selector
+ ^(selector = #initialiseModule
+ or: [InterpreterPlugin includesSelector: selector]) ifFalse:
+ [(self methodNamed: selector) ifNotNil:
+ [:m| self accessorDepthForMethod: m]]!
Item was added:
+ ----- Method: CCodeGenerator>>accessorsAndAssignmentsForMethod:actuals:depth:interpreterClass:into: (in category 'spur primitive compilation') -----
+ accessorsAndAssignmentsForMethod: method actuals: actualParameters depth: depth interpreterClass: interpreterClass into: aTrinaryBlock
+ "Evaluate aTrinaryBlock with the root accessor sends, accessor sends and assignments in the method."
+ | accessors assignments roots |
+ accessors := Set new.
+ assignments := Set new.
+ roots := Set new.
+ actualParameters with: method args do:
+ [:actual :argName|
+ (actual isVariable or: [actual isSend]) ifTrue:
+ [assignments add: (TAssignmentNode new
+ setVariable: (TVariableNode new setName: argName)
+ expression: actual)]].
+ method parseTree nodesDo:
+ [:node|
+ node isSend ifTrue:
+ [(interpreterClass isStackAccessor: node selector) ifTrue:
+ [roots add: node].
+ (interpreterClass isObjectAccessor: node selector) ifTrue:
+ [accessors add: node].
+ (self accessorDepthDeterminationFollowsSelfSends
+ and: [node receiver isVariable
+ and: [node receiver name = 'self'
+ and: [roots isEmpty
+ or: [node args anySatisfy:
+ [:arg|
+ (roots includes: arg)
+ or: [(accessors includes: arg)
+ or: [assignments anySatisfy: [:assignment| assignment variable isSameAs: arg]]]]]]]]) ifTrue:
+ [self accessorsAndAssignmentsForSubMethodNamed: node selector
+ actuals: node args
+ depth: depth + 1
+ interpreterClass: interpreterClass
+ into: [:subRoots :subAccessors :subAssignments|
+ (subRoots isEmpty and: [subAccessors isEmpty and: [subAssignments isEmpty]]) ifFalse:
+ [roots addAll: subRoots.
+ accessors add: node.
+ accessors addAll: subAccessors.
+ assignments addAll: subAssignments]]]].
+ (node isAssignment
+ and: [(roots includes: node expression)
+ or: [(accessors includes: node expression)
+ or: [node expression isVariable and: [node expression name ~= 'nil']]]]) ifTrue:
+ [assignments add: node]].
+ ^aTrinaryBlock
+ value: roots
+ value: accessors
+ value: assignments!
Item was added:
+ ----- Method: CCodeGenerator>>emitExportsNamed:pluginName:on: (in category 'C code generator') -----
+ emitExportsNamed: exportsNamePrefix pluginName: pluginName on: aStream
+ "Store all the exported primitives in the form used by the internal named prim system."
+ | nilVMClass |
+ (nilVMClass := vmClass isNil) ifTrue:
+ [vmClass := StackInterpreter].
+ aStream cr; cr; nextPutAll: 'void* '; nextPutAll: exportsNamePrefix; nextPutAll: '_exports[][3] = {'.
+ (self sortStrings: self exportedPrimitiveNames) do:
+ [:primName|
+ aStream cr;
+ nextPutAll:' {"';
+ nextPutAll: pluginName;
+ nextPutAll: '", "';
+ nextPutAll: primName.
+ (self accessorDepthForSelector: primName asSymbol) ifNotNil:
+ [:depth| "store the accessor depth in a hidden byte immediately after the primName"
+ self assert: depth < 128.
+ aStream
+ nextPutAll: '\000\';
+ nextPutAll: ((depth bitAnd: 255) printStringBase: 8 nDigits: 3)].
+ aStream
+ nextPutAll:'", (void*)';
+ nextPutAll: primName;
+ nextPutAll:'},'].
+ aStream cr; tab; nextPutAll:'{NULL, NULL, NULL}'; cr; nextPutAll: '};'; cr.
+ nilVMClass ifTrue:
+ [vmClass := nil]!
Item was changed:
----- Method: CCodeGenerator>>emitExportsOn: (in category 'C code generator') -----
emitExportsOn: aStream
+ "Store all the exported primitives in the form used by the internal named prim system."
+ (vmClass isNil or: [vmClass isInterpreterClass]) ifTrue:
+ [self emitExportsNamed: 'vm' pluginName: '' on: aStream]!
- "Store all the exported primitives in a form to be used by the internal named prim system"
- (vmClass isNil or: [vmClass isInterpreterClass]) ifFalse:
- [^self].
- aStream nextPutAll:'
-
- void* vm_exports[][3] = {'.
- (self sortStrings: self exportedPrimitiveNames) do:[:primName|
- aStream cr;
- nextPutAll:' {"", "';
- nextPutAll: primName;
- nextPutAll:'", (void*)';
- nextPutAll: primName;
- nextPutAll:'},'.
- ].
- aStream nextPutAll:'
- {NULL, NULL, NULL}
- };
- '!
Item was added:
+ ----- Method: StackInterpreter class>>isObjectAccessor: (in category 'spur compilation support') -----
+ isObjectAccessor: selector
+ "Answer if selector is one of fetchPointer:ofObject: storePointer:ofObject:withValue:
+ et al."
+ ^(InterpreterProxy whichCategoryIncludesSelector: selector) = #'object access'
+ or: [(SpurMemoryManager whichCategoryIncludesSelector: selector) = #'object access']
+
+ "This for checking. The above two protocols are somewhat disjoint."
+ "(InterpreterProxy allMethodsInCategory: #'object access') copyWithoutAll: (SpurMemoryManager allMethodsInCategory: #'object access')"
+ "(SpurMemoryManager allMethodsInCategory: #'object access') copyWithoutAll: (InterpreterProxy allMethodsInCategory: #'object access')"!
Item was added:
+ ----- Method: StackInterpreter class>>isStackAccessor: (in category 'spur compilation support') -----
+ isStackAccessor: selector
+ ^#( stackTop stackValue: stackTopPut: stackValue:put:
+ stackFloatValue: stackIntegerValue: stackObjectValue:) includes: selector!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
primitiveExternalCall
"Call an external primitive. External primitive methods first literals are an array of
+ * The module name (String | Symbol)
+ * The function name (String | Symbol)
+ * The session ID (SmallInteger) [OBSOLETE] (or in Spur, the accessorDepth)
- * The module name (String | Symbol)
- * The function name (String | Symbol)
- * The session ID (SmallInteger) [OBSOLETE]
* The function index (Integer) in the externalPrimitiveTable
For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
in the method cache is rewritten, either to the function itself, or to zero if the external
function is not found. This allows for fast responses as long as the method stays in
the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
+ addNewMethodToCache:.
- addNewMethodToCache:.
Now that the VM flushes function addresses from its tables, the session ID is obsolete,
but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
method has been looked up and not been found, the function address is stored as -1
(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
lookup), and the primitive fails with PrimErrNotFound."
+ | lit addr moduleName functionName moduleLength functionLength accessorDepth index |
- | lit addr moduleName functionName moduleLength functionLength index |
<var: #addr declareC: 'void (*addr)()'>
"Fetch the first literal of the method"
(self literalCountOf: newMethod) > 0 ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
lit := self literal: 0 ofMethod: newMethod.
"Check if it's an array of length 4"
((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]) ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
"Look at the function index in case it has been loaded before"
index := objectMemory fetchPointer: 3 ofObject: lit.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
index := objectMemory integerValueOf: index.
"Check if we have already looked up the function and failed."
index < 0 ifTrue:
["Function address was not found in this session,
Void the primitive function."
self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
^self primitiveFailFor: PrimErrNotFound].
"Try to call the function directly"
(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
[addr := externalPrimitiveTable at: index - 1.
addr ~= 0 ifTrue:
[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
self callExternalPrimitive: addr.
^nil].
"if we get here, then an index to the external prim was
kept on the ST side although the underlying prim
table was already flushed"
^self primitiveFailFor: PrimErrNamedInternal].
"Clean up session id and external primitive index"
objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: lit.
moduleName = objectMemory nilObject
ifTrue: [moduleLength := 0]
ifFalse: [(objectMemory isBytes: moduleName) ifFalse:
[self primitiveFailFor: PrimErrBadMethod].
moduleLength := objectMemory lengthOf: moduleName].
functionName := objectMemory fetchPointer: 1 ofObject: lit.
(objectMemory isBytes: functionName) ifFalse:
[self primitiveFailFor: PrimErrBadMethod].
functionLength := objectMemory lengthOf: functionName.
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
+ OfLength: functionLength
+ FromModule: moduleName + BaseHeaderSize
+ OfLength: moduleLength
+ AccessorDepthInto: (self addressOf: accessorDepth
+ put: [:val| accessorDepth := val]).
+ addr = 0
+ ifTrue: [index := -1]
+ ifFalse: "add the function to the external primitive table"
+ [index := self addToExternalPrimitiveTable: addr.
+ objectMemory
+ storePointerUnchecked: 2
+ ofObject: lit
+ withValue: (objectMemory integerObjectOf: accessorDepth)]]
+ ifFalse:
+ [addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
+ OfLength: functionLength
+ FromModule: moduleName + BaseHeaderSize
+ OfLength: moduleLength.
+ addr = 0
+ ifTrue: [index := -1]
+ ifFalse: "add the function to the external primitive table"
+ [index := self addToExternalPrimitiveTable: addr]].
- addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
- OfLength: functionLength
- FromModule: moduleName + BaseHeaderSize
- OfLength: moduleLength.
- addr = 0
- ifTrue: [index := -1]
- ifFalse: ["add the function to the external primitive table"
- index := self addToExternalPrimitiveTable: addr].
"Store the index (or -1 if failure) back in the literal"
objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
"If the function has been successfully loaded cache and call it"
index >= 0
ifTrue:
[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: [addr] inSmalltalk: [1000 + index]).
+ self callExternalPrimitive: addr]
+ ifFalse: "Otherwise void the primitive function and fail"
+ [self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
+ self assert: (objectMemory fetchPointer: 2 ofObject: lit) = ConstZero.
+ self primitiveFailFor: PrimErrNotFound]!
- self callExternalPrimitive: addr]
- ifFalse: ["Otherwise void the primitive function and fail"
- self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
- ^self primitiveFailFor: PrimErrNotFound]!
Item was added:
+ ----- Method: TConstantNode>>isSameAs: (in category 'comparing') -----
+ isSameAs: aTParseNode
+ ^aTParseNode isConstant
+ and: [value class == aTParseNode value class
+ and: [value = aTParseNode value]]!
Item was added:
+ ----- Method: TDefineNode>>isSameAs: (in category 'comparing') -----
+ isSameAs: aTParseNode
+ ^self class == aTParseNode class
+ and: [value class == aTParseNode value class
+ and: [value = aTParseNode value
+ and: [name = aTParseNode nameOrValue]]]!
Item was added:
+ ----- Method: TParseNode>>isSameAs: (in category 'comparing') -----
+ isSameAs: aTParseNode
+ ^self subclassResponsibility!
Item was added:
+ ----- Method: TSendNode>>isSameAs: (in category 'comparing') -----
+ isSameAs: aTParseNode
+ (aTParseNode isSend
+ and: [selector == aTParseNode selector]) ifFalse:
+ [^false].
+ arguments with: aTParseNode args do:
+ [:a :b|
+ (a isSameAs: b) ifFalse:
+ [^false]].
+ ^true!
Item was added:
+ ----- Method: TVariableNode>>isSameAs: (in category 'comparing') -----
+ isSameAs: aTParseNode
+ ^aTParseNode isVariable
+ and: [name = aTParseNode name]!
Item was changed:
CCodeGenerator subclass: #VMPluginCodeGenerator
+ instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed inProgressSelectors'
- instanceVariableNames: 'pluginClass pluginName pluginFunctionsUsed'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-Translation to C'!
!VMPluginCodeGenerator commentStamp: '<historical>' prior: 0!
I generate code that can be loaded dynamically from external libraries (e.g., DSOs on Unix or DLLs on Windows)!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>accessorChainsForMethod:interpreterClass: (in category 'spur primitive compilation') -----
+ accessorChainsForMethod: method interpreterClass: interpreterClass
+ inProgressSelectors := Set new.
+ ^[super accessorChainsForMethod: method interpreterClass: interpreterClass] ensure:
+ [inProgressSelectors := nil]!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>accessorDepthDeterminationFollowsSelfSends (in category 'spur primitive compilation') -----
+ accessorDepthDeterminationFollowsSelfSends
+ ^true!
Item was added:
+ ----- Method: VMPluginCodeGenerator>>accessorsAndAssignmentsForSubMethodNamed:actuals:depth:interpreterClass:into: (in category 'spur primitive compilation') -----
+ accessorsAndAssignmentsForSubMethodNamed: selector actuals: actualParameters depth: depth interpreterClass: interpreterClass into: aTrinaryBlock
+ "Evaluate aTrinaryBlock with the root accessor sends, accessor sends and assignments in the sub-method named selector."
+
+ | method map |
+ (inProgressSelectors includes: selector) ifTrue:
+ [^nil].
+ inProgressSelectors add: selector.
+ method := self methodNamed: selector.
+ "this is unsatisfactory. a pluggable scheme that asks the relevant plugin the right question would
+ be better but for now the only cross-plugin load is for loadBitBltFrom:warping: and variants."
+ (#(loadBitBltFrom: loadWarpBltFrom: loadBitBltFrom:warping:) includes: selector) ifTrue:
+ [(method isNil
+ or: [method definingClass ~~ BitBltSimulation]) ifTrue:
+ [method := (BitBltSimulation >> selector) methodNode asTranslationMethodOfClass: TMethod]].
+ method ifNil:
+ [^nil].
+ map := Dictionary new.
+ method args do: [:var| map at: var put: depth asString, var].
+ method locals do: [:var| map at: var put: depth asString, var].
+ ^self accessorsAndAssignmentsForMethod: (method copy renameVariablesUsing: map)
+ actuals: actualParameters
+ depth: depth + 1
+ interpreterClass: interpreterClass
+ into: aTrinaryBlock!
Item was changed:
----- Method: VMPluginCodeGenerator>>emitExportsOn: (in category 'C code generator') -----
emitExportsOn: aStream
+ "Store all the exported primitives in the form used by the internal named prim system."
+ aStream cr; cr; nextPutAll:'#ifdef SQUEAK_BUILTIN_PLUGIN'.
+ self emitExportsNamed: pluginName pluginName: pluginName on: aStream.
+ aStream cr; nextPutAll: '#endif /* ifdef SQ_BUILTIN_PLUGIN */'; cr!
- "Store all the exported primitives in a form to be used by internal plugins"
- | prefix |
- aStream nextPutAll:'
-
- #ifdef SQUEAK_BUILTIN_PLUGIN
-
- void* ', pluginName,'_exports[][3] = {'.
- prefix := '"', pluginName,'"'.
- (self sortStrings: self exportedPrimitiveNames) do:[:primName|
- aStream cr;
- nextPutAll:' {';
- nextPutAll: prefix;
- nextPutAll:', "';
- nextPutAll: primName;
- nextPutAll:'", (void*)';
- nextPutAll: primName;
- nextPutAll:'},'.
- ].
- aStream nextPutAll:'
- {NULL, NULL, NULL}
- };
-
- #endif /* ifdef SQ_BUILTIN_PLUGIN */
- '!
More information about the Vm-dev
mailing list