[Vm-dev] VM Maker: VMMaker.oscog-eem.3090.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Oct 15 19:52:16 UTC 2021
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3090.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3090
Author: eem
Time: 15 October 2021, 12:50:03.820019 pm
UUID: 3e2b8343-01bb-4169-ba4c-aecf82b4dcfc
Ancestors: VMMaker.oscog-eem.3089
Spur Slang:
Reimplement finding of the transitive closure and length of accessor chains for computing primitive accessor depth. The algorithm now has some semblance of correctness and comprehensibility. Refactor so that accessorChainsForMethod:interpreterClass: => accessorDepthForMethod:interpreterClass:, and includes accessorDepthForChain:.
Add explicit accessor depths for primitiveStringAt[Put] (correcting the ommission to mirror primitiveAt[Put]) and primitiveExternalCall.
Minor cleanups to a few primitives (e.g. we now have cppIf:ifFalse:).
Don't crate a new CCodeGenerator just to compute the primitiveAccessorDepthTable.
=============== Diff against VMMaker.oscog-eem.3089 ===============
Item was removed:
- ----- 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: (self actualsForMethod: method)
- 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]);
- addAll: (accessors
- select: [:accessor| accessor anySatisfy: [:subnode| subnode = root]]
- thenCollect: [:accessor| OrderedCollection with: accessor])].
- lastPass := false.
- [extended := false.
- extendedChains := OrderedCollection new: chains size * 2.
- chains do:
- [:chain| | tip refs accessorRefs variableRefs |
- chain last isAssignment
- ifTrue:
- [tip := chain last variable.
- refs := accessors select: [:send| send args anySatisfy: [:arg| tip isSameAs: arg]]]
- ifFalse:
- [tip := chain last.
- refs := #()].
- 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 changed:
----- Method: CCodeGenerator>>accessorDepthForChain: (in category 'spur primitive compilation') -----
+ accessorDepthForChain: chain "SequenceableCollection"
+ "Answer the actual number of accessors in an access chain, counting actual references.
+
+ Consider this chain from primitiveSpurStringReplace:
+ repl := self stackValue: 1 . oop := objectMemory fetchPointer: srcDelta + i ofObject: repl . objectMemory storePointerUnchecked: i ofObject: array withValue: oop
+ The length of this chain is 2, because oop is derived from repl by the second statement, but is not part of the final access. There is another chain:
+ array := self stackValue: 4 . objectMemory storePointerUnchecked: i ofObject: array withValue: oop
+ which does make use of the final accessor. So in following chains we find and follow variables.
+
+ Nested accessors are also possible, e.g.
+ self fetchPointer: i ofObject: (self fetchPointer: j ofObject: (self fetchPointer: k ofObject: var))
+ So we must also consider the height of each accessor expression."
+
+ | accessorDepth chainVariable |
- accessorDepthForChain: chain "OrderedCollection"
- "Answer the actual number of accessors in the access chain, filtering out assignments of variables to variables."
- | accessorDepth |
accessorDepth := 0.
+ chainVariable := nil.
chain do:
+ [:node| | accessor |
+ accessor := node isAssignment
+ ifTrue: [node expression]
+ ifFalse: [self assert: node isSend. node].
+ accessorDepth:= accessorDepth + (self depthOfAccessor: accessor for: chainVariable).
+ node isAssignment ifTrue:
+ [chainVariable := node variable]].
- [:node|
- ((node isAssignment and: [node expression isVariable])
- or: [node isSend and: [SpurMemoryManager isSameLevelObjectAccessor: node selector]]) ifFalse:
- [accessorDepth := accessorDepth + 1]].
^accessorDepth!
Item was changed:
----- Method: CCodeGenerator>>accessorDepthForMethod: (in category 'spur primitive compilation') -----
+ accessorDepthForMethod: method "TMethod"
- 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 find and forwarders and, if any are found, retry the primitive.
+
- 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.
+ The information is cached since it needs to be computed *before* inlining."
- The information is cached since it needs to be computed *before* inlining"
^accessorDepthCache
at: method smalltalkSelector
ifAbsentPut:
[beganInlining
ifTrue:
[(method export
or: [vmClass notNil or: [vmClass primitiveTable includes: method smalltalkSelector]])
ifTrue: [-1]
ifFalse: [self error: 'it is too late to compute accessor depths!!']]
ifFalse:
[((method definingClass includesSelector: method smalltalkSelector) ifTrue:
[(method definingClass >> method smalltalkSelector) pragmaAt: #accessorDepth:])
+ ifNotNil: [:pragma| pragma arguments first]
ifNil:
["Deal with the
primitiveFoo
objectMemory hasSpurMemoryManagerAPI
ifTrue: [self primitiveFooSpur]
ifFalse: [self primitiveFooV3]
cliché"
+ method extractSpurPrimitiveSelector
+ ifNotNil:
+ [:actualSelector| | subMethod |
+ (subMethod := self methodNamed: actualSelector) ifNil:
+ [subMethod := self compileToTMethodSelector: actualSelector in: method definingClass].
+ self accessorDepthForMethod: subMethod]
+ ifNil: [self accessorDepthForMethod: method interpreterClass: (vmClass ifNil: [StackInterpreter])]]]]!
- method extractSpurPrimitiveSelector ifNotNil:
- [:actualSelector| | subMethod |
- (subMethod := self methodNamed: actualSelector) ifNil:
- [subMethod := self compileToTMethodSelector: actualSelector in: method definingClass].
- ^self accessorDepthForMethod: subMethod].
- ((self
- accessorChainsForMethod: method
- interpreterClass: (vmClass ifNil: [StackInterpreter]))
- inject: 0
- into: [:length :chain| length max: (self accessorDepthForChain: chain)]) - 1]
- ifNotNil: [:pragma| pragma arguments first]]]!
Item was added:
+ ----- Method: CCodeGenerator>>accessorDepthForMethod:interpreterClass: (in category 'spur primitive compilation') -----
+ accessorDepthForMethod: method interpreterClass: interpreterClass
+ "Answer the maximal length 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."
+
+ | chains |
+ chains := self accessorsAndAssignmentsForMethod: method
+ actuals: (self actualsForMethod: method)
+ depth: 0
+ interpreterClass: interpreterClass
+ into: [:roots :accessors :assignments|
+ self transitiveClosureOfAccessorChainRoots: roots accessors: accessors assignments: assignments].
+ "Now compute the maximal length and subtract 1. The depth for a stack access is 0.
+ The depth of an access to an object taken from the stack is 1, etc. And the depth for no access is -1."
+ ^(chains
+ inject: 0
+ into: [:maximumLength :chain| maximumLength max: (self accessorDepthForChain: chain)]) - 1!
Item was added:
+ ----- Method: CCodeGenerator>>depthOfAccessor:for: (in category 'spur primitive compilation') -----
+ depthOfAccessor: accessor for: chainVariableOrNil
+ "Compute the accessor depth for a send. This is potentially greater than one for a nested access
+ such as self fetchPointer: i ofObject: (self fetchPointer: j ofObject: (self fetchPointer: k ofObject: var)).
+ If chainVariableOrNil is not nil then an access is only meaningful if it is an access of chainVariableOrNil."
+
+ | keywords accessIndex objectAccessed |
+ accessor isSend ifFalse:
+ [^0].
+ (StackInterpreter isStackAccessor: accessor selector) ifTrue:
+ [^1].
+ keywords := accessor selector keywords.
+ accessIndex := keywords
+ indexOf: 'ofObject:'
+ ifAbsent:
+ [^(accessor args
+ inject: ((StackInterpreter isObjectAccessor: accessor selector)
+ ifTrue: [1]
+ ifFalse: [0])
+ into:
+ [:best :node|
+ node isSend
+ ifTrue: [best max: (self depthOfAccessor: node for: chainVariableOrNil)]
+ ifFalse: [best]])].
+ objectAccessed := accessor args at: accessIndex.
+ chainVariableOrNil ifNil:
+ [^1 + (self depthOfAccessor: objectAccessed for: chainVariableOrNil)].
+ objectAccessed isSend ifFalse:
+ [^(objectAccessed isSameAs: chainVariableOrNil)
+ ifTrue: [1]
+ ifFalse: [0]].
+ (objectAccessed anySatisfy: [:node| node isSameAs: chainVariableOrNil]) ifFalse:
+ [^0].
+ ^1 + (self depthOfAccessor: objectAccessed for: chainVariableOrNil)!
Item was added:
+ ----- Method: CCodeGenerator>>transitiveClosureOfAccessorChainRoots:accessors:assignments: (in category 'spur primitive compilation') -----
+ transitiveClosureOfAccessorChainRoots: roots accessors: accessors assignments: assignments
+ "Compute the transitive closure of accessor and assignment expressions from the roots.
+ Start from the stack accesses (the roots)."
+ | chains chainSets expressions extended extendedChains |
+ chains := OrderedCollection new.
+ roots do:
+ [:root|
+ chains
+ addAll: (assignments
+ select: [:assignment| assignment expression isSameAs: root]
+ thenCollect: [:assignment| {assignment}]);
+ addAll: (accessors
+ select: [:accessor| accessor anySatisfy: [:subnode| subnode isSameAs: root]]
+ thenCollect: [:accessor| {accessor}])].
+ chains isEmpty ifTrue:
+ [^roots collect: [:root| {root}]].
+ "chainSets are the visited sets for each chain root. For example, in primiitveSpurStringReplace
+ objectMemory storeByte: i ofObject: array withValue: (objectMemory fetchByte: srcDelta + i ofObject: repl)
+ is reachable both from
+ array := self stackValue: 4
+ and from
+ repl := self stackValue: 1.
+ If there is only a single visited set we will compute only one of these paths."
+ chainSets := Dictionary new.
+ chains do:
+ [:tuple| chainSets at: tuple first put: (Set with: tuple first)].
+ (expressions := Set new)
+ addAll: accessors;
+ addAll: assignments.
+ [extended := false.
+ extendedChains := OrderedCollection new: chains size * 2.
+ chains do:
+ [:chain| | visited |
+ visited := chainSets at: chain first.
+ chain last isAssignment
+ ifTrue: "extend with any and all new references to the variable at the end of the chain."
+ [| tip |
+ tip := chain last variable.
+ (expressions select: [:expr| (visited includes: expr) not and: [expr anySatisfy: [:node| tip isSameAs: node]]])
+ ifEmpty: [extendedChains addLast: chain]
+ ifNotEmpty:
+ [:refs|
+ extendedChains addAll: ((visited addAll: refs) collect: [:ref| chain, {ref}]).
+ extended := true]]
+ ifFalse:
+ [extendedChains addLast: chain]].
+ extended] whileTrue:
+ [chains := extendedChains].
+ ^extendedChains!
Item was changed:
----- Method: FilePlugin>>primitiveFileStdioHandles (in category 'file primitives') -----
primitiveFileStdioHandles
"Answer an Array of file handles for standard in, standard out and standard error,
with nil in entries that are unvailable, e.g. because the platform does not provide
standard error, etc. Fail if an error occurs determining the stdio handles,
if the security plugin denies access or if memory runs out."
- | fileRecords result validMask |
<export: true>
+ | fileRecords result validMask |
<var: 'fileRecords' declareC: 'SQFile fileRecords[3]'>
+ self cCode: '' inSmalltalk: [fileRecords := Array new: 3].
sHFAfn ~= 0 ifTrue:
[(self cCode: ' ((sqInt (*)(void))sHFAfn)()' inSmalltalk: [true]) ifFalse:
[^interpreterProxy primitiveFailFor: PrimErrUnsupported]].
- self cCode: '' inSmalltalk: [fileRecords := Array new: 3].
validMask := self sqFileStdioHandlesInto: fileRecords.
validMask < 0 ifTrue:
[^interpreterProxy primitiveFailForOSError: validMask].
result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
result = nil ifTrue:
[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy pushRemappableOop: result.
0 to: 2 do:
[:index|
(validMask bitAnd: (1 << index)) ~= 0 ifTrue:
[result := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize.
result = nil ifTrue:
[interpreterProxy popRemappableOop.
^interpreterProxy primitiveFailFor: PrimErrNoMemory].
interpreterProxy storePointer: index ofObject: interpreterProxy topRemappableOop withValue: result.
self
cCode:
[self memcpy: (interpreterProxy firstIndexableField: result)
_: (self addressOf: (fileRecords at: index))
_: self fileRecordSize]
inSmalltalk:
[(interpreterProxy firstIndexableField: result)
unitSize: interpreterProxy wordSize;
at: 0 put: (fileRecords at: index + 1)]]].
"In the non-Spur threaded VM ensure the handles are old, so that sqFileReadIntoAt is unaffected
by incremental GCs. See platforms/Cross/plugins/FilePlugin/sqFilePluginBasicPrims.c. The Spur
VM uses pinning, so it doesn't need the GC."
self cppIf: COGMTVM
ifTrue: [self cppIf: SPURVM
- ifTrue: []
ifFalse: [interpreterProxy fullGC]].
result := interpreterProxy popRemappableOop.
interpreterProxy methodReturnValue: result!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFormPrint (in category 'I/O primitives') -----
primitiveFormPrint
"On platforms that support it, this primitive prints the receiver, assumed to be a Form, to the default printer."
| landscapeFlag vScale hScale rcvr bitsArray w h
+ depth pixelsPerWord wordsPerLine bitsArraySize |
- depth pixelsPerWord wordsPerLine bitsArraySize ok |
-
- <var: #vScale type: #double>
- <var: #hScale type: #double>
landscapeFlag := self booleanValueOf: self stackTop.
vScale := objectMemory floatValueOf: (self stackValue: 1).
hScale := objectMemory floatValueOf: (self stackValue: 2).
rcvr := self stackValue: 3.
((objectMemory isPointers: rcvr)
and: [(objectMemory lengthOf: rcvr) >= 4]) ifFalse:
[self success: false].
self successful ifTrue:
[bitsArray := objectMemory fetchPointer: 0 ofObject: rcvr.
w := self fetchInteger: 1 ofObject: rcvr.
h := self fetchInteger: 2 ofObject: rcvr.
depth := self fetchInteger: 3 ofObject: rcvr.
(w > 0 and: [h > 0]) ifFalse: [self success: false].
pixelsPerWord := 32 // depth.
wordsPerLine := (w + (pixelsPerWord - 1)) // pixelsPerWord.
(objectMemory isWordsOrBytes: bitsArray)
ifTrue:
[bitsArraySize := objectMemory numBytesOf: bitsArray.
+ self success: bitsArraySize = (wordsPerLine * h * 4)]
- self success: (bitsArraySize = (wordsPerLine * h * 4))]
ifFalse: [self success: false]].
self successful ifTrue:
+ [self success: (self ioFormPrint: bitsArray + BaseHeaderSize _: w _: h _: depth _: hScale _: vScale _: landscapeFlag).
+ self successful ifTrue:
+ [self methodReturnReceiver]]!
- [ok := self cCode: 'ioFormPrint(bitsArray + BaseHeaderSize, w, h, depth, hScale, vScale, landscapeFlag)'.
- self success: ok].
- self successful ifTrue:
- [self pop: 3] "pop hScale, vScale, and landscapeFlag; leave rcvr on stack"!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveIntegerAt (in category 'indexing primitives') -----
primitiveIntegerAt
+ objectMemory hasSpurMemoryManagerAPI
- SPURVM
ifTrue: [self primitiveSpurIntegerAt] "Answer the signed integer element of a pure bits receiver"
ifFalse: [self primitiveV3IntegerAt] "Answer the 32 bit signed integer contents of a words receiver"!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveIntegerAtPut (in category 'indexing primitives') -----
primitiveIntegerAtPut
+ objectMemory hasSpurMemoryManagerAPI
- SPURVM
ifTrue: [self primitiveSpurIntegerAtPut] "Assign an indexable variable of a pure bits receiver with a signed integer."
ifFalse: [self primitiveV3IntegerAtPut] "Assign an indexable variable of a words receiver with a 32 bit signed integer."!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveStringAt (in category 'indexing primitives') -----
primitiveStringAt
+ <accessorDepth: 0>
+ self commonAt: true!
-
- self commonAt: true.!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveStringAtPut (in category 'indexing primitives') -----
primitiveStringAtPut
+ <accessorDepth: 0>
+ self commonAtPut: true!
-
- self commonAtPut: true.!
Item was removed:
- ----- Method: SpurMemoryManager class>>isSameLevelObjectAccessor: (in category 'translation') -----
- isSameLevelObjectAccessor: selector
- "For accessor depth calculation, answer if selector doesn't traverse into an object, merely deriving a pointer from it."
- ^#(arrayValueOf: firstFixedField: firstIndexableField:) includes: selector!
Item was changed:
----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
| vmClass |
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
aCCodeGenerator
addHeaderFile: '<stdio.h> /* for printf */';
addHeaderFile: '<stdlib.h> /* for e.g. alloca */';
addHeaderFile: '<setjmp.h>';
addHeaderFile: '<wchar.h> /* for wint_t */';
addHeaderFile: '"vmCallback.h"';
addHeaderFile: '"sqMemoryFence.h"';
addHeaderFile: '"sqImageFileAccess.h"';
addHeaderFile: '"sqSetjmpShim.h"';
addHeaderFile: '"dispdbg.h"'.
LowcodeVM ifTrue:
[aCCodeGenerator addHeaderFile: '"sqLowcodeFFI.h"'].
vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
aCCodeGenerator
var: #interpreterProxy type: #'struct VirtualMachine*'.
aCCodeGenerator
declareVar: #sendTrace type: 'volatile int';
declareVar: #byteCount type: #usqLong. "see dispdbg.h"
"These need to be pointers or unsigned."
self declareC: #(instructionPointer method newMethod)
as: #usqInt
in: aCCodeGenerator.
"These are all pointers; char * because Slang has no support for C pointer arithmetic."
self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit breakSelector)
as: #'char *'
in: aCCodeGenerator.
aCCodeGenerator
var: #breakSelectorLength
declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
self declareC: #(stackPage overflowedPage)
as: #'StackPage *'
in: aCCodeGenerator.
aCCodeGenerator
var: #transcript type: #'FILE *'.
aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code."
"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
is not defined, for the benefit of the interpreter on slow machines."
aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
MULTIPLEBYTECODESETS == false ifTrue:
[aCCodeGenerator
removeVariable: 'bytecodeSetSelector'].
BytecodeSetHasExtensions == false ifTrue:
[aCCodeGenerator
removeVariable: 'extA';
removeVariable: 'extB'].
aCCodeGenerator
var: #methodCache
declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
NewspeakVM
ifTrue:
[aCCodeGenerator
var: #nsMethodCache
declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]']
ifFalse:
[aCCodeGenerator
removeVariable: #nsMethodCache;
removeVariable: 'localAbsentReceiver';
removeVariable: 'localAbsentReceiverOrZero'].
AtCacheTotalSize isInteger ifTrue:
[aCCodeGenerator
var: #atCache
declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
aCCodeGenerator
var: #primitiveTable
declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
vmClass primitiveTable do:
[:symbolOrNot|
(symbolOrNot isSymbol
and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
[:tMethod| tMethod returnType: #void]]].
vmClass objectMemoryClass hasSpurMemoryManagerAPI
ifTrue:
[aCCodeGenerator
var: #primitiveAccessorDepthTable
type: 'signed char'
sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
+ array: (vmClass primitiveAccessorDepthTableUsing: aCCodeGenerator)]
- array: vmClass primitiveAccessorDepthTable]
ifFalse:
[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
aCCodeGenerator
var: #displayBits type: #'void *';
var: #primitiveCalloutPointer declareC: 'void *primitiveCalloutPointer = (void *)-1'.
self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator.
aCCodeGenerator
var: #primitiveFunctionPointer
declareC: 'void (*primitiveFunctionPointer)()';
var: #externalPrimitiveTable
declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)';
var: #interruptCheckChain
declareC: 'void (*interruptCheckChain)(void) = 0';
var: #showSurfaceFn
declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)';
var: #jmpBuf
declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
var: #suspendedCallbacks
declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
var: #suspendedMethods
declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
statProcessSwitch statIOProcessEvents statForceInterruptCheck
statCheckForEvents statStackOverflow statStackPageDivorce
statIdleUsecs)
in: aCCodeGenerator.
aCCodeGenerator var: #nextProfileTick type: #sqLong.
aCCodeGenerator var: #reenterInterpreter type: 'jmp_buf'.
LowcodeVM
ifTrue:
[aCCodeGenerator
var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'.
self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer)
as: #'char *'
in: aCCodeGenerator]
ifFalse:
[#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do:
[:var| aCCodeGenerator removeVariable: var]]!
Item was changed:
----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreter class>>primitiveAccessorDepthTable (in category 'constants') -----
primitiveAccessorDepthTable
| cg |
cg := CCodeGenerator new.
cg vmClass: StackInterpreter.
+ ^self primitiveAccessorDepthTableUsing: cg!
- ^self primitiveTable collect:
- [:thing| | implementingClass method |
- (thing isInteger "quick prims, 0 for fast primitve fail"
- or: [thing == #primitiveFail
- or: [(implementingClass := self primitivesClass whichClassIncludesSelector: thing) isNil]])
- ifTrue: [-1]
- ifFalse:
- [method := cg compileToTMethodSelector: thing in: implementingClass.
- cg accessorDepthForMethod: method]]!
Item was added:
+ ----- Method: StackInterpreter class>>primitiveAccessorDepthTableUsing: (in category 'constants') -----
+ primitiveAccessorDepthTableUsing: aCCodeGenerator
+ ^self primitiveTable collect:
+ [:thing| | implementingClass |
+ (thing isInteger "quick prims, 0 for fast primitve fail"
+ or: [thing == #primitiveFail
+ or: [(implementingClass := self primitivesClass whichClassIncludesSelector: thing) isNil]])
+ ifTrue: [-1]
+ ifFalse:
+ [aCCodeGenerator accessorDepthForMethod:
+ ((aCCodeGenerator methodNamed: thing) ifNil:
+ [aCCodeGenerator compileToTMethodSelector: thing in: implementingClass])]]!
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 metadata (accessorDepth and flags; Integer))
* 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:.
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."
+ <accessorDepth: 0> "because the primitive accesses newMethod's first literal, which is checked for explicitly in checkForAndFollowForwardedPrimitiveState"
| lit addr index |
<var: #addr declareC: 'void (*addr)()'>
"Check for it being a method for primitiveDoPrimitiveWithArgs.
Fetch the first literal of the method; check its an Array of length 4.
Look at the function index in case it has been loaded before"
((objectMemory isOopCompiledMethod: newMethod)
and: [(objectMemory literalCountOf: newMethod) > 0
and: [lit := self literal: 0 ofMethod: newMethod.
(objectMemory isArray: lit)
and: [(objectMemory numSlotsOf: lit) = 4
and: [index := objectMemory fetchPointer: ExternalCallLiteralTargetFunctionIndex 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. "On Spur, sets primitiveFunctionPointer"
self maybeRetryPrimitiveOnFailure.
^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/metadata and external primitive index"
objectMemory storePointerUnchecked: ExternalCallLiteralFlagsIndex ofObject: lit withValue: ConstZero.
objectMemory storePointerUnchecked: ExternalCallLiteralTargetFunctionIndex ofObject: lit withValue: ConstZero.
"The function has not been loaded yet. Attempt to link it, cache it, and call it."
addr := self linkExternalCall: lit errInto: (self addressOf: primFailCode put: [:v| primFailCode := v]).
addr = 0 ifTrue:
[self assert: (objectMemory fetchPointer: ExternalCallLiteralFlagsIndex ofObject: lit) = ConstZero.
^self primitiveFailFor: (primFailCode = 0 ifTrue: [PrimErrNotFound] ifFalse: [primFailCode])].
self callExternalPrimitive: addr.
self maybeRetryPrimitiveOnFailure !
Item was removed:
- ----- 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>>accessorDepthForMethod:interpreterClass: (in category 'spur primitive compilation') -----
+ accessorDepthForMethod: method "TMethod" interpreterClass: interpreterClass
+ inProgressSelectors := Set new.
+ ^[super accessorDepthForMethod: method interpreterClass: interpreterClass] ensure:
+ [inProgressSelectors := nil]!
More information about the Vm-dev
mailing list