[Vm-dev] VM Maker: VMMaker.oscog.seperateMarking-eem.3317.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Mar 13 19:22:27 UTC 2023
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-eem.3317.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-eem.3317
Author: eem
Time: 13 March 2023, 12:22:05.816988 pm
UUID: 1f59eb12-f477-4835-86b2-6db5a406707a
Ancestors: VMMaker.oscog.seperateMarking-eem.3316
Merge
VMMaker.oscog-eem.3304
VMMaker.oscog-eem.3305
VMMaker.oscog-eem.3306
VMMaker.oscog-eem.3307
VMMaker.oscog-eem.3308
VMMaker.oscog-eem.3309
VMMaker.oscog-eem.3310
=============== Diff against VMMaker.oscog.seperateMarking-eem.3316 ===============
Item was changed:
InterpreterPlugin subclass: #CameraPlugin
instanceVariableNames: ''
+ classVariableNames: 'MirrorImage'
- classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-Plugins'!
Item was added:
+ ----- Method: CameraPlugin class>>initialize (in category 'class initialization') -----
+ initialize
+ "The first two parameter names are as written, but the plugin doesn't need them so they're left undefined."
+ "FrameCount := 1."
+ "FrameByteSize := 2."
+ MirrorImage := 3!
Item was added:
+ ----- Method: CameraPlugin>>primGetLatestBufferIndex (in category 'primitives') -----
+ primGetLatestBufferIndex
+ "If double-buffering is in effect (set via primSetCameraBuffers) answer
+ which buffer contains the freshest data, either A (1) or B (2). If no buffer
+ has been filled yet, answer nil. Otherwise fail with an appropriate error code."
+
+ <export: true>
+ | cameraNum |
+ cameraNum := interpreterProxy stackValue: 0.
+ (interpreterProxy isIntegerObject: cameraNum) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+
+ (self CameraGetLatestBufferIndex: (interpreterProxy integerValueOf: cameraNum))
+ ifNil: [interpreterProxy methodReturnValue: interpreterProxy nilObject]
+ ifNotNil:
+ [:result|
+ result < 0
+ ifTrue: [interpreterProxy primitiveFailFor: result negated]
+ ifFalse: [interpreterProxy methodReturnInteger: result]]!
Item was changed:
----- Method: CameraPlugin>>primGetParam (in category 'primitives') -----
primGetParam
+ "Answer the requested parameter value of the given camera.
+ See platforms/Cross/plugins/CameraPlugin/CameraPlugin.h for the list of parameter names."
- "Answer the given integer parameter of the given camera."
- | cameraNum paramNum |
<export: true>
+ | cameraNum paramNum result |
cameraNum := interpreterProxy stackIntegerValue: 1.
paramNum := interpreterProxy stackIntegerValue: 0.
+ interpreterProxy failed
+ ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrBadArgument]
+ ifFalse:
+ [result := self Camera: cameraNum GetParam: paramNum.
+ result < 0
+ ifTrue:
+ [interpreterProxy primitiveFailFor: result negated]
+ ifFalse:
+ [paramNum = MirrorImage
+ ifTrue: [interpreterProxy methodReturnBool: result]
+ ifFalse: [interpreterProxy methodReturnInteger: result]]]!
- interpreterProxy failed ifFalse:
- [interpreterProxy methodReturnInteger: (self Camera: cameraNum GetParam: paramNum)]!
Item was added:
+ ----- Method: CameraPlugin>>primSetParam (in category 'primitives') -----
+ primSetParam
+ "Set the requested parameter value of the given camera, and answer its previous value.
+ See platforms/Cross/plugins/CameraPlugin/CameraPlugin.h for the list of parameter names."
+
+ <export: true>
+ | cameraNum paramNum paramValue result |
+ cameraNum := interpreterProxy stackIntegerValue: 2.
+ paramNum := interpreterProxy stackIntegerValue: 1.
+ paramValue := interpreterProxy stackValue: 0.
+ paramValue := (interpreterProxy isIntegerObject: paramValue)
+ ifTrue: [interpreterProxy integerValueOf: paramValue]
+ ifFalse: [interpreterProxy booleanValueOf: paramValue].
+ interpreterProxy failed
+ ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrBadArgument]
+ ifFalse:
+ [result := self CameraSetParam: cameraNum _: paramNum _: paramValue.
+ result < 0
+ ifTrue:
+ [interpreterProxy primitiveFailFor: result negated]
+ ifFalse:
+ [paramNum = MirrorImage
+ ifTrue: [interpreterProxy methodReturnBool: result]
+ ifFalse: [interpreterProxy methodReturnInteger: result]]]!
Item was added:
+ ----- Method: CoInterpreter>>cogMethodHasTooManyLiterals: (in category 'frame access') -----
+ cogMethodHasTooManyLiterals: aCogMethod
+ <api>
+ <var: 'aCogMethod' type: #'CogMethod *'>
+ ^(self methodWithHeaderShouldBeCogged: aCogMethod methodHeader) not!
Item was changed:
----- Method: CoInterpreter>>divorceAllFramesSuchThat: (in category 'frame access') -----
divorceAllFramesSuchThat: criterion
+ "Divorce all frames that satisfy criterion and answer the current activeContext."
+ <inline: false>
- "Divorce all frames that satisfy criterion nd answer the current activeContext."
<var: #criterion declareC: 'sqInt (*criterion)(char *fp)'>
| activeContext divorcedSome |
activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
self ensurePushedInstructionPointer.
self externalWriteBackHeadFramePointers.
[stackPage ifNotNil: "This is needed for the assert in externalDivorceFrame:andContext:"
[stackPages markStackPageMostRecentlyUsed: stackPage].
"Slang can't currently cope with the lack of the variable here.
Something to do with the preceding statement. Take it out
and the code is good. leave it in and we get do { ... } while(l1:)"
divorcedSome := self divorceSomeFramesIf: criterion.
divorcedSome] whileTrue.
^activeContext!
Item was added:
+ ----- Method: CoInterpreter>>ensureAllContextsHaveBytecodePCsIf: (in category 'frame access') -----
+ ensureAllContextsHaveBytecodePCsIf: criterion
+ "Map all native pcs to bytecoded pcs in all contexts whose method matches criterion."
+ <inline: false>
+ <var: #criterion declareC: 'sqInt (*criterion)(sqInt methodOop)'>
+ objectMemory allObjectsDo:
+ [:oop| | pc |
+ ((objectMemory isContextNonImm: oop)
+ and: [(objectMemory isIntegerObject: (pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: oop))
+ and: [pc < 0 "oops are signed; hence if integerValueOf: foo is negative so is foo"
+ and: [self perform: criterion with: (objectMemory followObjField: MethodIndex ofObject: oop)]]]) ifTrue:
+ [self widowOrForceToBytecodePC: oop]]!
Item was removed:
- ----- Method: CoInterpreter>>ensureAllContextsWithMachineCodeMethodsFlaggedForBecomeHaveBytecodePCs (in category 'frame access') -----
- ensureAllContextsWithMachineCodeMethodsFlaggedForBecomeHaveBytecodePCs
- "Map all native pcs to bytecoded pcs in all contexts that have a method with a cog method flagged for become
- See the comment in primitiveArrayBecome."
- <inline: true>
- objectMemory allObjectsDo:
- [:oop| | methodHeader |
- (objectMemory isContextNonImm: oop) ifTrue:
- [method := objectMemory followObjField: MethodIndex ofObject: oop.
- methodHeader := self rawHeaderOf: (objectMemory fetchPointer: MethodIndex ofObject: oop).
- ((self isCogMethodReference: methodHeader)
- and: [(self cCoerceSimple: methodHeader to: #'CogMethod *') isCMMethodFlaggedForBecome]) ifTrue:
- [self widowOrForceToBytecodePC: oop]]]!
Item was removed:
- ----- Method: CoInterpreter>>ensureAllContextsWithMethodMachineCodePrimitiveMethodHaveBytecodePCs (in category 'frame access') -----
- ensureAllContextsWithMethodMachineCodePrimitiveMethodHaveBytecodePCs
- "Map all native pcs to bytecoded pcs in all contexts that have a method with a cog method with a machine code primitive.
- Used to implement flushMethodsWithMachineCodePrimitivesAndContinueAnswering:/vmParameterAt: 75 put: aBool."
- <inline: true>
- objectMemory allObjectsDo:
- [:oop| | methodHeader |
- (objectMemory isContextNonImm: oop) ifTrue:
- [methodHeader := self rawHeaderOf: (objectMemory fetchPointer: MethodIndex ofObject: oop).
- ((self isCogMethodReference: methodHeader)
- and: [cogit cogMethodHasMachineCodePrim: (self cCoerceSimple: methodHeader to: #'CogMethod *')]) ifTrue:
- [self widowOrForceToBytecodePC: oop]]]!
Item was changed:
----- Method: CoInterpreter>>flushExternalPrimitives (in category 'plugin primitive support') -----
flushExternalPrimitives
"Flush the references to external functions from plugin primitives.
Then continue execution answering self.
This will force a reload of those primitives when accessed next.
Note: We must flush the method cache here also, so that any failed
primitives are looked up again.
Override to ensure that any and all activations of an external method
have a bytecode pc so that if code generation changes (e.g. a primitive
method is used, unloaded, and the reloaded primitive is marked with
the FastCPrimitiveFlag) stale machine code pcs have been eliminated.
THIS MUST BE INVOKED IN THE CONTEXT OF A PRIMITIVE."
| activeContext theFrame thePage |
activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForExternalPrimitiveMethod:.
objectMemory allObjectsDo:
[:oop|
(objectMemory isCompiledMethod: oop)
ifTrue:
[self flushExternalPrimitiveOf: oop]
ifFalse:
[(objectMemory isContext: oop) ifTrue:
[self mapToBytecodePCIfActivationOfExternalMethod: oop]]].
cogit unlinkSendsToMethodsSuchThat: #cogMethodHasExternalPrim: AndFreeIf: true.
self flushMethodCache.
self flushExternalPrimitiveTable.
self cCode: '' inSmalltalk:
+ [self assert: (cogit methodZone cogMethodsSelect: [:cogMethod| cogMethod isCMFree not and: [cogit cogMethodHasExternalPrim: cogMethod]]) isEmpty].
- [self assert: (cogit methodZone cogMethodsSelect: [:cogMethod| cogMethod cmType > CMFree and: [cogit cogMethodHasExternalPrim: cogMethod]]) isEmpty].
"If flushing led to divorce continue in the interpreter."
(self isStillMarriedContext: activeContext) ifFalse:
[self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
self popStack. "pop pushed instructionPointer"
self pop: argumentCount.
cogit ceInvokeInterpret
"NOTREACHED"].
"If not, work out where we are and continue"
theFrame := self frameOfMarriedContext: activeContext.
thePage := stackPages stackPageFor: theFrame.
self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
self setStackPointersFromPage: thePage.
instructionPointer := self popStack.
+ instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
+ [instructionPointer := self iframeSavedIP: framePointer].
self pop: argumentCount!
Item was changed:
----- Method: CoInterpreter>>flushMethodsWithMachineCodePrimitivesAndContinueAnswering: (in category 'primitive support') -----
flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
"Arrange that any and all cog methods with machine code primitives can be and are discarded.
Hence scan contexts and map their PCs to bytecode PCs if required, and scan frames, divorcing
the frames of activations if required. Then continue execution answering result. THIS MUST BE
INVOKED IN THE CONTEXT OF A PRIMITIVE. It exists to support vmParameterAt:put:."
| activeContext theFrame thePage |
activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForCogMethodWithMachineCodePrim:.
+ self ensureAllContextsHaveBytecodePCsIf: #methodHasMachineCodePrimitiveMethod:.
- self ensureAllContextsWithMethodMachineCodePrimitiveMethodHaveBytecodePCs.
cogit unlinkSendsToMethodsSuchThat: #cogMethodHasMachineCodePrim: AndFreeIf: true.
"If the top frame was divorced then continue in the interpreter."
(self isStillMarriedContext: activeContext) ifFalse:
[self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
"pop bogus machine-code instructionPointer, arguments and receiver"
self pop: argumentCount + 2 thenPush: result.
cogit ceInvokeInterpret
"NOTREACHED"].
"If not, work out where we are and continue"
theFrame := self frameOfMarriedContext: activeContext.
thePage := stackPages stackPageFor: theFrame.
self assert: thePage headFP = theFrame.
self setStackPageAndLimit: thePage.
self setStackPointersFromPage: thePage.
instructionPointer := self popStack.
+ instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
+ [instructionPointer := self iframeSavedIP: framePointer].
self pop: argumentCount + 1 thenPush: result!
Item was added:
+ ----- Method: CoInterpreter>>flushMethodsWithNumLiteralsAboveLimitAndContinueAnswering: (in category 'primitive support') -----
+ flushMethodsWithNumLiteralsAboveLimitAndContinueAnswering: result
+ "Arrange that any and all cog methods with numLiterals above maxLiteralCountForCompile are discarded.
+ Hence scan contexts and map their PCs to bytecode PCs if required, and scan frames, divorcing
+ the frames of activations if required. Then continue execution answering result. THIS MUST BE
+ INVOKED IN THE CONTEXT OF A PRIMITIVE. It exists to support vmParameterAt:put:."
+ | activeContext theFrame thePage |
+ activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForCogMethodWithTooManyLiterals:.
+ self ensureAllContextsHaveBytecodePCsIf: #methodHasTooManyLiterals:.
+ cogit unlinkSendsToMethodsSuchThat: #cogMethodHasTooManyLiterals: AndFreeIf: true.
+
+ "If the top frame was divorced then continue in the interpreter."
+ (self isStillMarriedContext: activeContext) ifFalse:
+ [self nilStackPage. "to avoid assert in marryContextInNewStackPageAndInitializeInterpreterRegisters:"
+ self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
+ "pop bogus machine-code instructionPointer, arguments and receiver"
+ self pop: argumentCount + 2 thenPush: result.
+ cogit ceInvokeInterpret
+ "NOTREACHED"].
+ "If not, work out where we are and continue"
+ theFrame := self frameOfMarriedContext: activeContext.
+ thePage := stackPages stackPageFor: theFrame.
+ self assert: thePage headFP = theFrame.
+ self setStackPageAndLimit: thePage.
+ self setStackPointersFromPage: thePage.
+ instructionPointer := self popStack.
+ instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
+ [instructionPointer := self iframeSavedIP: framePointer].
+ self pop: argumentCount + 1 thenPush: result!
Item was added:
+ ----- Method: CoInterpreter>>getMaxLiteralCountForCompile (in category 'internal interpreter access') -----
+ getMaxLiteralCountForCompile
+ ^objectMemory integerObjectOf: maxLiteralCountForCompile!
Item was changed:
----- Method: CoInterpreter>>insulateFramesAndContextsFromCogMethodsFlaggedForBecome (in category 'object access primitives') -----
insulateFramesAndContextsFromCogMethodsFlaggedForBecome
| activeContext |
activeContext := self divorceAllFramesSuchThat: #isMachineCodeFrameForCogMethodFlaggedForBecome:.
self popStack. "divorceAllFramesSuchThat: sends ensurePushedInstructionPointer, which is a side-effect we don't want here (but need elsewhere)"
"Mapping native pcs in contexts whose methods are flagged for become will not ensure that pcs are mapped reliably.
Consider this arc: a context on a method that has been jitted exists with a native pc.
The method is unjitted to make room for other methods to be jitted.
The method is becommed.
+ So the scan is only effective for methods in the code zone. Slowing down become so that a rare
- So the scan is only effective for methods in the jit. Slowing down become so that a rare
case may fail more comprehensibly, when its going to fail anyway, is a waste of effort."
false ifTrue:
+ [self ensureAllContextsHaveBytecodePCsIf: #methodIsCoggedFlaggedForBecome:].
- [self ensureAllContextsWithMachineCodeMethodsFlaggedForBecomeHaveBytecodePCs].
self assert: (framePointer ~= 0) == (self isStillMarriedContext: activeContext).
(self isStillMarriedContext: activeContext) ifFalse:
[objectMemory storePointer: SuspendedContextIndex ofObject: self activeProcess withValue: activeContext]!
Item was added:
+ ----- Method: CoInterpreter>>isMachineCodeFrameForCogMethodWithTooManyLiterals: (in category 'plugin primitive support') -----
+ isMachineCodeFrameForCogMethodWithTooManyLiterals: theFP
+ <var: #theFP type: #'char *'>
+ ^(self isMachineCodeFrame: theFP)
+ and: [(self methodWithHeaderShouldBeCogged: (self mframeHomeMethod: theFP) methodHeader) not]!
Item was added:
+ ----- Method: CoInterpreter>>methodHasMachineCodePrimitiveMethod: (in category 'primitive support') -----
+ methodHasMachineCodePrimitiveMethod: methodObj
+ | methodHeader |
+ methodHeader := self rawHeaderOf: methodObj.
+ ^(self isCogMethodReference: methodHeader)
+ and: [cogit cogMethodHasMachineCodePrim: (self cCoerceSimple: methodHeader to: #'CogMethod *')]!
Item was added:
+ ----- Method: CoInterpreter>>methodHasTooManyLiterals: (in category 'primitive support') -----
+ methodHasTooManyLiterals: methodObj
+ ^(self methodWithHeaderShouldBeCogged: (self methodHeaderOf: methodObj)) not!
Item was added:
+ ----- Method: CoInterpreter>>methodIsCoggedFlaggedForBecome: (in category 'primitive support') -----
+ methodIsCoggedFlaggedForBecome: methodObj
+ | methodHeader |
+ methodHeader := self rawHeaderOf: (objectMemory fetchPointer: MethodIndex ofObject: methodObj).
+ ^(self isCogMethodReference: methodHeader)
+ and: [(self cCoerceSimple: methodHeader to: #'CogMethod *') isCMMethodFlaggedForBecome]!
Item was changed:
----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating an amount of memory to its object heap.
V3: desiredHeapSize is the total size of the heap. Fail if the image has an unknown format or
requires more than the specified amount of memory.
Spur: desiredHeapSize is ignored; this routine will attempt to provide at least extraVMMemory's
ammount of free space after the image is loaded, taking any free space in the image into account.
extraVMMemory is stored in the image header and is accessible as vmParameterAt: 23. If
extraVMMemory is 0, the value defaults to the default grow headroom. Fail if the image has an
unknown format or if sufficient memory cannot be allocated.
Details: This method detects when the image was stored on a machine with the opposite byte
ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header
information to start 512 bytes into the file, since some file transfer programs for the Macintosh
apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix
area could also be used to store an exec command on Unix systems, allowing one to launch
Smalltalk by invoking the image name as a command."
- | swapBytes headerStart headerSize headerFlags dataSize bytesRead bytesToShift heapSize
- oldBaseAddr minimumMemory allocationReserve cogCodeBase
- firstSegSize hdrNumStackPages hdrEdenBytes hdrCogCodeSize hdrMaxExtSemTabSize |
<var: 'f' type: #sqImageFile>
+ <var: 'desiredHeapSize' type: #usqInt>
+ <var: 'imageOffset' type: #squeakFileOffsetType>
+
+ | swapBytes headerStart headerSize headerFlags dataSize bytesRead bytesToShift heapSize
+ oldBaseAddr minimumMemory allocationReserve cogCodeBase firstSegSize
+ hdrNumStackPages hdrEdenBytes hdrCogCodeSize hdrMaxExtSemTabSize |
<var: 'heapSize' type: #usqInt>
<var: 'dataSize' type: #'size_t'>
<var: 'minimumMemory' type: #usqInt>
- <var: 'desiredHeapSize' type: #usqInt>
<var: 'allocationReserve' type: #usqInt>
<var: 'headerStart' type: #squeakFileOffsetType>
- <var: 'imageOffset' type: #squeakFileOffsetType>
transcript := #stdout. "stdout is not available at compile time. this is the earliest available point."
metaclassNumSlots := 6. "guess Metaclass instSize"
classNameIndex := 6. "guess (Class instVarIndexFor: 'name' ifAbsent: []) - 1"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - 4. "record header start position"
headerSize := self getWord32FromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getWord32FromFile: f swap: swapBytes. "N.B. ignored in V3."
hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
cogCodeSize := desiredCogCodeSize ~= 0
ifTrue: [desiredCogCodeSize]
ifFalse:
[hdrCogCodeSize = 0
ifTrue: [cogit defaultCogCodeSize]
ifFalse: [desiredCogCodeSize := hdrCogCodeSize]]. "set for vmParameter 47"
cogCodeSize > cogit maxCogCodeSize ifTrue:
[cogCodeSize := cogit maxCogCodeSize].
+ hdrEdenBytes := self getWord32FromFile: f swap: swapBytes.
- hdrEdenBytes := self getWord32FromFile: f swap: swapBytes.
objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
+ the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
+ "Set maxLiteralCountForCompile unless it has already been set on the command line."
+ maxLiteralCountForCompile < 0 ifTrue:
+ [maxLiteralCountForCompile := the2ndUnknownShort ~= 0
+ ifTrue: [the2ndUnknownShort]
+ ifFalse: [MaxLiteralCountForCompile]].
- "pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
- Preserve it to be polite to other VMs."
- the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
firstSegSize := self getLongFromFile: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"compare memory requirements with availability"
allocationReserve := self interpreterAllocationReserveBytes.
minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ dataSize
+ objectMemory newSpaceBytes
+ allocationReserve.
"Compute how much space is needed for the initial heap allocation.
no need to include the stackZone; this is alloca'ed.
no need to include the JIT code zone size; this is allocated separately."
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[| freeOldSpaceInImage headroom |
freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes.
headroom := objectMemory
initialHeadroom: extraVMMemory
givenFreeOldSpaceInImage: freeOldSpaceInImage.
heapSize := objectMemory roundUpHeapSize:
dataSize
+ headroom
+ objectMemory newSpaceBytes
+ (headroom > allocationReserve
ifTrue: [0]
ifFalse: [allocationReserve])]
ifFalse:
[heapSize := desiredHeapSize
+ objectMemory newSpaceBytes
+ (desiredHeapSize - dataSize > allocationReserve
ifTrue: [0]
ifFalse: [allocationReserve]).
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError]].
"allocateJITMemory will assign the actual size allocated, which is rounded up to a page boundary."
cogCodeBase := (self allocateJITMemory: (self addressOf: cogCodeSize)) asInteger.
"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
(self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize) asUnsignedInteger
ifNil: [self insufficientMemoryAvailableError]
ifNotNil:
[:mem| "cannot clash with the variable memory still in use in NewCoObjectMemory and superclasses"
objectMemory
setHeapBase: (heapBase := mem)
memoryLimit: mem + heapSize
endOfMemory: mem + dataSize].
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
cogit initializeCodeZoneFrom: cogCodeBase upTo: cogCodeBase + cogCodeSize.
^dataSize!
Item was added:
+ ----- Method: CoInterpreter>>setMaxLiteralCountForCompile: (in category 'internal interpreter access') -----
+ setMaxLiteralCountForCompile: mlcfc
+ <inline: true>
+ "the2ndUnknownShort is the value written to the image; so set both the limit and the value saved."
+ maxLiteralCountForCompile := the2ndUnknownShort := mlcfc!
Item was added:
+ ----- Method: CogObjectRepresentation>>genPrimitiveHighResClock32 (in category 'primitive generators') -----
+ genPrimitiveHighResClock32
+ <inline: true>
+ "This awaits a 32-bit implementation of genAlloc64BitPositiveIntegerValue:into:scratchReg:scratchReg:..."
+ ^UnimplementedPrimitive!
Item was added:
+ ----- Method: CogObjectRepresentationFor64BitSpur>>genPrimitiveHighResClock64 (in category 'primitive generators') -----
+ genPrimitiveHighResClock64
+ <inline: true>
+ | reg jumpFailAlloc jumpNotSmallInteger |
+ cogit backEnd has64BitPerformanceCounter ifFalse:
+ [^UnimplementedPrimitive].
+ reg := cogit backEnd preferredRegisterForMovePerfCnt64RL = NoReg
+ ifTrue: [Arg0Reg]
+ ifFalse: [cogit backEnd preferredRegisterForMovePerfCnt64RL].
+ self assert: (cogit register: reg isNotInMask: (cogit registerMaskFor: ReceiverResultReg and: Arg1Reg and: Extra0Reg and: Extra1Reg)).
+ cogit
+ MovePerfCnt64R: reg L: (cogit registerMaskFor: NoReg);
+ LogicalShiftRightCq: self numSmallIntegerBits - 1 R: reg R: Arg1Reg. "If in range this is now 0"
+ (cogit lastOpcode setsConditionCodesFor: JumpZero) ifFalse:
+ [cogit CmpCq: 0 R: Arg1Reg]. "N.B. FLAGS := ClassReg - 0"
+ jumpNotSmallInteger := cogit JumpNonZero: 0.
+ self genConvertIntegerInReg: reg toSmallIntegerInReg: ReceiverResultReg.
+ cogit genPrimReturn.
+ jumpNotSmallInteger jmpTarget: cogit Label.
+ jumpFailAlloc := self genAlloc64BitPositiveIntegerValue: reg into: ReceiverResultReg scratchReg: Extra0Reg scratchReg: Extra1Reg.
+ cogit MoveR: SendNumArgsReg R: ReceiverResultReg.
+ cogit genPrimReturn.
+ jumpFailAlloc jmpTarget: cogit Label.
+ ^0!
Item was changed:
----- Method: CogVMSimulator>>initialize (in category 'initialize-release') -----
initialize
"Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The
primary responsibility of this method is to allocate Smalltalk Arrays for variables
that will be declared as statically-allocated global arrays in the translated code."
super initialize.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := InitializationOptions
at: #ObjectMemorySimulator
ifPresent: [:className| (Smalltalk classNamed: className) new]
ifAbsent: [self class objectMemoryClass simulatorClass new]].
cogit ifNil:
[cogit := self class cogitClass new setInterpreter: self].
objectMemory coInterpreter: self cogit: cogit.
(cogit numRegArgs > 0
and: [VMClass initializationOptions at: #CheckStackDepth ifAbsent: [true]]) ifTrue:
[debugStackDepthDictionary := Dictionary new].
cogThreadManager ifNotNil:
[super initialize].
self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
enableCog := true.
methodCache := Array new: MethodCacheSize.
nsMethodCache := Array new: NSMethodCacheSize.
atCache := nil.
self flushMethodCache.
cogCompiledCodeCompactionCalledFor := false.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
self initializePluginEntries.
desiredNumStackPages := InitializationOptions at: #desiredNumStackPages ifAbsent: [0].
desiredEdenBytes := InitializationOptions at: #desiredEdenBytes ifAbsent: [0].
desiredCogCodeSize := InitializationOptions at: #desiredCogCodeSize ifAbsent: [0].
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds.
+ maxLiteralCountForCompile := -1. "This allows seeing if maxLiteralCountForCompile has been set on the command line."
- maxLiteralCountForCompile := MaxLiteralCountForCompile.
minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
flagInterpretedMethods := false.
"initialize InterpreterSimulator variables used for debugging"
byteCount := lastPollCount := sendCount := lookupCount := 0.
quitBlock := [^self close].
printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
suppressHeartbeatFlag := deferSmash := deferredSmash := false.
systemAttributes := Dictionary new.
primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
primTraceLogIndex := 0.
traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
traceLogIndex := 0.
traceSources := TraceSources.
statCodeCompactionCount := 0.
statCodeCompactionUsecs := 0.
extSemTabSize := 256.
zeroNextProfileTickCount := 0.
printFrameRange := 0 to: 0.
printfConversions := IdentityDictionary new!
Item was changed:
----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialize-release') -----
openOn: fileName extraMemory: extraBytes
"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
| f version headerSize dataSize count oldBaseAddr bytesToShift swapBytes
headerFlags firstSegSize heapSize
hdrNumStackPages hdrEdenBytes hdrMaxExtSemTabSize hdrCogCodeSize
stackZoneSize methodCacheSize primTraceLogSize allocationReserve |
"open image file and read the header"
(f := self openImageFileNamed: fileName) ifNil: [^self].
"Set the image name and the first argument; there are
no arguments during simulation unless set explicitly."
systemAttributes at: 1 put: fileName.
["begin ensure block..."
imageName := f fullName.
f binary.
version := self getWord32FromFile: f swap: false. "current version: 16r1968 (=6504) vive la revolucion!!"
(self readableFormat: version)
ifTrue: [swapBytes := false]
ifFalse: [(version := version byteSwap32) = self imageFormatVersion
ifTrue: [swapBytes := true]
ifFalse: [self error: 'incomaptible image format']].
headerSize := self getWord32FromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes. "length of heap in file"
oldBaseAddr := self getLongFromFile: f swap: swapBytes. "object memory base address of image"
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "Should be loaded from, and saved to the image header"
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getWord32FromFile: f swap: swapBytes.
hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n"
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
stackZoneSize := self computeStackZoneSize.
"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
cogCodeSize := desiredCogCodeSize ~= 0
ifTrue: [desiredCogCodeSize]
ifFalse:
[hdrCogCodeSize = 0
ifTrue: [cogit defaultCogCodeSize]
ifFalse: [hdrCogCodeSize]].
desiredCogCodeSize := hdrCogCodeSize.
self assert: f position = (objectMemory wordSize = 4 ifTrue: [40] ifFalse: [64]).
hdrEdenBytes := self getWord32FromFile: f swap: swapBytes.
objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
+ the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
+ "Set maxLiteralCountForCompile unless it has already been set on the command line."
+ maxLiteralCountForCompile < 0 ifTrue:
+ [maxLiteralCountForCompile := the2ndUnknownShort ~= 0
+ ifTrue: [the2ndUnknownShort]
+ ifFalse: [MaxLiteralCountForCompile]].
- "pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
- Preserve it to be polite to other VMs."
- the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
self assert: f position = (objectMemory wordSize = 4 ifTrue: [48] ifFalse: [72]).
firstSegSize := self getLongFromFile: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"For Open PICs to be able to probe the method cache during
simulation the methodCache must be relocated to memory."
methodCacheSize := methodCache size * objectMemory wordSize.
primTraceLogSize := primTraceLog size * objectMemory wordSize.
"To cope with modern OSs that disallow executing code in writable memory we dual-map
the code zone, one mapping with read/write permissions and the other with read/execute
permissions. In simulation all we can do is use memory, so if we're simulating dual mapping
we use double the memory and simulate the memory sharing in the Cogit's backEnd."
effectiveCogCodeSize := (InitializationOptions at: #DUAL_MAPPED_CODE_ZONE ifAbsent: [false])
+ ifTrue: [cogCodeSize * 2 + Cogit guardPageSize]
- ifTrue: [cogCodeSize * 2]
ifFalse: [cogCodeSize].
"allocate interpreter memory. This list is in address order, low to high.
In the actual VM the stack zone exists on the C stack."
heapBase := (Cogit guardPageSize
+ effectiveCogCodeSize
+ stackZoneSize
+ methodCacheSize
+ primTraceLogSize
+ self rumpCStackSize) roundUpTo: objectMemory allocationUnit.
"compare memory requirements with availability"
allocationReserve := self interpreterAllocationReserveBytes.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[| freeOldSpaceInImage headroom |
freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes.
headroom := objectMemory
initialHeadroom: extraVMMemory
givenFreeOldSpaceInImage: freeOldSpaceInImage.
heapSize := objectMemory roundUpHeapSize:
dataSize
+ headroom
+ objectMemory newSpaceBytes
+ (headroom > allocationReserve
ifTrue: [0]
ifFalse: [allocationReserve])]
ifFalse:
[heapSize := dataSize
+ extraBytes
+ objectMemory newSpaceBytes
+ (extraBytes > allocationReserve
ifTrue: [0]
ifFalse: [allocationReserve])].
"allocate interpreter memory"
heapBase := objectMemory
setHeapBase: heapBase
memoryLimit: heapBase + heapSize
endOfMemory: heapBase + dataSize. "bogus for Spur"
self assert: cogCodeSize \\ 4 = 0.
self assert: objectMemory memoryLimit \\ 4 = 0.
self assert: self rumpCStackSize \\ 4 = 0.
objectMemory allocateMemoryOfSize: objectMemory memoryLimit.
"read in the image in bulk, then swap the bytes if necessary"
f position: headerSize.
count := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
count ~= dataSize ifTrue: [self halt]]
ensure: [f close].
self moveMethodCacheToMemoryAt: objectMemory cogCodeBase + effectiveCogCodeSize + stackZoneSize.
self movePrimTraceLogToMemoryAt: objectMemory cogCodeBase + effectiveCogCodeSize + stackZoneSize + methodCacheSize.
self ensureImageFormatIsUpToDate: swapBytes.
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. "adjust pointers for zero base address"
UIManager default
informUser: 'Relocating object pointers...'
during: [self initializeInterpreter: bytesToShift].
cogit
initializeCodeZoneFrom: Cogit guardPageSize
upTo: Cogit guardPageSize + cogCodeSize!
Item was changed:
----- Method: CurrentImageCoInterpreterFacade>>functionPointerForCompiledMethod:primitiveIndex:primitivePropertyFlagsInto: (in category 'accessing') -----
functionPointerForCompiledMethod: methodOop primitiveIndex: primIndex primitivePropertyFlagsInto: flagsPtr
primIndex = PrimNumberExternalCall ifTrue:
[flagsPtr
at: 0
put: (coInterpreter
primitivePropertyFlagsFor: (self primitiveMethodForMethodContainingExternalPrimitive: methodOop)
primitiveIndex: primIndex).
+ ^((self objectForOop: methodOop) literalAt: 1) second].
- ^self oopForObject: ((self objectForOop: methodOop) literalAt: 1) second].
^(coInterpreter functionPointerForCompiledMethod: methodOop primitiveIndex: primIndex primitivePropertyFlagsInto: flagsPtr) ifNotNil:
[:symbol| self addressForLabel: symbol]!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>isFullBlockMethod: (in category 'testing') -----
+ isFullBlockMethod: anInteger
+ ^false!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation>>isFullBlockMethod: (in category 'testing') -----
+ isFullBlockMethod: methodOop
+ ^(self objectForOop: methodOop) isCompiledBlock!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveHighResClock (in category 'system control primitives') -----
primitiveHighResClock
"Return the value of the high resolution clock if this system has any.
The exact frequency of the high res clock is undefined specifically so that we can use
processor dependent instructions (like RDTSC). The only use for the high res clock is for
profiling where we can allocate time based on sub-msec resolution of the high res clock.
If no high-resolution counter is available, the platform should return zero. ar 6/22/2007"
<export: true>
+ <api>
<primitiveMetadata: #FastCPrimitiveFlag>
self methodReturnValue: (self positive64BitIntegerFor: self ioHighResClock)!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive:flags: (in category 'primitive generators') -----
compileInterpreterPrimitive: primitiveRoutine flags: flags
"Compile a call to an interpreter primitive. Call the C routine with the
usual stack-switching dance, test the primFailCode and then either
return on success or continue to the method body."
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
| jmp continueAfterProfileSample jumpToTakeSample |
+ self cCode: '' inSmalltalk:
+ [primitiveRoutine isSymbol ifTrue:
+ [^self compileInterpreterPrimitive: (self simulatedAddressFor: primitiveRoutine) flags: flags]].
+
self deny: (backEnd hasVarBaseRegister
and: [self register: VarBaseReg isInMask: ABICallerSavedRegisterMask]).
"Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers"
self genExternalizePointersForPrimitiveCall.
"Switch to the C stack."
self genLoadCStackPointersForPrimCall.
"Old old full prim trace is in VMMaker-eem.550 and prior.
Old simpler full prim trace is in VMMaker-eem.2969 and prior."
(coInterpreter recordPrimTraceForMethod: methodObj) ifTrue:
[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
"Clear the primFailCode and set argumentCount"
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
methodOrBlockNumArgs ~= 0 ifTrue:
[self AddCq: methodOrBlockNumArgs R: TempReg]. "As small or smaller than move on most archs"
self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
"If required, set newMethod"
(flags anyMask: PrimCallNeedsNewMethod) ifTrue:
[self genLoadNewMethod].
"Invoke the primitive. If the primitive (potentially) contains a call-back then its code
may disappear and consequently we cannot return here, since here may evaporate.
Instead sideways-call the routine, substituting cePrimReturnEnterCogCode[Profiling]
as the return address, so the call always returns there."
self PrefetchAw: coInterpreter primFailCodeAddress.
(flags anyMask: PrimCallMayEndureCodeCompaction) ifTrue:
["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
needsFrame := true.
backEnd
genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil;
genSubstituteReturnAddress:
((flags anyMask: PrimCallCollectsProfileSamples)
ifTrue: [cePrimReturnEnterCogCodeProfiling]
ifFalse: [cePrimReturnEnterCogCode]).
self JumpFullRT: primitiveRoutine asInteger.
^0].
"Call the C primitive routine."
backEnd genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil.
self CallFullRT: primitiveRoutine asInteger.
backEnd genRemoveNArgsFromStack: 0.
objectRepresentation maybeCompileRetryOf: primitiveRoutine onPrimitiveFail: primitiveIndex flags: flags.
"Switch back to the Smalltalk stack. Stack better be in either of these two states:
success: stackPointer -> result (was receiver)
arg1
...
argN
return pc
failure: receiver
arg1
...
stackPointer -> argN
return pc"
backEnd genLoadStackPointersForPrimCall: ClassReg.
"genLoadStackPointersForPrimCall: leaves the stack in these states:
NoLinkRegister LinkRegister
success: result (was receiver) stackPointer -> result (was receiver)
stackPointer -> arg1 arg1
... ...
argN argN
return pc
failure: receiver receiver
arg1 arg1
... ...
argN stackPointer -> argN
stackPointer -> return pc
which corresponds to the stack on entry after pushRegisterArgs.
In either case we can write the instructionPointer to top of stack or load it into the LinkRegister to reestablish the return pc."
backEnd hasLinkRegister
ifTrue:
[self MoveAw: coInterpreter instructionPointerAddress R: LinkReg]
ifFalse:
[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.
self MoveR: ClassReg Mw: 0 r: SPReg].
"Test primitive failure"
self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
self flag: 'ask concrete code gen if move sets condition codes?'.
self CmpCq: 0 R: TempReg.
jmp := self JumpNonZero: 0.
"placing the test here attributes the tick to the primitive plus any checkForAndFollowForwardedPrimitiveState
scanning, but attributes all of a failing primitive to the current method (in ceStackOverflow: on frame build)."
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample := self genCheckForProfileTimerTick: (self registerMaskFor: NoReg)].
"Fetch result from stack"
continueAfterProfileSample :=
self MoveMw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize])
r: SPReg
R: ReceiverResultReg.
self RetN: objectMemory wordSize. "return to caller, popping receiver"
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample jmpTarget: self Label.
self genTakeProfileSample.
backEnd genLoadStackPointerForPrimCall: ClassReg.
backEnd hasLinkRegister
ifTrue:
[self MoveAw: coInterpreter instructionPointerAddress R: LinkReg]
ifFalse:
[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.
self MoveR: ClassReg Mw: 0 r: SPReg].
self Jump: continueAfterProfileSample].
"Jump to restore of receiver reg and proceed to frame build for failure."
jmp jmpTarget: self Label.
"Restore receiver reg from stack. If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack."
self MoveMw: objectMemory wordSize * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]))
r: SPReg
R: ReceiverResultReg.
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>compileOnStackExternalPrimitive:flags: (in category 'primitive generators') -----
compileOnStackExternalPrimitive: primitiveRoutine flags: flags
"Compile a fast call of a C primitive using the current stack page, avoiding the stack switch except on failure.
This convention still uses stackPointer and argumentCount to access operands. Push all operands to the stack,
assign stackPointer, argumentCount, and zero primFailCode. Make the call (saving a LinkReg if required).
Test for failure and return. On failure on Spur, if there is an accessor depth, assign framePointer and newMethod,
do the stack switch, call checkForAndFollowForwardedPrimitiveState, and loop back if forwarders are found.
Fall through to frame build."
<option: #SpurObjectMemory>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
| calleeSavedRegisterMask linkRegSaveRegister spRegSaveRegister jmpFail retry continueAfterProfileSample jumpToTakeSample |
+ self cCode: '' inSmalltalk:
+ [primitiveRoutine isSymbol ifTrue:
+ [^self compileOnStackExternalPrimitive: (self simulatedAddressFor: primitiveRoutine) flags: flags]].
+
self assert: (objectRepresentation hasSpurMemoryManagerAPI and: [flags anyMask: PrimCallOnSmalltalkStack]).
self deny: (backEnd hasVarBaseRegister
and: [self register: VarBaseReg isInMask: ABICallerSavedRegisterMask]).
(coInterpreter recordFastCCallPrimTraceForMethod: methodObj) ifTrue:
[self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
"Clear the primFailCode and set argumentCount"
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
methodOrBlockNumArgs ~= 0 ifTrue:
[self AddCq: methodOrBlockNumArgs R: TempReg]. "As small or smaller than move on most archs"
self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
self genExternalizeStackPointerForFastPrimitiveCall.
"We may need to save LinkReg and/or SPReg, and given the stack machinations
it is much easier to save them in callee saved registers than on the stack itself."
calleeSavedRegisterMask := ABICalleeSavedRegisterMask bitClear: (self registerMaskFor: ClassReg).
backEnd hasLinkRegister ifTrue:
[linkRegSaveRegister := self availableRegisterOrNoneIn: calleeSavedRegisterMask.
self deny: linkRegSaveRegister = NoReg.
self MoveR: LinkReg R: linkRegSaveRegister.
calleeSavedRegisterMask := calleeSavedRegisterMask bitClear: (self registerMaskFor: linkRegSaveRegister)].
spRegSaveRegister := NoReg.
(SPReg ~= NativeSPReg
and: [(self isCalleeSavedReg: SPReg) not]) ifTrue:
[spRegSaveRegister := self availableRegisterOrNoneIn: calleeSavedRegisterMask.
self deny: spRegSaveRegister = NoReg.
self MoveR: SPReg R: spRegSaveRegister].
retry := self Label.
(flags anyMask: PrimCallOnSmalltalkStackAlign2x)
ifTrue: [self AndCq: (objectMemory wordSize * 2 - 1) bitInvert R: SPReg R: NativeSPReg]
ifFalse:
[SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadNativeSPRegWithAlignedSPReg]].
backEnd genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil.
"If the primitive is in the interpreter then its address won't change relative to the code zone over time,
whereas if it is in a plugin its address could change if the module is un/re/over/loaded.
So if in the interpreter and in range use a normal call instruction."
((flags noMask: PrimCallIsExternalCall)
and: [backEnd isWithinCallRange: primitiveRoutine asInteger])
ifTrue: [self CallRT: primitiveRoutine asInteger]
ifFalse: [self CallFullRT: primitiveRoutine asInteger].
backEnd genRemoveNArgsFromStack: 0.
"test primFailCode and jump to failure sequence if non-zero"
self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
spRegSaveRegister ~= NoReg ifTrue:
[self MoveR: spRegSaveRegister R: SPReg].
self CmpCq: 0 R: TempReg.
jmpFail := self JumpNonZero: 0.
"Remember to restore the native stack pointer to point to the C stack,
otherwise the Smalltalk frames will get overwritten on an interrupt."
SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadCStackPointer].
"placing the test here attributes the tick to the primitive plus any checkForAndFollowForwardedPrimitiveState
scanning, but attributes all of a failing primitive to the current method (in ceStackOverflow: on frame build)."
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample := self genCheckForProfileTimerTick: (self registerMaskFor: NoReg)].
"At this point the primitive has cut back stackPointer to point to the result."
continueAfterProfileSample :=
self MoveAw: coInterpreter stackPointerAddress R: TempReg.
"get result and restore retpc"
backEnd hasLinkRegister
ifTrue:
[self MoveMw: 0 r: TempReg R: ReceiverResultReg;
AddCq: objectMemory wordSize R: TempReg R: SPReg;
MoveR: linkRegSaveRegister R: LinkReg]
ifFalse:
[| retpcOffset |
"The original retpc is (argumentCount + 1) words below stackPointer."
retpcOffset := (methodOrBlockNumArgs + 1 * objectMemory wordSize) negated.
self MoveMw: retpcOffset r: TempReg R: ClassReg; "get retpc"
MoveR: TempReg R: SPReg;
MoveMw: 0 r: TempReg R: ReceiverResultReg;
MoveR: ClassReg Mw: 0 r: TempReg "put it back on stack for the return..."].
self RetN: 0.
(backEnd has64BitPerformanceCounter
and: [flags anyMask: PrimCallCollectsProfileSamples]) ifTrue:
[jumpToTakeSample jmpTarget: self Label.
self genTakeProfileSample.
self Jump: continueAfterProfileSample].
"primitive failure. if there is an accessor depth, scan and retry on failure (but what if faling for out of memory?)"
jmpFail jmpTarget: self Label.
(coInterpreter accessorDepthForPrimitiveMethod: methodObj) >= 0
ifTrue:
[| skip |
"Given that following primitive state to the accessor depth is recursive, we're asking for
trouble if we run the fixup on the Smalltalk stack page. Run it on the full C stack instead.
This won't be a performance issue since primitive failure should be very rare."
self MoveR: FPReg Aw: coInterpreter framePointerAddress.
self MoveCw: primitiveRoutine asInteger R: TempReg.
self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress.
self genLoadNewMethod.
self genLoadCStackPointersForPrimCall.
backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
(backEnd isWithinCallRange: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState]))
ifTrue:
[self CallRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState])]
ifFalse:
[self CallFullRT: (self cCode: [#checkForAndFollowForwardedPrimitiveState asUnsignedIntegerPtr]
inSmalltalk: [self simulatedTrampolineFor: #checkForAndFollowForwardedPrimitiveState])].
backEnd genLoadStackPointersForPrimCall: ClassReg.
self CmpCq: 0 R: ABIResultReg.
skip := self JumpZero: 0.
self MoveCq: 0 R: TempReg.
self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
self Jump: retry.
skip jmpTarget: self Label]
ifFalse: "must reload SPReg to undo any alignment change,"
[(flags anyMask: PrimCallOnSmalltalkStackAlign2x) ifTrue:
[backEnd hasLinkRegister
ifTrue:
[self MoveAw: coInterpreter stackPointerAddress R: SPReg]
ifFalse: "remember to include return address; use scratch to avoid an interrupt overwriting retpc"
[self MoveAw: coInterpreter stackPointerAddress R: TempReg.
self SubCq: objectRepresentation wordSize R: TempReg.
self MoveR: TempReg R: SPReg]]].
"Remember to restore the native stack pointer to point to the C stack,
otherwise the Smalltalk frames will get overwritten on an interrupt."
SPReg ~= NativeSPReg ifTrue:
[backEnd genLoadCStackPointer].
"The LinkRegister now contains the return address either of the primitive call or of checkForAndFollowForwardedPrimitiveState.
It must be restored to the return address of the send invoking this primtiive method."
backEnd hasLinkRegister ifTrue:
[self MoveR: linkRegSaveRegister R: LinkReg].
"Finally remember to reload ReceiverResultReg if required. Even if
arguments have been pushed, the prolog sequence assumes it is live."
(self register: ReceiverResultReg isInMask: ABICallerSavedRegisterMask) ifTrue:
[self MoveMw: (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1])) * objectMemory wordSize
r: SPReg
R: ReceiverResultReg].
"continue to frame build..."
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>compilePrimitive (in category 'primitive generators') -----
compilePrimitive
"Compile a primitive. If possible, performance-critical primitives will
be generated by their own routines (primitiveGenerator). Otherwise,
if there is a primitive at all, we call the C routine with the usual
stack-switching dance, test the primFailCode and then either return
on success or continue to the method body."
<inline: false>
+ | primitiveDescriptor primitiveRoutine code flags |
- | primitiveDescriptor primitiveRoutine flags |
<var: #primitiveDescriptor type: #'PrimitiveDescriptor *'>
<var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
primitiveIndex = 0 ifTrue: [^0].
"If a descriptor specifies an argument count (by numArgs >= 0) then it must match
for the generated code to be correct. For example for speed many primitives use
ResultReceiverReg instead of accessing the stack, so the receiver better be at
numArgs down the stack. Use the interpreter version if not."
((primitiveDescriptor := self primitiveGeneratorOrNil) notNil
and: [primitiveDescriptor primitiveGenerator notNil
and: [(primitiveDescriptor primNumArgs < 0 "means generator doesn't care"
+ or: [primitiveDescriptor primNumArgs = methodOrBlockNumArgs])]]) ifTrue:
+ [| opcodeIndexAtPrimitive |
- or: [primitiveDescriptor primNumArgs = (coInterpreter argumentCountOf: methodObj)])]]) ifTrue:
- [| opcodeIndexAtPrimitive code |
"Note opcodeIndex so that any arg load instructions
for unimplemented primitives can be discarded."
opcodeIndexAtPrimitive := opcodeIndex.
code := objectRepresentation perform: primitiveDescriptor primitiveGenerator.
(code < 0 and: [code ~= UnimplementedPrimitive]) ifTrue: "Generator failed, so no point continuing..."
[^code].
"If the primitive can never fail then there is nothing more that needs to be done."
code = UnfailingPrimitive ifTrue:
[^0].
"If the machine code version handles all cases the only reason to call the interpreter
primitive is to reap the primitive error code. Don't bother if it isn't used."
(code = CompletePrimitive
and: [(self methodUsesPrimitiveErrorCode: methodObj header: methodHeader) not]) ifTrue:
[^0].
"Discard any arg load code generated by the primitive generator."
code = UnimplementedPrimitive ifTrue:
[opcodeIndex := opcodeIndexAtPrimitive]].
primitiveRoutine := coInterpreter
functionPointerForCompiledMethod: methodObj
primitiveIndex: primitiveIndex
primitivePropertyFlagsInto: (self addressOf: flags put: [:val| flags := val]).
(primitiveRoutine = 0 "no primitive"
or: [primitiveRoutine = (self cCoerceSimple: #primitiveFail to: 'void (*)(void)')]) ifTrue:
[^self genFastPrimFail].
+ (backEnd has64BitPerformanceCounter
+ and: [primitiveRoutine = (self cCoerceSimple: #primitiveHighResClock to: 'void (*)(void)')
+ and: [methodOrBlockNumArgs = 0]]) ifTrue:
+ [objectRepresentation wordSize = 8
+ ifTrue: [code := objectRepresentation genPrimitiveHighResClock64]
+ ifFalse: [code := objectRepresentation genPrimitiveHighResClock32].
+ code ~= UnimplementedPrimitive ifTrue:
+ [^code]].
+
(objectRepresentation hasSpurMemoryManagerAPI
and: [flags anyMask: PrimCallOnSmalltalkStack]) ifTrue:
[^self compileOnStackExternalPrimitive: primitiveRoutine flags: flags].
^self compileInterpreterPrimitive: primitiveRoutine flags: flags!
Item was added:
+ ----- Method: StackInterpreter>>flushMethodsWithNumLiteralsAboveLimitAndContinueAnswering: (in category 'primitive support') -----
+ flushMethodsWithNumLiteralsAboveLimitAndContinueAnswering: result
+ "In the StackInterpreter this is simply a no op"!
Item was added:
+ ----- Method: StackInterpreter>>getMaxLiteralCountForCompile (in category 'internal interpreter access') -----
+ getMaxLiteralCountForCompile
+ "This is nil in the StackVM"
+ ^objectMemory nilObject!
Item was added:
+ ----- Method: StackInterpreter>>setMaxLiteralCountForCompile: (in category 'internal interpreter access') -----
+ setMaxLiteralCountForCompile: mlcfc
+ <inline: true>
+ "This should perhaps be a no-op in the StackVM, but we implement it for the convenience of bootstrap scripts etc."
+ the2ndUnknownShort := mlcfc!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveAllVMParameters: (in category 'system control primitives') -----
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveGetVMParameter: (in category 'system control primitives') -----
primitiveGetVMParameter: arg
"See primitiveVMParameter method comment.
N.B. written as a returning case to avoid branch limits in the V3 bytecode set."
arg caseOf: {
[1] -> [^self positiveMachineIntegerFor: objectMemory oldSpaceSize].
[2] -> [^objectMemory integerObjectOf: objectMemory newSpaceSize].
[3] -> [^self positiveMachineIntegerFor: objectMemory totalMemorySize].
[6] -> [^objectMemory integerObjectOf: objectMemory tenuringThreshold].
[7] -> [^objectMemory integerObjectOf: objectMemory statFullGCs].
[8] -> [^objectMemory integerObjectOf: objectMemory statFullGCUsecs + 500 // 1000].
[9] -> [^objectMemory integerObjectOf: (objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory statScavenges]
ifFalse: [objectMemory statIncrGCs])].
[10] -> [^objectMemory integerObjectOf: (objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory statScavengeGCUsecs]
ifFalse: [objectMemory statIncrGCUsecs]) + 500 // 1000].
[11] -> [^objectMemory integerObjectOf: objectMemory statTenures].
[12] -> [^objectMemory integerObjectOf: eventTraceMask].
[13] -> [^self getVMTickerStartUSecs].
[14] -> [^self getVMTickerCount].
[15] -> [^self getVMTickeeCallCount].
[16] -> [^self positive64BitIntegerFor: statIdleUsecs].
[17] -> [^(SistaVM and: [self isCog])
ifTrue: [objectMemory floatObjectOf: self getCogCodeZoneThreshold]
ifFalse: [ConstZero]].
[18] -> [^objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory integerObjectOf: objectMemory statCompactionUsecs + 500 // 1000]
ifFalse: [ConstZero]].
[19] -> [^objectMemory hasSpurMemoryManagerAPI
ifTrue: [objectMemory integerObjectOf: objectMemory scavengeThresholdAsExtent]
ifFalse: [ConstZero]].
[20] -> [^objectMemory positive64BitIntegerFor: self ioUTCStartMicroseconds].
[21] -> [^objectMemory integerObjectOf: objectMemory rootTableCount].
[22] -> [^objectMemory integerObjectOf: objectMemory statRootTableOverflows].
[23] -> [^objectMemory integerObjectOf: extraVMMemory].
[24] -> [^objectMemory integerObjectOf: objectMemory shrinkThreshold].
[25] -> [^objectMemory integerObjectOf: objectMemory growHeadroom].
[26] -> [^objectMemory integerObjectOf: self ioHeartbeatMilliseconds].
[27] -> [^objectMemory integerObjectOf: objectMemory statMarkCount].
[28] -> [^objectMemory integerObjectOf: objectMemory statSweepCount].
[29] -> [^objectMemory integerObjectOf: objectMemory statMkFwdCount].
[30] -> [^objectMemory integerObjectOf: objectMemory statCompMoveCount].
[31] -> [^objectMemory integerObjectOf: objectMemory statGrowMemory].
[32] -> [^objectMemory integerObjectOf: objectMemory statShrinkMemory].
[33] -> [^objectMemory integerObjectOf: objectMemory statRootTableCount].
[34] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:"was statAllocationCount"
[objectMemory positive64BitIntegerFor: objectMemory currentAllocatedBytes]].
[35] -> [^objectMemory integerObjectOf: objectMemory statSurvivorCount].
[36] -> [^objectMemory integerObjectOf: (self microsecondsToMilliseconds: objectMemory statGCEndUsecs)].
[37] -> [^objectMemory integerObjectOf: objectMemory statSpecialMarkCount].
[38] -> [^objectMemory integerObjectOf: objectMemory statIGCDeltaUsecs + 500 // 1000].
[39] -> [^objectMemory integerObjectOf: statPendingFinalizationSignals].
[40] -> [^objectMemory integerObjectOf: objectMemory wordSize].
[41] -> [^objectMemory integerObjectOf: self imageFormatVersion].
[42] -> [^objectMemory integerObjectOf: numStackPages].
[43] -> [^objectMemory integerObjectOf: desiredNumStackPages].
[44] -> [^objectMemory integerObjectOf: objectMemory edenBytes].
[45] -> [^objectMemory integerObjectOf: desiredEdenBytes].
[46] -> [^self getCogCodeSize].
[47] -> [^self getDesiredCogCodeSize].
[48] -> [^self getImageHeaderFlagsParameter].
[49] -> [^objectMemory integerObjectOf: self ioGetMaxExtSemTableSize].
+ [50] -> [^self getMaxLiteralCountForCompile].
[52] -> [^objectMemory integerObjectOf: objectMemory rootTableCapacity].
[53] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory integerObjectOf: objectMemory numSegments]].
[54] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory integerObjectOf: objectMemory freeSize]].
[55] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory floatObjectOf: objectMemory getHeapGrowthToSizeGCRatio]].
[56] -> [^self positive64BitIntegerFor: statProcessSwitch].
[57] -> [^self positive64BitIntegerFor: statIOProcessEvents].
[58] -> [^self positive64BitIntegerFor: statForceInterruptCheck].
[59] -> [^self positive64BitIntegerFor: statCheckForEvents].
[60] -> [^self positive64BitIntegerFor: statStackOverflow].
[61] -> [^self positive64BitIntegerFor: statStackPageDivorce].
[62] -> [^self getCodeCompactionCount].
[63] -> [^self getCodeCompactionMSecs].
[64] -> [^self getCogMethodCount].
[65] -> [^self getCogVMFeatureFlags].
[66] -> [^objectMemory integerObjectOf: stackPages bytesPerPage].
[67] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[self positiveMachineIntegerFor: objectMemory maxOldSpaceSize]].
[68] -> [^objectMemory floatObjectOf: stackPages statAverageLivePagesWhenMapping].
[69] -> [^objectMemory integerObjectOf: stackPages statMaxPageCountWhenMapping].
[70] -> [^objectMemory integerObjectOf: self vmProxyMajorVersion].
[71] -> [^objectMemory integerObjectOf: self vmProxyMinorVersion].
[72] -> [^objectMemory integerObjectOf: objectMemory statMarkUsecs + 500 // 1000].
[73] -> [^objectMemory integerObjectOf: objectMemory statSweepUsecs + 500 // 1000].
[74] -> [^objectMemory hasSpurMemoryManagerAPI ifTrue:
[objectMemory integerObjectOf: objectMemory statMaxAllocSegmentTime + 500 // 1000]].
[75] -> [^objectMemory booleanObjectOf: self primitiveDoMixedArithmetic].
[76] -> [^objectMemory integerObjectOf: self minimumUnusedHeadroom] }
otherwise: [^nil]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveSetVMParameter:arg: (in category 'system control primitives') -----
primitiveSetVMParameter: index arg: argOop
"See primitiveVMParameter method comment"
| arg result |
"argOop read & checks; in most cases this is an integer parameter. Handle the exceptions."
index
caseOf: {
[17] -> [((objectMemory isFloatInstance: argOop)
or: [objectMemory isIntegerObject: argOop]) ifFalse:
[primFailCode := PrimErrBadArgument]].
[55] -> [((objectMemory isFloatInstance: argOop)
or: [objectMemory isIntegerObject: argOop]) ifFalse:
[primFailCode := PrimErrBadArgument]].
[68] -> [((objectMemory isFloatInstance: argOop)
or: [objectMemory isIntegerObject: argOop]) ifFalse:
[primFailCode := PrimErrBadArgument]].
[67] -> [arg := self positiveMachineIntegerValueOf: argOop].
[75] -> [arg := objectMemory booleanValueOf: argOop] }
otherwise: [arg := objectMemory integerValueOf: argOop].
self failed ifTrue:
[^self primitiveFailFor: PrimErrBadArgument].
"assume failure, then set success for handled indices"
self primitiveFailFor: PrimErrBadArgument.
index caseOf: {
[5] -> [objectMemory hasSpurMemoryManagerAPI ifFalse:
["Was:
result := allocationsBetweenGCs.
allocationsBetweenGCs := arg."
"Ignore for now, because old images won't start up otherwise.
See 45 for eden size setting."
result := objectMemory nilObject.
self initPrimCall]].
[6] -> [result := objectMemory integerObjectOf: objectMemory tenuringThreshold.
primFailCode := objectMemory tenuringThreshold: arg].
[12] -> [result := objectMemory integerObjectOf: eventTraceMask.
eventTraceMask := arg.
self initPrimCall].
[11] -> [arg >= 0 ifTrue:
[result := objectMemory integerObjectOf: objectMemory statTenures.
objectMemory statTenures: arg.
self initPrimCall]].
[17] -> [(SistaVM and: [self isCog]) ifTrue:
[result := objectMemory floatObjectOf: self getCogCodeZoneThreshold.
primFailCode := self setCogCodeZoneThreshold: (self noInlineLoadFloatOrIntFrom: argOop)]].
[23] -> [result := objectMemory integerObjectOf: extraVMMemory.
extraVMMemory := arg.
self initPrimCall].
[24] -> [arg > 0 ifTrue:
[result := objectMemory integerObjectOf: objectMemory shrinkThreshold.
objectMemory shrinkThreshold: arg.
self initPrimCall]].
[25] -> [arg > 0 ifTrue:
[result := objectMemory integerObjectOf: objectMemory growHeadroom.
objectMemory growHeadroom: arg.
self initPrimCall]].
[26] -> [arg >= 0 ifTrue: "0 turns off the heartbeat"
[result := objectMemory integerObjectOf: self ioHeartbeatMilliseconds.
self ioSetHeartbeatMilliseconds: arg.
self initPrimCall]].
[34] -> [(objectMemory hasSpurMemoryManagerAPI "was statAllocationCount; now statAllocatedBytes"
and: [arg >= 0]) ifTrue:
[result := objectMemory positive64BitIntegerFor: objectMemory currentAllocatedBytes.
objectMemory setCurrentAllocatedBytesTo: arg.
self initPrimCall]].
[43] -> [(arg between: 0 and: 65535) ifTrue:
[result := objectMemory integerObjectOf: desiredNumStackPages.
desiredNumStackPages := arg.
self initPrimCall]].
[45] -> [arg >= 0 ifTrue:
[result := objectMemory integerObjectOf: desiredEdenBytes.
desiredEdenBytes := arg.
self initPrimCall]].
[47] -> [(self isCog
and: [arg between: 0 and: self maxCogCodeSize]) ifTrue:
[result := objectMemory integerObjectOf: self getDesiredCogCodeSize.
self setDesiredCogCodeSize: arg.
self initPrimCall]].
[48] -> [arg >= 0 ifTrue:
[| oldPrimitiveDoMixedArithmetic |
oldPrimitiveDoMixedArithmetic := primitiveDoMixedArithmetic.
result := self getImageHeaderFlagsParameter.
self initPrimCall. "i.e. setImageHeaderFlags: can fail"
self setImageHeaderFlags: arg.
(primFailCode = 0
and: [oldPrimitiveDoMixedArithmetic ~= primitiveDoMixedArithmetic]) ifTrue:
[self flushMethodCache.
+ ^self flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
- self flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
"NOT REACHED (in CoInterpreter)"]]].
[49] -> [(arg between: 0 and: 65535) ifTrue:
[result := objectMemory integerObjectOf: self ioGetMaxExtSemTableSize.
self initPrimCall. "i.e. ioSetMaxExtSemTableSize: is allowed to fail"
self setMaxExtSemSizeTo: arg]].
+ [50] -> [(self isCog
+ and: [arg between: 0 and: 32767]) ifTrue:
+ [result := objectMemory integerObjectOf: self getMaxLiteralCountForCompile.
+ self setMaxLiteralCountForCompile: arg.
+ self initPrimCall.
+ ^self flushMethodsWithNumLiteralsAboveLimitAndContinueAnswering: result
+ "NOT REACHED (in CoInterpreter)"]].
[55] -> [objectMemory hasSpurMemoryManagerAPI ifTrue:
[result := objectMemory floatObjectOf: objectMemory getHeapGrowthToSizeGCRatio.
primFailCode := objectMemory setHeapGrowthToSizeGCRatio: (self noInlineLoadFloatOrIntFrom: argOop)]].
[67] -> [(arg >= 0
and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue:
[result := self positiveMachineIntegerFor: objectMemory maxOldSpaceSize.
primFailCode := objectMemory setMaxOldSpaceSize: arg]].
[68] -> [result := objectMemory floatObjectOf: stackPages statAverageLivePagesWhenMapping.
self initPrimCall. "i.e. statAverageLivePagesWhenMapping: is allowed to fail"
stackPages statAverageLivePagesWhenMapping: (self noInlineLoadFloatOrIntFrom: argOop)].
[69] -> [arg >= 0 ifTrue:
[result := objectMemory integerObjectOf: stackPages statMaxPageCountWhenMapping.
stackPages statMaxPageCountWhenMapping: arg.
self initPrimCall]].
[74] -> [(arg >= 0
and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue:
[result := objectMemory integerObjectOf: objectMemory statMaxAllocSegmentTime + 500 // 1000.
stackPages statMaxAllocSegmentTime: arg. "usually 0"
self initPrimCall]].
[75] -> [| mustFlush |
result := objectMemory booleanObjectOf: self primitiveDoMixedArithmetic.
self initPrimCall.
mustFlush := primitiveDoMixedArithmetic ~= arg.
primitiveDoMixedArithmetic := arg.
mustFlush ifTrue:
[self flushMethodCache.
+ ^self flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
- self flushMethodsWithMachineCodePrimitivesAndContinueAnswering: result
"NOT REACHED (in CoInterpreter)"]] }
otherwise: [].
self successful
ifTrue: [self methodReturnValue: result] "return old value"
ifFalse: [self primitiveFailFor: PrimErrInappropriate] "attempting to write a read-only or non-existent parameter"!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveVMParameter (in category 'system control primitives') -----
primitiveVMParameter
"Behaviour depends on argument count:
0 args: return an Array of VM parameter values;
1 arg: return the indicated VM parameter;
2 args: set the VM indicated parameter.
VM parameters are numbered as follows:
1 end (v3)/size(Spur) of old-space (0-based, read-only)
2 end (v3)/size(Spur) of young/new-space (read-only)
3 end (v3)/size(Spur) of heap (read-only)
4 nil (was allocationCount (read-only))
5 nil (was allocations between GCs (read-write)
6 survivor count tenuring threshold (read-write)
7 full GCs since startup (read-only)
8 total milliseconds in full GCs since startup (read-only)
9 incremental GCs (SqueakV3) or scavenges (Spur) since startup (read-only)
10 total milliseconds in incremental GCs (SqueakV3) or scavenges (Spur) since startup (read-only)
11 tenures of surving objects since startup or reset (read-write)
12-20 were specific to ikp's JITTER VM, now 12 16 open for use
13 if started, the start time in utc microseconds of the high-priority ticker
14 if started, the number of checkHighPriorityTickees calls
15 if started, the number of tickee calls from checkHighPriorityTickees
16 total microseconds at idle since start-up (if non-zero)
17 fraction of the code zone to use (Sista only; used to control code zone use to preserve sendAndBranchData on counter tripped callback)
18 total milliseconds in compaction phase of full GC since start-up (Spur only)
19 scavenge threshold, the effective size of eden. When eden fills to the threshold a scavenge is scheduled. Newer Spur VMs only.
20 utc microseconds at VM start-up (actually at time initialization, which precedes image load).
21 root/remembered table size (occupancy) (read-only)
22 root table overflows since startup (read-only)
23 bytes of extra memory to reserve for VM buffers, plugins, etc (stored in image file header).
24 memory threshold above which shrinking object memory (rw)
25 memory headroom when growing object memory (rw)
26 interruptChecksEveryNms - force an ioProcessEvents every N milliseconds (rw)
27 number of times mark loop iterated for current IGC/FGC (read-only) includes ALL marking
28 number of times sweep loop iterated for current IGC/FGC (read-only)
29 number of times make forward loop iterated for current IGC/FGC (read-only)
30 number of times compact move loop iterated for current IGC/FGC (read-only)
31 number of grow memory requests (read-only)
32 number of shrink memory requests (read-only)
33 number of root table entries used for current IGC/FGC (read-only)
34 Spur: bytes allocated in total since start-up or reset (read-write) (Used to be number of allocations done before current IGC/FGC (read-only))
35 number of survivor objects after current IGC/FGC (read-only)
36 millisecond clock when current IGC/FGC completed (read-only)
37 number of marked objects for Roots of the world, not including Root Table entries for current IGC/FGC (read-only)
38 milliseconds taken by current IGC (read-only)
39 Number of finalization signals for Weak Objects pending when current IGC/FGC completed (read-only)
40 BytesPerOop for this image
41 imageFormatVersion for the VM
42 number of stack pages in use
43 desired number of stack pages (stored in image file header, max 65535)
44 size of eden, in bytes
45 desired size of eden, in bytes (stored in image file header)
46 machine code zone size, in bytes (Cog only; otherwise nil)
47 desired machine code zone size (stored in image file header; Cog only; otherwise nil)
48 various header flags. See getImageHeaderFlags.
49 max size the image promises to grow the external semaphore table to (0 sets to default, which is 256 as of writing)
+ 50 max literal count for JIT compile (stored in image file header; Cog only; otherwise nil)
+ 51 nil; reserved for VM parameters that persist in the image (such as eden above)
- 50-51 nil; reserved for VM parameters that persist in the image (such as eden above)
52 root/remembered table capacity
53 number of segments (Spur only; otherwise nil)
54 total size of free old space (Spur only, otherwise nil)
55 ratio of growth and image size at or above which a GC will be performed post scavenge
56 number of process switches since startup (read-only)
57 number of ioProcessEvents calls since startup (read-only)
58 number of ForceInterruptCheck calls since startup (read-only)
59 number of check event calls since startup (read-only)
60 number of stack page overflows since startup (read-only)
61 number of stack page divorces since startup (read-only)
62 compiled code compactions since startup (read-only; Cog only; otherwise nil)
63 total milliseconds in compiled code compactions since startup (read-only; Cog only; otherwise nil)
64 the number of methods that currently have jitted machine-code
65 various VM feature flags; see getCogVMFeatureFlags
66 the byte size of a stack page
67 the max allowed size of old space (Spur only; nil otherwise; 0 implies no limit except that of the underlying platform)
68 the average number of live stack pages when scanned by GC (at scavenge/gc/become et al) (read-write)
69 the maximum number of live stack pages when scanned by GC (at scavenge/gc/become et al) (read-write)
70 the vmProxyMajorVersion (the interpreterProxy VM_MAJOR_VERSION)
71 the vmProxyMinorVersion (the interpreterProxy VM_MINOR_VERSION)
72 total milliseconds in full GCs Mark phase since startup (read-only)
73 total milliseconds in full GCs Sweep phase since startup (read-only, can be 0 depending on compactors)
74 maximum pause time due to segment allocation
75 whether the arithmetic primitives perform conversion in case of mixed SmallInteger/Float (true) or fail (false)
76 the minimum unused headroom in all stack pages; Cog VMs only
Note: Thanks to Ian Piumarta for this primitive."
| paramsArraySize index |
paramsArraySize := 76.
argumentCount = 0 ifTrue: [^self primitiveAllVMParameters: paramsArraySize].
argumentCount > 2 ifTrue: [^self primitiveFailFor: PrimErrBadNumArgs].
"index read & checks"
index := self stackValue: (argumentCount = 1 ifTrue: [0] ifFalse: [1]).
(objectMemory isIntegerObject: index) ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
index := objectMemory integerValueOf: index.
(index < 1 or: [index > paramsArraySize]) ifTrue: [^self primitiveFailFor: PrimErrBadIndex].
argumentCount = 1 ifTrue: "read VM parameter; written this way to avoid branch limits in V3 bytecode set"
+ [| result | "written thus to enable Slang inlining of primitiveGetVMParameter:"
- [| result |
result := self primitiveGetVMParameter: index.
^self methodReturnValue: (result ifNil: [objectMemory nilObject])].
"write a VM parameter"
self primitiveSetVMParameter: index arg: self stackTop!
Item was removed:
- ----- Method: ThreadedARM64AppleFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
- ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
- <var: #pointer type: #'void *'>
- <var: #argSpec type: #'unsigned int *'>
- <var: #calloutState type: #'CalloutState *'>
- <inline: #always>
- | availableRegisterSpace stackPartSize roundedSize |
- "Stage B, step B.4 -- composite type larger than 16 bytes copied to caller-allocated memory and replaced by pointer"
- self flag: #todo.
-
- "See IHI0055B_aapcs64.pdf sections 4.3.5 & 5.4.2 Stage C; we don't yet support HVA's"
- (self structIsHomogenousFloatArrayOfSize: structSize typeSpec: argSpec ofLength: argSpecSize)
- ifTrue:
- [availableRegisterSpace := (NumFloatRegArgs - calloutState floatRegisterIndex) * self wordSize.
- structSize <= availableRegisterSpace ifTrue: "Stage C, step C.2, all in floating-point registers (!!!!)"
- [self
- memcpy: (self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) to: #'void *')
- _: pointer
- _: structSize.
- "Round structSize up and divide by 8 ( NB: _not_ 4 !!)"
- calloutState floatRegisterIndex: calloutState floatRegisterIndex + (structSize + 7 bitShift: -3).
- ^0].
- "Stage C, step C.3"
- availableRegisterSpace := 0.
- calloutState floatRegisterIndex: 8]
-
- ifFalse:
- [availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * self wordSize].
- stackPartSize := structSize.
- availableRegisterSpace > 0 ifTrue:
- [structSize <= availableRegisterSpace ifTrue:"all in integer registers"
- [self
- memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: #'void *')
- _: pointer
- _: structSize.
- "Round structSize up and divide by 8 ( NB: _not_ 4 !!)"
- calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 7 bitShift: -3).
- ^0].
- "If no previous co-processor candidate arg has already been pushed on the stack, then split the struct between registers and stack.
- Otherwise push entire struct on stack."
- calloutState currentArg = calloutState argVector
- ifTrue:
- [stackPartSize := structSize - availableRegisterSpace.
- self
- memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *')
- _: pointer
- _: availableRegisterSpace]
- ifFalse:
- [availableRegisterSpace := 0].
- "Stage C, step C.11"
- calloutState integerRegisterIndex: NumIntRegArgs].
-
- stackPartSize > 0 ifTrue:
- [roundedSize := stackPartSize + 3 bitClear: 3.
- calloutState currentArg + roundedSize > calloutState limit ifTrue:
- [^FFIErrorCallFrameTooBig].
- self alignCurrentArgOf: calloutState to: 8.
- self memcpy: calloutState currentArg _: (self addressOf: ((self cCoerceSimple: pointer to: #'char *') at: availableRegisterSpace)) _: stackPartSize.
- calloutState currentArg: calloutState currentArg + roundedSize].
- ^0!
Item was changed:
----- Method: ThreadedARM64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
<var: #pointer type: #'void *'>
<var: #argSpec type: #'unsigned int *'>
<var: #calloutState type: #'CalloutState *'>
<inline: #always>
+ | availableRegisterSpace roundedSize |
+ "Stage B
+ B.1 If the argument type is a Composite Type whose size cannot be statically determined by both the caller
+ and the callee, the argument is copied to memory and the argument is replaced by a pointer to the copy.
+ (There are no such types in C/C++ but they exist in other languages or in language extensions).
+ B.2 If the argument type is an HFA or an HVA, then the argument is used unmodified.
+ B.3 If the argument type is a Composite Type that is larger than 16 bytes, then the argument is copied to
+ memory allocated by the caller and the argument is replaced by a pointer to the copy.
+ B.4 If the argument type is a Composite Type then the size of the argument is rounded up to the nearest
+ multiple of 8 bytes."
- | availableRegisterSpace stackPartSize roundedSize |
- "Stage B, step B.4 -- composite type larger than 16 bytes copied to caller-allocated memory and replaced by pointer"
- self flag: #todo.
+ "See IHI0055B_aapcs64.pdf sections 4.3.5 & 5.4.2 Stage C"
- "See IHI0055B_aapcs64.pdf sections 4.3.5 & 5.4.2 Stage C; we don't yet support HVA's"
(self structIsHomogenousFloatArrayOfSize: structSize typeSpec: argSpec ofLength: argSpecSize)
ifTrue:
[availableRegisterSpace := (NumFloatRegArgs - calloutState floatRegisterIndex) * self wordSize.
structSize <= availableRegisterSpace ifTrue: "Stage C, step C.2, all in floating-point registers (!!!!)"
[self
memcpy: (self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: calloutState floatRegisterIndex)) to: #'void *')
_: pointer
_: structSize.
"Round structSize up and divide by 8 ( NB: _not_ 4 !!)"
calloutState floatRegisterIndex: calloutState floatRegisterIndex + (structSize + 7 bitShift: -3).
^0].
"Stage C, step C.3"
availableRegisterSpace := 0.
calloutState floatRegisterIndex: 8]
ifFalse:
[availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * self wordSize].
+
+ "If it's small (16 bytes or less) and will fit in registers it is passed in registers, otherwise it is copied to memory.
+ If it is a Homogenous Short Vector (HVA) (up to 32 bytes long) and will fit it is passed in registers."
+ (structSize <= availableRegisterSpace "all in integer registers; we have no way of getting to SIMD registers"
+ and: [structSize <= 16
+ or: [self structIsHomogenousIntegerArrayOfSize: structSize typeSpec: argSpec ofLength: argSpecSize]]) ifTrue:
- stackPartSize := structSize.
- availableRegisterSpace > 0 ifTrue:
[structSize <= availableRegisterSpace ifTrue:"all in integer registers"
[self
memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: #'void *')
_: pointer
_: structSize.
"Round structSize up and divide by 8 ( NB: _not_ 4 !!)"
calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 7 bitShift: -3).
+ ^0]].
- ^0].
- "If no previous co-processor candidate arg has already been pushed on the stack, then split the struct between registers and stack.
- Otherwise push entire struct on stack."
- calloutState currentArg = calloutState argVector
- ifTrue:
- [stackPartSize := structSize - availableRegisterSpace.
- self
- memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *')
- _: pointer
- _: availableRegisterSpace]
- ifFalse:
- [availableRegisterSpace := 0].
- "Stage C, step C.11"
- calloutState integerRegisterIndex: NumIntRegArgs].
+ "If small and won't fit in registers, copy to the stack.
+ N.B. my (eem) reading of IHI0055B_aapcs64.pdf is that unlike the 32-bit PCS, aggregates are never split between memory and registers."
+ structSize <= 16 ifTrue:
+ [roundedSize := structSize + 7 bitClear: 7.
- stackPartSize > 0 ifTrue:
- [roundedSize := stackPartSize + 3 bitClear: 3.
calloutState currentArg + roundedSize > calloutState limit ifTrue:
[^FFIErrorCallFrameTooBig].
+ self alignCurrentArgOf: calloutState to: 8.
+ self memcpy: calloutState currentArg _: pointer _: structSize.
- self memcpy: calloutState currentArg _: (self addressOf: ((self cCoerceSimple: pointer to: #'char *') at: availableRegisterSpace)) _: stackPartSize.
calloutState currentArg: calloutState currentArg + roundedSize].
+
+ "If it is not small it is passed as a pointer. N.B. Spur guarantees only 8-byte alignment. IHI0055B_aapcs64.pdf is vague on the memory's alignment.
+ Arguably the memory should be pinned in case of a callback. Don't bother for now. eem 3/11/2023"
+ ^self ffiPushPointer: pointer in: calloutState!
- ^0!
Item was changed:
----- Method: ThreadedARM64FFIPlugin>>structIsHomogenousFloatArrayOfSize:typeSpec:ofLength: (in category 'marshalling') -----
structIsHomogenousFloatArrayOfSize: structSize typeSpec: argSpec ofLength: argSpecSize
+ "See IHI0055B_aapcs64.pdf
+ 4.3.5.1 Homogeneous Floating-point Aggregates (HFA)
+ An Homogeneous Floating-point Aggregate (HFA) is an Homogeneous Aggregate with a
+ Fundamental Data Type that is a Floating-Point type and at most four uniquely addressable members."
<var: #argSpec type: #'unsigned int *'>
| firstField typeOfFirstField |
(structSize <= (4 * (self sizeof: #double))
and: [argSpecSize <= 5]) "header plus up to four fields" ifFalse:
[^false].
typeOfFirstField := self atomicTypeOf: (firstField := argSpec at: 1).
(typeOfFirstField ~= FFITypeSingleFloat and: [typeOfFirstField ~= FFITypeDoubleFloat]) ifTrue:
[^false].
2 to: argSpecSize - 1 do:
[:idx|
firstField ~= (argSpec at: idx) ifTrue:
[^false]].
^true!
Item was added:
+ ----- Method: ThreadedARM64FFIPlugin>>structIsHomogenousIntegerArrayOfSize:typeSpec:ofLength: (in category 'marshalling') -----
+ structIsHomogenousIntegerArrayOfSize: structSize typeSpec: argSpec ofLength: argSpecSize
+ "See IHI0055B_aapcs64.pdf
+ 4.1.2 Short Vectors
+ A short vector is a machine type that is composed of repeated instances of one fundamental integral
+ or floating- point type. It may be 8 or 16 bytes in total size. A short vector has a base type that is the
+ fundamental integral or floating-point type from which it is composed, but its alignment is always the
+ same as its total size. The number of elements in the short vector is always such that the type is fully
+ packed. For example, an 8-byte short vector may contain 8 unsigned byte elements, 4 unsigned half-word
+ elements, 2 single-precision floating-point elements, or any other combination where the product of
+ the number of elements and the size of an individual element is equal to 8. Similarly, for 16-byte short
+ vectors the product of the number of elements and the size of the individual elements must be 16.
+
+ Elements in a short vector are numbered such that the lowest numbered element (element 0) occupies
+ the lowest numbered bit (bit zero) in the vector and successive elements take on progressively
+ increasing bit positions in the vector. When a short vector transferred between registers and memory
+ it is treated as an opaque object. That is a short vector is stored in memory as if it were stored with
+ a single STR of the entire register; a short vector is loaded from memory using the corresponding LDR
+ instruction. On a little-endian system this means that element 0 will always contain the lowest
+ addressed element of a short vector; on a big-endian system element 0 will contain the highest-addressed
+ element of a short vector.
+
+ A language binding may define extended types that map directly onto short vectors. Short vectors
+ are not otherwise created spontaneously (for example because a user has declared an aggregate
+ consisting of eight consecutive byte-sized objects)."
+ <var: #argSpec type: #'unsigned int *'>
+ | firstField typeOfFirstField sizeOfType |
+ structSize <= (4 * (self sizeof: #long)) ifFalse:
+ [^false].
+ typeOfFirstField := self atomicTypeOf: (firstField := argSpec at: 1).
+ (typeOfFirstField between: FFITypeUnsignedInt8 and: FFITypeSignedInt64) ifFalse:
+ [^false].
+ "N.B. This is as of pluginVersion: 1, c.f. initializeTypeConstants_v1.
+ pluginVersion: 2, c.f. initializeTypeConstants_v2 needs different code"
+ sizeOfType := 1 << (typeOfFirstField >> 1 - 1).
+ "{ FFITypeUnsignedInt8. FFITypeUnsignedInt16. FFITypeUnsignedInt32. FFITypeUnsignedInt64.
+ FFITypeSignedInt8. FFITypeSignedInt16. FFITypeSignedInt32. FFITypeSignedInt64} collect:
+ [:typeOfFirstField| 1 << (typeOfFirstField >> 1 - 1)]"
+ sizeOfType * argSpecSize > (4 * (self sizeof: #long)) ifTrue:
+ [^false].
+ 2 to: argSpecSize - 1 do:
+ [:idx|
+ firstField ~= (argSpec at: idx) ifTrue:
+ [^false]].
+ ^true!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
"Generic callout. Does the actual work. If argArrayOrNil is nil it takes args from the stack
and the spec from the method. If argArrayOrNil is not nil takes args from argArrayOrNil
and the spec from the receiver."
| flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result primNumArgs |
<inline: #always>
<var: #theCalloutState type: #'CalloutState'>
<var: #calloutState type: #'CalloutState *'>
<var: #allocation type: #'char *'>
primNumArgs := interpreterProxy methodArgumentCount.
(interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
[^self ffiFail: FFIErrorNotFunction].
"Load and check the values in the externalFunction before we call out"
flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
interpreterProxy failed ifTrue:
[^self ffiFail: FFIErrorBadArgs].
"This must come early for compatibility with the old FFIPlugin. Image-level code
may assume the function pointer is loaded eagerly. Thanks to Nicolas Cellier."
address := self ffiLoadCalloutAddress: externalFunction.
interpreterProxy failed ifTrue:
[^0 "error code already set by ffiLoadCalloutAddress:"].
argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
"must be array of arg types"
((interpreterProxy isArray: argTypeArray)
and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
[^self ffiFail: FFIErrorBadArgs].
"check if the calling convention is supported"
self cppIf: COGMTVM
ifTrue:
[(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse:
[^self ffiFail: FFIErrorCallType]]
ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded."
[(self ffiSupportsCallingConvention: flags) ifFalse:
[^self ffiFail: FFIErrorCallType]].
requiredStackSize := self externalFunctionHasStackSizeSlot
ifTrue: [interpreterProxy
fetchInteger: ExternalFunctionStackSizeIndex
ofObject: externalFunction]
ifFalse: [-1].
interpreterProxy failed ifTrue:
[^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
ifTrue: [PrimErrBadMethod]
ifFalse: [PrimErrBadReceiver])].
stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
calloutState := self addressOf: theCalloutState.
self cCode: [self memset: calloutState _: 0 _: (self sizeof: #CalloutState)].
calloutState callFlags: flags.
"Fetch return type and args"
argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
+ "Witten this way to allow Slang to inline ffiCheckReturn:With:in:"
+ err := self ffiCheckReturn: argSpec With: argClass in: calloutState.
+ err ~= 0 ifTrue:
- (err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
[^self ffiFail: err]. "cannot return"
"alloca the outgoing stack frame, leaving room for marshalling args, and including space for the return struct, if any.
Additional space reserved for saving register args like mandated by Win64 X64 or PPC ABI, will be managed by the call itself"
allocation := self alloca: stackSize + calloutState structReturnSize + self cStackAlignment.
self mustAlignStack ifTrue:
[allocation := self cCoerce: (allocation asUnsignedIntegerPtr bitClear: self cStackAlignment - 1) to: #'char *'].
calloutState
argVector: allocation;
currentArg: allocation;
limit: allocation + stackSize.
(self nonRegisterStructReturnIsViaImplicitFirstArgument
and: [calloutState structReturnSize > 0
and: [(self returnStructInRegisters: calloutState) not]]) ifTrue:
[err := self ffiPushPointer: calloutState limit in: calloutState.
err ~= 0 ifTrue:
[self cleanupCalloutState: calloutState.
self cppIf: COGMTVM ifTrue:
[err = PrimErrObjectMayMove negated ifTrue:
[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
^self ffiFail: err]].
1 to: nArgs do:
[:i|
argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
oop := argArrayOrNil
ifNil: [interpreterProxy stackValue: nArgs - i]
ifNotNil: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
err ~= 0 ifTrue:
[self cleanupCalloutState: calloutState.
self cppIf: COGMTVM ifTrue:
[err = PrimErrObjectMayMove negated ifTrue:
[^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
^self ffiFail: err]]. "coercion failed or out of stack space"
"Failures must be reported back from ffiArgument:Spec:Class:in:.
Should not fail from here on in."
self assert: interpreterProxy failed not.
self ffiLogCallout: externalFunction.
(requiredStackSize < 0
and: [self externalFunctionHasStackSizeSlot]) ifTrue:
[stackSize := calloutState currentArg - calloutState argVector.
interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
"Go out and call this guy"
result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
self cleanupCalloutState: calloutState.
"Can not safely use argumentCount (via e.g. methodReturnValue:) since it may have been changed by a callback."
interpreterProxy pop: primNumArgs + 1 thenPush: result.
^result!
Item was changed:
----- Method: ThreadedFFIPlugin>>ffiCheckReturn:With:in: (in category 'callout support') -----
ffiCheckReturn: retSpec With: retClass in: calloutState
<var: #calloutState type: #'CalloutState *'>
"Make sure we can return an object of the given type"
+ <inline: #always>
- <inline: true>
retClass = interpreterProxy nilObject ifFalse:
[(interpreterProxy
includesBehavior: retClass
ThatOf: interpreterProxy classExternalStructure) ifFalse:
[^FFIErrorBadReturn]].
((interpreterProxy isWords: retSpec)
and: [(interpreterProxy slotSizeOf: retSpec) > 0]) ifFalse:
[^FFIErrorWrongType].
calloutState ffiRetSpec: retSpec.
calloutState ffiRetHeader: (interpreterProxy fetchLong32: 0 ofObject: retSpec).
(self isAtomicType: calloutState ffiRetHeader) ifFalse:
[retClass = interpreterProxy nilObject ifTrue:
[^FFIErrorBadReturn]].
(calloutState ffiRetHeader bitAnd: (FFIFlagPointer bitOr: FFIFlagStructure)) = FFIFlagStructure ifTrue:
[calloutState structReturnSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask).
self encodeStructReturnTypeIn: calloutState].
^0!
More information about the Vm-dev
mailing list