[Vm-dev] VM Maker: VMMaker.oscog-eem.916.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Oct 31 19:06:11 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.916.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.916
Author: eem
Time: 31 October 2014, 12:03:13.052 pm
UUID: 79925bdf-769f-446f-8532-f04f0e2f11ae
Ancestors: VMMaker.oscog-eem.915
Spur:
Reimplement deriving the accessorDepth and retrying
primitives on primitive failure machinery. Always take
the primitive index from newMethod (setting newMethod
to a SmallInteger for primitiveDoPrimitiveWithArgs.
Have the Cogit always set primitiveFunctionPointer and
newMethod for the retry,
Add isNonInteger(Non)Immediate: and use it in several of
the integer conversion routines that were missing code
to exclude Character immediates, with fatal consequences.
With these changes the Pharo 4 test suite runs without
crashing on the latest Pharo Spur boot image.
=============== Diff against VMMaker.oscog-eem.915 ===============
Item was changed:
----- Method: CoInterpreter>>ceActivateFailingPrimitiveMethod: (in category 'enilopmarts') -----
ceActivateFailingPrimitiveMethod: aPrimitiveMethod
"An external call or FFI primitive has failed. Build the frame and
activate as appropriate. Enter either the interpreter or machine
code depending on whether aPrimitiveMethod has been or is still
cogged. Note that we could always interpret but want the efficiency
of executing machine code if it is available."
<api>
| methodHeader |
self assert: primFailCode ~= 0.
self assert: newMethod = aPrimitiveMethod.
"If we're on Spur, check for forwarders and retry,
returning if successful the second time around."
(objectMemory hasSpurMemoryManagerAPI
+ and: [self checkForAndFollowForwardedPrimitiveState]) ifTrue:
- and: [(objectMemory isOopCompiledMethod: newMethod)
- and: [self checkForAndFollowForwardedPrimitiveState]]) ifTrue:
[self initPrimCall.
self cCode: [self dispatchFunctionPointer: primitiveFunctionPointer]
inSmalltalk:
[| evaluable |
evaluable := primitiveFunctionPointer isInteger
ifTrue: [cogit simulatedTrampolines at: primitiveFunctionPointer]
ifFalse: [primitiveFunctionPointer].
evaluable isMessageSend
ifTrue: [self assert: evaluable receiver == self]
ifFalse: [self assert: evaluable isBlock].
evaluable value].
self successful ifTrue:
[^self]].
methodHeader := self rawHeaderOf: aPrimitiveMethod.
(self isCogMethodReference: methodHeader)
ifTrue: [self activateCoggedNewMethod: false]
ifFalse: [self activateNewMethod]!
Item was added:
+ ----- Method: CoInterpreter>>ceCheckForAndFollowForwardedPrimitiveState (in category 'cog jit support') -----
+ ceCheckForAndFollowForwardedPrimitiveState
+ "In Spur a primitive may fail due to encountering a forwarder.
+ On failure check the accessorDepth for the primitive and
+ if non-negative scan the args to the depth, following any
+ forwarders. Answer if any are found so the prim can be retried."
+ <api>
+ <option: #SpurObjectMemory>
+ ^self cCode: [self checkForAndFollowForwardedPrimitiveState]
+ inSmalltalk: [(self checkForAndFollowForwardedPrimitiveState)
+ ifTrue: [1]
+ ifFalse: [0]]!
Item was removed:
- ----- Method: CoInterpreter>>ceCheckForAndFollowForwardedPrimitiveStateFor: (in category 'cog jit support') -----
- ceCheckForAndFollowForwardedPrimitiveStateFor: primIndex
- "In Spur a primitive may fail due to encountering a forwarder.
- On failure check the accessorDepth for the primitive and
- if non-negative scan the args to the depth, following any
- forwarders. Answer if any are found so the prim can be retried."
- <api>
- <option: #SpurObjectMemory>
- ^self cCode: [self checkForAndFollowForwardedPrimitiveStateFor: primIndex]
- inSmalltalk: [(self checkForAndFollowForwardedPrimitiveStateFor: primIndex)
- ifTrue: [1]
- ifFalse: [0]]!
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlags: (in category 'cog jit support') -----
primitivePropertyFlags: primIndex
<api>
"Answer any special requirements of the given primitive"
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [^self primitivePropertyFlagsForSpur: primIndex]
+ ifFalse: [^self primitivePropertyFlagsForV3: primIndex]!
- | baseFlags functionPointer |
- <var: #functionPointer declareC: 'void (*functionPointer)(void)'>
- functionPointer := self functionPointerFor: primIndex inClass: nil.
-
- "The complications of following forwarding pointers in machine code on failures
- of primitives called indirectly through primitiveDoNamedPrimitiveWithArgs are not
- worth dealing with, as primitiveDoNamedPrimitiveWithArgs is used only in debugging."
- (objectMemory hasSpurMemoryManagerAPI
- and: [functionPointer = #primitiveDoNamedPrimitiveWithArgs]) ifTrue:
- [^PrimCallDoNotJIT].
-
- baseFlags := profileSemaphore ~= objectMemory nilObject
- ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
- ifFalse: [0].
-
- longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod].
-
- (functionPointer == #primitiveExternalCall
- or: [functionPointer == #primitiveCalloutToFFI]) ifTrue: "For callbacks"
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack.
- checkAllocFiller ifTrue:
- [baseFlags := baseFlags bitOr: CheckAllocationFillerAfterPrimCall]].
-
- ^baseFlags!
Item was added:
+ ----- Method: CoInterpreter>>primitivePropertyFlagsForSpur: (in category 'cog jit support') -----
+ primitivePropertyFlagsForSpur: primIndex
+ <inline: true>
+ "Answer any special requirements of the given primitive. Spur always needs to set
+ primitiveFunctionPointer and newMethod so primitives can retry on failure due to forwarders."
+ | baseFlags |
+ baseFlags := PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod.
+ profileSemaphore ~= objectMemory nilObject ifTrue:
+ [baseFlags := baseFlags bitOr: PrimCallCollectsProfileSamples].
+
+ self cCode: [] inSmalltalk: [#(primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
+ (primIndex == 117 "#primitiveExternalCall"
+ or: [primIndex == 120 "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
+ [baseFlags := baseFlags bitOr: PrimCallMayCallBack.
+ checkAllocFiller ifTrue:
+ [baseFlags := baseFlags bitOr: CheckAllocationFillerAfterPrimCall]].
+
+ ^baseFlags!
Item was added:
+ ----- Method: CoInterpreter>>primitivePropertyFlagsForV3: (in category 'cog jit support') -----
+ primitivePropertyFlagsForV3: primIndex
+ <inline: true>
+ "Answer any special requirements of the given primitive"
+ | baseFlags |
+ baseFlags := profileSemaphore ~= objectMemory nilObject
+ ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
+ ifFalse: [0].
+
+ longRunningPrimitiveCheckSemaphore ifNotNil:
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod].
+
+ self cCode: [] inSmalltalk: [#(primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
+ (primIndex == 117 "#primitiveExternalCall"
+ or: [primIndex == 120 "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack].
+
+ ^baseFlags!
Item was added:
+ ----- Method: CoInterpreter>>saneFunctionPointerForFailureOfPrimIndex: (in category 'primitive support') -----
+ saneFunctionPointerForFailureOfPrimIndex: primIndex
+ ^instructionPointer >= objectMemory nilObject asUnsignedInteger
+ ifTrue:
+ [super saneFunctionPointerForFailureOfPrimIndex: primIndex]
+ ifFalse:
+ [self
+ cCode:
+ [primitiveFunctionPointer = (self functionPointerFor: primIndex
+ inClass: objectMemory nilObject)]
+ inSmalltalk:
+ [(primitiveFunctionPointer isInteger
+ ifTrue:
+ [(cogit lookupAddress: primitiveFunctionPointer)
+ endsWith: (self functionPointerFor: primIndex
+ inClass: objectMemory nilObject)]
+ ifFalse:
+ [primitiveFunctionPointer = (self functionPointerFor: primIndex
+ inClass: objectMemory nilObject)])]]!
Item was changed:
----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') -----
markAndTraceInterpreterOops: fullGCFlag
"Mark and trace all oops in the interpreter's state."
"Assume: All traced variables contain valid oops.
N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
only during message lookup and because createActualMessageTo will not
cause a GC these cannot change during message lookup."
| oop |
<var: #vmThread type: #'CogVMThread *'>
"Must mark stack pages first to initialize the per-page trace
flags for full garbage collect before any subsequent tracing."
self markAndTraceStackPages: fullGCFlag.
self markAndTraceTraceLog.
self markAndTracePrimTraceLog.
objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
(objectMemory isImmediate: newMethod) ifFalse:
[objectMemory markAndTrace: newMethod].
self traceProfileState.
tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
+ tempOop2 = 0 ifFalse: [objectMemory markAndTrace: tempOop2].
1 to: objectMemory remapBufferCount do:
[:i|
oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop) ifFalse:
[objectMemory markAndTrace: oop]].
"Callback support - trace suspended callback list - will be made per-thread soon"
1 to: jmpDepth do:
[:i|
oop := suspendedCallbacks at: i.
(objectMemory isIntegerObject: oop) ifFalse:
[objectMemory markAndTrace: oop].
oop := suspendedMethods at: i.
(objectMemory isIntegerObject: oop) ifFalse:
[objectMemory markAndTrace: oop]].
"Per-thread state; trace each thread's own newMethod and stack of awol processes."
1 to: cogThreadManager getNumThreads do:
[:i| | vmThread |
vmThread := cogThreadManager vmThreadAt: i.
vmThread state notNil ifTrue:
[vmThread newMethodOrNull notNil ifTrue:
[objectMemory markAndTrace: vmThread newMethodOrNull].
0 to: vmThread awolProcIndex - 1 do:
[:j|
objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!
Item was added:
+ ----- Method: CogObjectRepresentation>>maybeCompileRetry:onPrimitiveFail:primPropertyFlags: (in category 'primitive generators') -----
+ maybeCompileRetry: retryInst onPrimitiveFail: primIndex primPropertyFlags: flags
+ <var: #retryInst type: #'AbstractInstruction *'>
+ "Object representations with lazy forwarding will want to check for
+ forwarding pointers on primitive failure and retry the primitive if found.
+ By default do nothing."!
Item was changed:
----- Method: CogObjectRepresentationForSpur>>maybeCompileRetry:onPrimitiveFail: (in category 'primitive generators') -----
maybeCompileRetry: retryInst onPrimitiveFail: primIndex
<var: #retryInst type: #'AbstractInstruction *'>
"If primIndex has an accessorDepth, check for primitive failure and call
+ ceCheckForAndFollowForwardedPrimitiveState if so If ceCheck.... answers
- ceCheckForAndFollowForwardedPrimitiveStateFor:. If ceCheck.... answers
true, retry the primitive."
+ | jmp |
- | accessorDepth jmp |
<var: #jmp type: #'AbstractInstruction *'>
+ (coInterpreter accessorDepthForPrimitiveIndex: primIndex) < 0 ifTrue:
- accessorDepth := coInterpreter accessorDepthForPrimitiveIndex: primIndex.
- accessorDepth < 0 ifTrue:
[^0].
cogit MoveAw: coInterpreter primFailCodeAddress R: TempReg.
cogit CmpCq: 0 R: TempReg.
jmp := cogit JumpZero: 0.
cogit
+ compileCallFor: #ceCheckForAndFollowForwardedPrimitiveState
+ numArgs: 0
- compileCallFor: #ceCheckForAndFollowForwardedPrimitiveStateFor:
- numArgs: 1
- arg: primIndex
arg: nil
arg: nil
arg: nil
+ arg: nil
resultReg: TempReg
saveRegs: false.
cogit CmpCq: 0 R: TempReg.
cogit JumpNonZero: retryInst.
jmp jmpTarget: cogit Label.
^0!
Item was changed:
----- Method: CogVMSimulator>>callExternalPrimitive: (in category 'plugin support') -----
callExternalPrimitive: mapIndex
| entry |
entry := self pluginEntryFor: mapIndex.
+ "Spur needs the primitiveFunctionPointer to be set correctly
+ for accurate following of forwarders on primitive failure."
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [primitiveFunctionPointer := entry at: 2].
^(entry at: 1) perform: (entry at: 2)!
Item was changed:
----- Method: InterpreterPrimitives>>isNegativeIntegerValueOf: (in category 'primitive support') -----
isNegativeIntegerValueOf: oop
"Answer true if integer object is negative.
Fail if object pointed by oop i not an integer."
| ok smallInt |
+ (objectMemory isIntegerObject: oop) ifTrue:
+ [smallInt := objectMemory integerValueOf: oop.
+ ^smallInt < 0].
+
+ (objectMemory isNonIntegerNonImmediate: oop) ifTrue:
+ [ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargePositiveInteger)
+ compactClassIndex: ClassLargePositiveIntegerCompactIndex.
+ ok ifTrue: [^false].
+
+ ok := objectMemory isClassOfNonImm: oop
+ equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
+ compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
+ ok ifTrue: [^true]].
- (objectMemory isIntegerObject: oop)
- ifTrue:
- [smallInt := objectMemory integerValueOf: oop.
- ^smallInt < 0].
-
- ok := objectMemory isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargePositiveInteger)
- compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- ok ifTrue: [^false].
-
- ok := objectMemory isClassOfNonImm: oop
- equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
- compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
- ok ifTrue: [^true].
self primitiveFail.
^false!
Item was changed:
----- Method: InterpreterPrimitives>>magnitude64BitValueOf: (in category 'primitive support') -----
magnitude64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or a eight-byte LargeInteger."
| sz value ok smallIntValue |
<returnTypeC: #usqLong>
<var: #value type: #usqLong>
(objectMemory isIntegerObject: oop) ifTrue:
[smallIntValue := (objectMemory integerValueOf: oop).
smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue].
^self cCoerce: smallIntValue to: #usqLong].
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [^self primitiveFail].
+
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifFalse:
[ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
sz := objectMemory lengthOf: oop.
sz > (self sizeof: #sqLong) ifTrue:
[^self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
^value!
Item was changed:
----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') -----
positive32BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or a four-byte LargePositiveInteger."
<returnTypeC: #usqInt>
| value ok |
+ (objectMemory isIntegerObject: oop) ifTrue:
+ [value := objectMemory integerValueOf: oop.
+ value < 0 ifTrue: [self primitiveFail. value := 0].
+ ^value].
- (objectMemory isIntegerObject: oop)
- ifTrue:
- [value := objectMemory integerValueOf: oop.
- value < 0 ifTrue: [self primitiveFail. value := 0].
- ^value]
- ifFalse:
- [(objectMemory hasSpurMemoryManagerAPI
- and: [objectMemory isImmediate: oop]) ifTrue:
- [self primitiveFail.
- ^0]].
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [self primitiveFail.
+ ^0].
+
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
(ok and: [(objectMemory lengthOf: oop) = 4]) ifFalse:
[self primitiveFail.
^0].
^(objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)!
Item was changed:
----- Method: InterpreterPrimitives>>positive64BitValueOf: (in category 'primitive support') -----
positive64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
<returnTypeC: #usqLong>
| sz value ok |
<var: #value type: #usqLong>
(objectMemory isIntegerObject: oop) ifTrue:
[(objectMemory integerValueOf: oop) < 0 ifTrue:
[^self primitiveFail].
^objectMemory integerValueOf: oop].
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [self primitiveFail.
+ ^0].
+
ok := objectMemory
isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
(ok and: [(sz := objectMemory lengthOf: oop) <= (self sizeof: #sqLong)]) ifFalse:
[^self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #usqLong) << (i*8))].
^value!
Item was changed:
----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') -----
positiveMachineIntegerValueOf: oop
"Answer a value of an integer in address range, i.e up to the size of a machine word.
The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size."
<returnTypeC: #'unsigned long'>
<inline: true> "only two callers & one is primitiveNewWithArg"
| value bs ok |
(objectMemory isIntegerObject: oop) ifTrue:
[value := objectMemory integerValueOf: oop.
value < 0 ifTrue: [^self primitiveFail].
^value].
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [^self primitiveFail].
+
ok := objectMemory
isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
(ok and: [(bs := objectMemory lengthOf: oop) <= (self sizeof: #'unsigned long')]) ifFalse:
[^self primitiveFail].
((self sizeof: #'unsigned long') = 8
and: [bs > 4]) ifTrue:
[^ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)].
^ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)!
Item was changed:
----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category 'primitive support') -----
signed32BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or a four-byte LargeInteger."
| value negative ok |
<inline: false>
<returnTypeC: #int>
<var: #value type: #int>
(objectMemory isIntegerObject: oop) ifTrue:
[^objectMemory integerValueOf: oop].
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [^self primitiveFail].
+
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifTrue: [negative := false]
ifFalse:
[negative := true.
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
(objectMemory lengthOf: oop) > 4 ifTrue:
[^self primitiveFail].
value := (objectMemory fetchByte: 0 ofObject: oop) +
((objectMemory fetchByte: 1 ofObject: oop) << 8) +
((objectMemory fetchByte: 2 ofObject: oop) << 16) +
((objectMemory fetchByte: 3 ofObject: oop) << 24).
self cCode: []
inSmalltalk:
[(value anyMask: 16r80000000) ifTrue:
[value := value - 16r100000000]].
"Filter out values out of range for the signed interpretation such as
16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit
32 set). Since the sign is implicit in the class we require that the high
bit of the magnitude is not set which is a simple test here. Note that
we have to handle the most negative 32-bit value -2147483648 specially."
value < 0 ifTrue:
[self assert: (self sizeof: value) == 4.
"Don't fail for -16r80000000/-2147483648
Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
(negative and: [0 = (self cCode: [value << 1]
inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue:
[^value].
^self primitiveFail].
^negative
ifTrue: [0 - value]
ifFalse: [value]!
Item was changed:
----- Method: InterpreterPrimitives>>signed64BitValueOf: (in category 'primitive support') -----
signed64BitValueOf: oop
"Convert the given object into an integer value.
The object may be either a positive SmallInteger or a eight-byte LargeInteger."
| sz value negative ok |
<inline: false>
<returnTypeC: #sqLong>
<var: #value type: #sqLong>
(objectMemory isIntegerObject: oop) ifTrue:
[^self cCoerce: (objectMemory integerValueOf: oop) to: #sqLong].
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [^self primitiveFail].
+
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifTrue: [negative := false]
ifFalse:
[negative := true.
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
sz := objectMemory lengthOf: oop.
sz > (self sizeof: #sqLong) ifTrue:
[^self primitiveFail].
value := 0.
0 to: sz - 1 do: [:i |
value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
"Filter out values out of range for the signed interpretation such as
16rFFFFFFFF... (positive w/ bit 64 set) and -16rFFFFFFFF... (negative w/ bit
64 set). Since the sign is implicit in the class we require that the high bit of
the magnitude is not set which is a simple test here. Note that we have to
handle the most negative 64-bit value -9223372036854775808 specially."
self cCode: []
inSmalltalk:
[(value anyMask: 16r8000000000000000) ifTrue:
[value := value - 16r10000000000000000]].
value < 0 ifTrue:
[self cCode:
[self assert: (self sizeof: value) == 8.
self assert: (self sizeof: value << 1) == 8].
"Don't fail for -9223372036854775808/-16r8000000000000000.
Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
(negative and: [0 = (self cCode: [value << 1]
inSmalltalk: [value << 1 bitAnd: (1 << 64) - 1])]) ifTrue:
[^value].
^self primitiveFail].
^negative
ifTrue:[0 - value]
ifFalse:[value]!
Item was changed:
----- Method: InterpreterPrimitives>>signedMachineIntegerValueOf: (in category 'primitive support') -----
signedMachineIntegerValueOf: oop
"Answer a signed value of an integer up to the size of a machine word.
The object may be either a positive SmallInteger or a LargeInteger of size <= word size."
<returnTypeC: #'long'>
| negative ok bs value bits |
<var: #value type: #long>
(objectMemory isIntegerObject: oop) ifTrue:
[^objectMemory integerValueOf: oop].
+ (objectMemory isNonIntegerImmediate: oop) ifTrue:
+ [^self primitiveFail].
+
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargePositiveInteger)
compactClassIndex: ClassLargePositiveIntegerCompactIndex.
ok
ifTrue: [negative := false]
ifFalse:
[negative := true.
ok := objectMemory isClassOfNonImm: oop
equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse: [^self primitiveFail]].
(bs := objectMemory lengthOf: oop) > (self sizeof: #'unsigned long') ifTrue:
[^self primitiveFail].
((self sizeof: #'unsigned long') = 8
and: [bs > 4])
ifTrue:
[value := (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
ifFalse:
[value := (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)].
self cCode: []
inSmalltalk:
[bits := (self sizeof: #long) * 8.
(value bitShift: 1 - bits) > 0 ifTrue:
[value := value - (1 bitShift: bits)]].
value < 0 ifTrue:
["Don't fail for -16r80000000[00000000].
Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer
overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined."
(negative and: [0 = (self cCode: [value << 1]
inSmalltalk: [value << 1 bitAnd: (1 << bits) - 1])]) ifTrue:
[^value].
^self primitiveFail].
^negative
ifTrue: [0 - value]
ifFalse: [value]!
Item was added:
+ ----- Method: ObjectMemory>>isNonIntegerImmediate: (in category 'interpreter access') -----
+ isNonIntegerImmediate: oop
+ "ObjectMemory only has integer immedates"
+ <inline: true>
+ ^false!
Item was added:
+ ----- Method: ObjectMemory>>isNonIntegerNonImmediate: (in category 'interpreter access') -----
+ isNonIntegerNonImmediate: oop
+ "ObjectMemory only has integer immedates"
+ <inline: true>
+ ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>isNonIntegerImmediate: (in category 'object testing') -----
+ isNonIntegerImmediate: oop
+ <inline: true>
+ ^self isImmediate: oop!
Item was added:
+ ----- Method: SpurMemoryManager>>isNonIntegerNonImmediate: (in category 'object testing') -----
+ isNonIntegerNonImmediate: oop
+ <inline: true>
+ ^self isNonImmediate: oop!
Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
+ instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
- instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
classVariableNames: 'AltBytecodeEncoderClassName AltLongStoreBytecode AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached'
poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
category: 'VMMaker-Interpreter'!
!StackInterpreter commentStamp: 'eem 9/11/2013 18:30' prior: 0!
This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. This VM supports Closures but *not* old-style BlockContexts.
It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
The VM does not use Contexts directly. Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image. There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up. The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations. A send establishes a new frame in the current stack page, a return returns to the previous frame. This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return. Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together). Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died). A married context is specially marked (more details in the code) and refers to its frame. Likewise a married frame is specially marked and refers to its context.
In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
1. There are a number of things that should be done the next time we plan to release a completely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item).
2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the SystemTracer. A better solution would be to reserve one of the format codes for Contexts only. An even better solution is to eliminate compact classes altogether (see 6.).
3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. [Late news, the support has been extended to 64-bit file sizes].
4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache.
5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT. We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger.
6. If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images. [Late breaking news, the 2-word header scheme is more compact, by over 2%]. See SpurMemorymanager's class comment.!
Item was changed:
----- Method: StackInterpreter>>callExternalPrimitive: (in category 'plugin primitive support') -----
callExternalPrimitive: functionID
"Call the external plugin function identified. In the VM this is an address;
see StackInterpreterSimulator for its version."
<var: #functionID declareC: 'void (*functionID)()'>
+ "Spur needs the primitiveFunctionPointer to be set correctly
+ for accurate following of forwarders on primitive failure."
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [primitiveFunctionPointer := functionID].
self dispatchFunctionPointer: functionID.
self maybeFailForLastObjectOverwrite.!
Item was changed:
----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
checkForAndFollowForwardedPrimitiveState
+ "In Spur a primitive may fail due to encountering a forwarder. On failure,
+ check the accessorDepth for the primitive and if non-negative scan the
+ args to the depth, following any forwarders. Answer if any are found so
+ the prim can be retried. The primitive index is derived from newMethod.
+ If the primitive is 118, then primitiveDoPrimitiveWithArgs sets newMethod
+ to a SmallInteger whose value is the primitive it is evaluating."
- "In Spur a primitive may fail due to encountering a forwarder.
- On failure check the accessorDepth for the primitive and
- if non-negative scan the args to the depth, following any
- forwarders. Answer if any are found so the prim can be retried."
<option: #SpurObjectMemory>
+ | primIndex accessorDepth found |
+ self assert: self failed.
+ found := false.
+ primIndex := (objectMemory isIntegerObject: newMethod)
+ ifTrue: [objectMemory integerValueOf: newMethod]
+ ifFalse:
+ [self assert: argumentCount = (self argumentCountOf: newMethod).
+ self primitiveIndexOf: newMethod].
+ accessorDepth := primitiveAccessorDepthTable at: primIndex.
+ "For the method-executing primitives, failure could have been in those primitives or the
+ primitives of the methods they execute. Find out which failed by seeing what is in effect."
+ ((primIndex = 117 and: [primitiveFunctionPointer ~~ #primitiveExternalCall])
+ or: [primIndex = 218 and: [primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs]])
+ ifTrue:
+ [accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]
+ ifFalse:
+ [self assert: (self saneFunctionPointerForFailureOfPrimIndex: primIndex)].
+ accessorDepth >= 0 ifTrue:
+ [0 to: argumentCount do:
+ [:index| | oop |
+ oop := self stackValue: index.
+ (objectMemory isNonImmediate: oop) ifTrue:
+ [(objectMemory isForwarded: oop) ifTrue:
+ [self assert: index < argumentCount. "receiver should have been caught at send time."
+ found := true.
+ oop := objectMemory followForwarded: oop.
+ self stackValue: index put: oop].
+ ((objectMemory hasPointerFields: oop)
+ and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
+ [found := true]]]].
+ ^found!
- ^self checkForAndFollowForwardedPrimitiveStateFor: (self primitiveIndexOf: newMethod)!
Item was removed:
- ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveStateFor: (in category 'primitive support') -----
- checkForAndFollowForwardedPrimitiveStateFor: primIndex
- "In Spur a primitive may fail due to encountering a forwarder.
- On failure check the accessorDepth for the primitive and
- if non-negative scan the args to the depth, following any
- forwarders. Answer if any are found so the prim can be retried."
- <option: #SpurObjectMemory>
- | accessorDepth found |
- self assert: self successful not.
- found := false.
- accessorDepth := primitiveAccessorDepthTable at: primIndex.
- "For the method-executing primitives, failure could have been in those primitives or the
- primitives of the methods they execute. find out which failed by seeing what is in effect."
- primIndex caseOf: {
- [117] ->
- [primitiveFunctionPointer ~~ #primitiveExternalCall ifTrue:
- [accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
- self assert: argumentCount = (self argumentCountOf: newMethod)].
- [118] -> "with tryPrimitive:withArgs: the argument count has nothing to do with newMethod's, so no arg count assert."
- [self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)].
- [218] ->
- [primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs ifTrue:
- [accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod].
- self assert: argumentCount = (self argumentCountOf: newMethod)]. }
- otherwise:
- ["functionPointer should have been set, unless we're in machine code"
- instructionPointer > objectMemory nilObject ifTrue:
- [self assert: primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject).
- self assert: argumentCount = (self argumentCountOf: newMethod)]].
- accessorDepth >= 0 ifTrue:
- [0 to: argumentCount do:
- [:index| | oop |
- oop := self stackValue: index.
- (objectMemory isNonImmediate: oop) ifTrue:
- [(objectMemory isForwarded: oop) ifTrue:
- [self assert: index < argumentCount. "receiver should have been caught at send time."
- found := true.
- oop := objectMemory followForwarded: oop.
- self stackValue: index put: oop].
- ((objectMemory hasPointerFields: oop)
- and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
- [found := true]]]].
- ^found!
Item was changed:
----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
checkInterpreterIntegrity
"Perform an integrity/leak check using the heapMap. Assume
clearLeakMapAndMapAccessibleObjects has set a bit at each
object's header. Check that all oops in the interpreter's state
points to a header. Answer if all checks pass."
| ok |
ok := true.
(objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop')ifFalse:
[ok := false].
"No longer check messageSelector; it is ephemeral, not living beyond message lookup.
(objectMemory isNonImmediate: messageSelector) ifTrue:
[(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
[ok := false]]."
(objectMemory checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
[ok := false].
"No longer check lkupClass; it is ephemeral, not living beyond message lookup.
(objectMemory checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
[ok := false]."
(objectMemory checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
[ok := false].
tempOop = 0 ifFalse:
[(objectMemory checkOopIntegrity: tempOop named: 'tempOop')ifFalse:
[ok := false]].
+ tempOop2 = 0 ifFalse:
+ [(objectMemory checkOopIntegrity: tempOop2 named: 'tempOop2')ifFalse:
+ [ok := false]].
"Callback support - check suspended callback list"
1 to: jmpDepth do:
[:i|
(objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
[ok := false].
(objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
[ok := false]].
self checkLogIntegrity ifFalse:
[ok := false].
^ok!
Item was changed:
----- Method: StackInterpreter>>checkOkayInterpreterObjects: (in category 'debug support') -----
checkOkayInterpreterObjects: writeBack
<api>
| ok oopOrZero oop |
ok := true.
ok := ok & (self checkOkayFields: objectMemory nilObject).
ok := ok & (self checkOkayFields: objectMemory falseObject).
ok := ok & (self checkOkayFields: objectMemory trueObject).
ok := ok & (self checkOkayFields: objectMemory specialObjectsOop).
ok := ok & (self checkOkayFields: messageSelector).
ok := ok & (self checkOkayFields: newMethod).
ok := ok & (self checkOkayFields: lkupClass).
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do:
[ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse:
[ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheSelector)).
objectMemory hasSpurMemoryManagerAPI ifFalse:
[ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheClass))].
ok := ok & (self checkOkayFields: (methodCache at: i + MethodCacheMethod))]].
1 to: objectMemory remapBufferCount do:
[ :i |
oop := objectMemory remapBuffer at: i.
+ (objectMemory isImmediate: oop) ifFalse:
- (objectMemory isIntegerObject: oop) ifFalse:
[ok := ok & (self checkOkayFields: oop)]].
ok := ok & (self checkOkayStackZone: writeBack).
^ok!
Item was changed:
----- Method: StackInterpreter>>initialize (in category 'initialization') -----
initialize
"Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
checkAllocFiller := false. "must preceed initializeObjectMemory:"
primFailCode := 0.
stackLimit := 0. "This is also the initialization flag for the stack system."
stackPage := overflowedPage := 0.
extraFramesToMoveOnOverflow := 0.
bytecodeSetSelector := 0.
highestRunnableProcessPriority := 0.
nextProfileTick := 0.
nextPollUsecs := 0.
nextWakeupUsecs := 0.
+ tempOop := tempOop2 := theUnknownShort := 0.
- tempOop := theUnknownShort := 0.
interruptPending := false.
inIOProcessEvents := 0.
fullScreenFlag := 0.
deferDisplayUpdates := false.
pendingFinalizationSignals := statPendingFinalizationSignals := 0.
globalSessionID := 0.
jmpDepth := 0.
longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
maxExtSemTabSizeSet := false.
statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0!
Item was changed:
----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
mapInterpreterOops
"Map all oops in the interpreter's state to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops."
<inline: false>
self mapStackPages.
self mapMachineCode: self getGCMode.
self mapTraceLogs.
self mapVMRegisters.
self mapProfileState.
self remapCallbackState.
(tempOop ~= 0
and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
+ [tempOop := objectMemory remapObj: tempOop].
+ (tempOop2 ~= 0
+ and: [objectMemory shouldRemapOop: tempOop2]) ifTrue:
+ [tempOop2 := objectMemory remapObj: tempOop2]!
- [tempOop := objectMemory remapObj: tempOop]!
Item was changed:
----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
markAndTraceInterpreterOops: fullGCFlag
"Mark and trace all oops in the interpreter's state."
"Assume: All traced variables contain valid oops.
N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
only during message lookup and because createActualMessageTo will not
cause a GC these cannot change during message lookup."
| oop |
"Must mark stack pages first to initialize the per-page trace
flags for full garbage collect before any subsequent tracing."
self markAndTraceStackPages: fullGCFlag.
self markAndTraceTraceLog.
self markAndTracePrimTraceLog.
objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
(objectMemory isImmediate: newMethod) ifFalse:
[objectMemory markAndTrace: newMethod].
self traceProfileState.
tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
+ tempOop2 = 0 ifFalse: [objectMemory markAndTrace: tempOop2].
1 to: objectMemory remapBufferCount do: [:i |
oop := objectMemory remapBuffer at: i.
(objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
"Callback support - trace suspended callback list"
1 to: jmpDepth do:[:i|
oop := suspendedCallbacks at: i.
(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
oop := suspendedMethods at: i.
(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
]!
Item was added:
+ ----- Method: StackInterpreter>>maybeRetryFailureDueToForwarding (in category 'primitive support') -----
+ maybeRetryFailureDueToForwarding
+ "In Spur a primitive may fail due to encountering a forwarder. On failure, check
+ the accessorDepth for the primitive and if non-negative scan the args to the
+ depth, following any forwarders. Retry the primitive if any are found."
+ <inline: true>
+ (objectMemory hasSpurMemoryManagerAPI
+ and: [self failed
+ and: [self checkForAndFollowForwardedPrimitiveState]]) ifTrue:
+ [self initPrimCall.
+ self dispatchFunctionPointer: primitiveFunctionPointer]!
Item was changed:
----- Method: StackInterpreter>>objectArg: (in category 'plugin primitive support') -----
objectArg: index
"Like #stackObjectValue: but access method arguments left-to-right"
| oop |
oop := self methodArg: index.
oop = 0 ifTrue:[^0]. "methodArg: failed"
+ (objectMemory isImmediate: oop) ifTrue: [self primitiveFail. ^ nil].
- (objectMemory isIntegerObject: oop) ifTrue: [self primitiveFail. ^ nil].
^oop!
Item was changed:
----- Method: StackInterpreter>>okayInterpreterObjects (in category 'debug support') -----
okayInterpreterObjects
| oopOrZero oop |
self okayFields: objectMemory nilObject.
self okayFields: objectMemory falseObject.
self okayFields: objectMemory trueObject.
self okayFields: objectMemory specialObjectsOop.
self okayFields: messageSelector.
self okayFields: newMethod.
self okayFields: lkupClass.
0 to: MethodCacheEntries - 1 by: MethodCacheEntrySize do: [ :i |
oopOrZero := methodCache at: i + MethodCacheSelector.
oopOrZero = 0 ifFalse: [
self okayFields: (methodCache at: i + MethodCacheSelector).
self okayFields: (methodCache at: i + MethodCacheClass).
self okayFields: (methodCache at: i + MethodCacheMethod).
].
].
1 to: objectMemory remapBufferCount do: [ :i |
oop := objectMemory remapBuffer at: i.
+ (objectMemory isImmediate: oop) ifFalse: [
- (objectMemory isIntegerObject: oop) ifFalse: [
self okayFields: oop.
].
].
self okayStackZone.!
Item was added:
+ ----- Method: StackInterpreter>>saneFunctionPointerForFailureOfPrimIndex: (in category 'primitive support') -----
+ saneFunctionPointerForFailureOfPrimIndex: primIndex
+ ^primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)!
Item was changed:
----- Method: StackInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
slowPrimitiveResponse
"Invoke a normal (non-quick) primitive.
Called under the assumption that primFunctionPointer has been preloaded."
| nArgs savedFramePointer savedStackPointer |
<inline: true>
<asmLabel: false>
<var: #savedFramePointer type: #'char *'>
<var: #savedStackPointer type: #'char *'>
self assert: (objectMemory isOopForwarded: (self stackValue: argumentCount)) not.
+ self assert: objectMemory remapBufferCount = 0.
FailImbalancedPrimitives ifTrue:
[nArgs := argumentCount.
savedStackPointer := stackPointer.
savedFramePointer := framePointer].
self initPrimCall.
self dispatchFunctionPointer: primitiveFunctionPointer.
+ self maybeRetryFailureDueToForwarding.
- "In Spur a primitive may fail due to encountering a forwarder.
- On failure check the accessorDepth for the primitive and
- if non-negative scan the args to the depth, following any
- forwarders. Retry the primitive if any are found."
- objectMemory hasSpurMemoryManagerAPI
- ifTrue:
- [(self successful not
- and: [(objectMemory isOopCompiledMethod: newMethod)
- and: [self checkForAndFollowForwardedPrimitiveState]]) ifTrue:
- [self initPrimCall.
- self dispatchFunctionPointer: primitiveFunctionPointer]]
- ifFalse:
- [self assert: objectMemory remapBufferCount = 0].
self maybeFailForLastObjectOverwrite.
(FailImbalancedPrimitives
and: [self successful
and: [framePointer = savedFramePointer
and: [(self isMachineCodeFrame: framePointer) not]]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
[stackPointer ~= (savedStackPointer + (nArgs * BytesPerWord)) ifTrue:
[self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
"This is necessary but insufficient; the result may still have been written to the stack.
At least we'll know something is wrong."
stackPointer := savedStackPointer.
self failUnbalancedPrimitive]].
"If we are profiling, take accurate primitive measures"
nextProfileTick > 0 ifTrue:
[self checkProfileTick: newMethod].
^self successful!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
primitiveDoNamedPrimitiveWithArgs
"Simulate an primitiveExternalCall invocation (e.g. for the Debugger). Do not cache anything.
e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
| argumentArray arraySize methodArg methodHeader
moduleName functionName moduleLength functionLength
+ spec addr primRcvr isArray |
- spec addr primRcvr ctxtRcvr isArray |
<var: #addr declareC: 'void (*addr)()'>
argumentArray := self stackTop.
methodArg := self stackValue: 2.
((objectMemory isArray: argumentArray)
and: [objectMemory isOopCompiledMethod: methodArg]) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
arraySize := objectMemory numSlotsOf: argumentArray.
(self roomToPushNArgs: arraySize) ifFalse:
[^self primitiveFailFor: -2]. "invalid args"
methodHeader := objectMemory methodHeaderOf: methodArg.
(objectMemory literalCountOfMethodHeader: methodHeader) > 2 ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
isArray := self isInstanceOfClassArray: spec.
(isArray
and: [(objectMemory lengthOf: spec) = 4
and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = 117]]) ifFalse:
[^self primitiveFailFor: -3]. "invalid methodArg state"
(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: spec.
moduleName = objectMemory nilObject
ifTrue: [moduleLength := 0]
ifFalse: [self success: (objectMemory isBytes: moduleName).
moduleLength := objectMemory lengthOf: moduleName.
self cCode: '' inSmalltalk:
[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
ifTrue: [moduleLength := 0 "Cause all of these to fail"]]].
functionName := objectMemory fetchPointer: 1 ofObject: spec.
self success: (objectMemory isBytes: functionName).
functionLength := objectMemory lengthOf: functionName.
self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
OfLength: functionLength
FromModule: moduleName + BaseHeaderSize
OfLength: moduleLength.
addr = 0 ifTrue:
[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
"Cannot fail this primitive from now on. Can only fail the external primitive."
+ tempOop := objectMemory
+ eeInstantiateClassIndex: ClassArrayCompactIndex
+ format: objectMemory arrayFormat
+ numSlots: (objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [5]
+ ifFalse: [4]).
+ objectMemory
+ storePointerUnchecked: 0 ofObject: tempOop withValue: (argumentArray := self popStack);
+ storePointerUnchecked: 1 ofObject: tempOop withValue: (primRcvr := self popStack);
+ storePointerUnchecked: 2 ofObject: tempOop withValue: self popStack; "the method"
+ storePointerUnchecked: 3 ofObject: tempOop withValue: self popStack. "the context receiver"
- objectMemory pushRemappableOop: (argumentArray := self popStack).
- objectMemory pushRemappableOop: (primRcvr := self popStack).
- objectMemory pushRemappableOop: self popStack. "the method"
- objectMemory pushRemappableOop: self popStack. "the context receiver"
self push: primRcvr. "replace context receiver with actual receiver"
argumentCount := arraySize.
1 to: arraySize do:
[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [objectMemory storePointerUnchecked: 4 ofObject: tempOop withValue: newMethod.
+ newMethod := methodArg.
+ self callExternalPrimitive: addr. "On Spur, sets primitiveFunctionPointer"
+ self maybeRetryFailureDueToForwarding.
+ newMethod := objectMemory fetchPointer: 4 ofObject: tempOop]
+ ifFalse:
+ [self callExternalPrimitive: addr].
- self callExternalPrimitive: addr.
- ctxtRcvr := objectMemory popRemappableOop.
- methodArg := objectMemory popRemappableOop.
- primRcvr := objectMemory popRemappableOop.
- argumentArray := objectMemory popRemappableOop.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize + 1.
+ self push: (objectMemory fetchPointer: 3 ofObject: tempOop).
+ self push: (objectMemory fetchPointer: 2 ofObject: tempOop).
+ self push: (objectMemory fetchPointer: 1 ofObject: tempOop).
+ self push: (objectMemory fetchPointer: 0 ofObject: tempOop).
- self push: ctxtRcvr.
- self push: methodArg.
- self push: primRcvr.
- self push: argumentArray.
argumentCount := 3.
"Hack. A nil prim error code (primErrorCode = 1) is interpreted by the image
as meaning this primitive is not implemented. So to pass back nil as an error
code we use -1 to indicate generic failure."
primFailCode = 1 ifTrue:
[primFailCode := -1]]!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
primitiveDoPrimitiveWithArgs
| argumentArray arraySize index primIdx |
argumentArray := self stackTop.
(objectMemory isArray: argumentArray) ifFalse: [^self primitiveFail].
arraySize := objectMemory numSlotsOf: argumentArray.
self success: (self roomToPushNArgs: arraySize).
primIdx := self stackIntegerValue: 1.
self successful ifFalse: [^self primitiveFail]. "invalid args"
primitiveFunctionPointer := self functionPointerFor: primIdx inClass: nil.
primitiveFunctionPointer = 0 ifTrue:
+ [primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs.
+ ^self primitiveFail].
- [^self primitiveFail].
"Pop primIndex and argArray, then push args in place..."
self pop: 2.
argumentCount := arraySize.
index := 1.
[index <= argumentCount] whileTrue:
[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
index := index + 1].
self isPrimitiveFunctionPointerAnIndex ifTrue:
[self externalQuickPrimitiveResponse.
^nil].
"We use tempOop instead of pushRemappableOop:/popRemappableOop here because in
the Cogit primitiveEnterCriticalSection, primitiveSignal, primitiveResume et al longjmp back
to either the interpreter or machine code, depending on the process activated. So if we're
executing one of these primitives control won't actually return here and the matching
popRemappableOop: wouldn't occur, potentially overflowing the remap buffer. While recursion
could occur (nil tryPrimitive: 118 withArgs: #(111 #())) it counts as shooting oneself in the foot."
tempOop := argumentArray. "prim might alloc/gc"
"Run the primitive (sets primFailCode)"
+
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [tempOop2 := newMethod.
+ newMethod := objectMemory integerObjectOf: primIdx.
+ self slowPrimitiveResponse.
+ newMethod := tempOop2.
+ tempOop2 := 0]
+ ifFalse:
+ [self slowPrimitiveResponse].
- self slowPrimitiveResponse.
self successful ifFalse: "If primitive failed, then restore state for failure code"
[self pop: arraySize.
self pushInteger: primIdx.
self push: tempOop.
+ primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs.
argumentCount := 2].
tempOop := 0!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
primitiveExternalCall
"Call an external primitive. External primitive methods first literals are an array of
* The module name (String | Symbol)
* The function name (String | Symbol)
* The session ID (SmallInteger) [OBSOLETE] (or in Spur, the accessorDepth)
* The function index (Integer) in the externalPrimitiveTable
For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
in the method cache is rewritten, either to the function itself, or to zero if the external
function is not found. This allows for fast responses as long as the method stays in
the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
addNewMethodToCache:.
Now that the VM flushes function addresses from its tables, the session ID is obsolete,
but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
method has been looked up and not been found, the function address is stored as -1
(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
lookup), and the primitive fails with PrimErrNotFound."
| lit addr moduleName functionName moduleLength functionLength accessorDepth index |
<var: #addr declareC: 'void (*addr)()'>
"Fetch the first literal of the method"
(objectMemory literalCountOf: newMethod) > 0 ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
lit := self literal: 0 ofMethod: newMethod.
"Check if it's an array of length 4"
((objectMemory isArray: lit) and: [(objectMemory lengthOf: lit) = 4]) ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
"Look at the function index in case it has been loaded before"
index := objectMemory fetchPointer: 3 ofObject: lit.
(objectMemory isIntegerObject: index) ifFalse:
[^self primitiveFailFor: PrimErrBadMethod].
index := objectMemory integerValueOf: index.
"Check if we have already looked up the function and failed."
index < 0 ifTrue:
["Function address was not found in this session,
Void the primitive function."
self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
^self primitiveFailFor: PrimErrNotFound].
"Try to call the function directly"
(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
[addr := externalPrimitiveTable at: index - 1.
addr ~= 0 ifTrue:
[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
+ self callExternalPrimitive: addr. "On Spur, sets primitiveFunctionPointer"
+ self maybeRetryFailureDueToForwarding.
- self callExternalPrimitive: addr.
^nil].
"if we get here, then an index to the external prim was
kept on the ST side although the underlying prim
table was already flushed"
^self primitiveFailFor: PrimErrNamedInternal].
"Clean up session id and external primitive index"
objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
"The function has not been loaded yet. Fetch module and function name."
moduleName := objectMemory fetchPointer: 0 ofObject: lit.
moduleName = objectMemory nilObject
ifTrue: [moduleLength := 0]
ifFalse: [(objectMemory isBytes: moduleName) ifFalse:
[self primitiveFailFor: PrimErrBadMethod].
moduleLength := objectMemory lengthOf: moduleName].
functionName := objectMemory fetchPointer: 1 ofObject: lit.
(objectMemory isBytes: functionName) ifFalse:
[self primitiveFailFor: PrimErrBadMethod].
functionLength := objectMemory lengthOf: functionName.
+ "Spur needs to know the primitive's accessorDepth which is stored in the last slot of the first literal."
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
OfLength: functionLength
FromModule: moduleName + BaseHeaderSize
OfLength: moduleLength
AccessorDepthInto: (self addressOf: accessorDepth
put: [:val| accessorDepth := val]).
addr = 0
ifTrue: [index := -1]
ifFalse: "add the function to the external primitive table"
[index := self addToExternalPrimitiveTable: addr.
objectMemory
storePointerUnchecked: 2
ofObject: lit
withValue: (objectMemory integerObjectOf: accessorDepth)]]
ifFalse:
[addr := self ioLoadExternalFunction: functionName + BaseHeaderSize
OfLength: functionLength
FromModule: moduleName + BaseHeaderSize
OfLength: moduleLength.
addr = 0
ifTrue: [index := -1]
ifFalse: "add the function to the external primitive table"
[index := self addToExternalPrimitiveTable: addr]].
"Store the index (or -1 if failure) back in the literal"
objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
"If the function has been successfully loaded cache and call it"
index >= 0
ifTrue:
[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: [addr] inSmalltalk: [1000 + index]).
+ self callExternalPrimitive: addr.
+ self maybeRetryFailureDueToForwarding]
- self callExternalPrimitive: addr]
ifFalse: "Otherwise void the primitive function and fail"
[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
self assert: (objectMemory fetchPointer: 2 ofObject: lit) = ConstZero.
self primitiveFailFor: PrimErrNotFound]!
Item was changed:
----- Method: StackInterpreterSimulator>>callExternalPrimitive: (in category 'plugin support') -----
callExternalPrimitive: mapIndex
| entry |
+ entry := self pluginEntryFor: mapIndex.
+ "Spur needs the primitiveFunctionPointer to be set correctly
+ for accurate following of forwarders on primitive failure."
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [primitiveFunctionPointer := entry at: 2].
+ ^(entry at: 1) perform: (entry at: 2)!
- entry := mappedPluginEntries at: (mapIndex > 1000
- ifTrue: [externalPrimitiveTable at: mapIndex - 1001]
- ifFalse: [mapIndex]).
- ^(entry at: 1) perform: (entry at: 2).!
Item was added:
+ ----- Method: StackInterpreterSimulator>>pluginEntryFor: (in category 'plugin support') -----
+ pluginEntryFor: mapIndex
+ ^mappedPluginEntries at: (mapIndex > 1000
+ ifTrue: [externalPrimitiveTable at: mapIndex - 1001]
+ ifFalse: [mapIndex])!
Item was added:
+ ----- Method: VMMaker class>>generateAllSpurConfigurationsUnderVersionControl (in category 'configurations') -----
+ generateAllSpurConfigurationsUnderVersionControl
+ self generateNewspeakSpurStackVM;
+ generateSqueakSpurStackVM;
+ generateNewspeakSpurCogVM;
+ generateSqueakSpurCogVM;
+ generateSqueakSpurCogSistaVM!
More information about the Vm-dev
mailing list