Branch: refs/heads/vi
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
2
1
[OpenSmalltalk/opensmalltalk-vm] abd3f1: For GitHub Actions builds (CI), move pharo.* flavo...
by Marcel Taeumel 21 Mar '23
by Marcel Taeumel 21 Mar '23
21 Mar '23
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: abd3f14bcb3771d756bba1d6b3f9c2873ab3aeca
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/abd3f14bcb3771d756…
Author: Marcel Taeumel <marcel.taeumel(a)hpi.de>
Date: 2023-03-21 (Tue, 21 Mar 2023)
Changed paths:
M .github/workflows/extra.yml
M .github/workflows/linux.yml
M .github/workflows/macos-arm.yml
M .github/workflows/macos.yml
M .github/workflows/win.yml
Log Message:
-----------
For GitHub Actions builds (CI), move pharo.* flavors from "on-push" to our monthly tier; see extra.yml. Third-party library builds are too flaky and obfuscate on-push CI results of vanilla OSVM. We have this already for newspeak.* flavors, which are also rarely used at this point but have some value to keep around.
Commit: b78061cf41ab7b85a3e45116674effb3da757513
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/b78061cf41ab7b85a3…
Author: Marcel Taeumel <marcel.taeumel(a)hpi.de>
Date: 2023-03-21 (Tue, 21 Mar 2023)
Changed paths:
R building/linux32ARMv6/pharo.cog.spur/build.assert/mvm
R building/linux32ARMv6/pharo.cog.spur/build.debug/mvm
R building/linux32ARMv6/pharo.cog.spur/build/mvm
R building/linux32ARMv6/pharo.cog.spur/makeallclean
R building/linux32ARMv6/pharo.cog.spur/makealldirty
R building/linux32ARMv6/pharo.cog.spur/plugins.ext
R building/linux32ARMv6/pharo.cog.spur/plugins.ext.all
R building/linux32ARMv6/pharo.cog.spur/plugins.int
R building/linux32ARMv6/pharo.cog.spur/prepare-rpi.sh
R building/linux32x86/nsnac.cog.spur/build.assert.itimerheartbeat/mvm
R building/linux32x86/nsnac.cog.spur/build.assert/mvm
R building/linux32x86/nsnac.cog.spur/build.debug.itimerheartbeat/mvm
R building/linux32x86/nsnac.cog.spur/build.debug/mvm
R building/linux32x86/nsnac.cog.spur/build.itimerheartbeat/mvm
R building/linux32x86/nsnac.cog.spur/build/mvm
R building/linux32x86/nsnac.cog.spur/makeallclean
R building/linux32x86/nsnac.cog.spur/makealldirty
R building/linux32x86/nsnac.cog.spur/plugins.ext
R building/linux32x86/nsnac.cog.spur/plugins.int
R building/linux32x86/pharo.cog.spur.minheadless/build.assert.itimerheartbeat/mvm
R building/linux32x86/pharo.cog.spur.minheadless/build.assert/mvm
R building/linux32x86/pharo.cog.spur.minheadless/build.debug.itimerheartbeat/mvm
R building/linux32x86/pharo.cog.spur.minheadless/build.itimerheartbeat/mvm
R building/linux32x86/pharo.cog.spur.minheadless/build/mvm
R building/linux32x86/pharo.cog.spur.minheadless/makeallclean
R building/linux32x86/pharo.cog.spur.minheadless/makealldirty
R building/linux64ARMv8/pharo.stack.spur/apt-get-libs.sh
R building/linux64ARMv8/pharo.stack.spur/build.debug/mvm
R building/linux64ARMv8/pharo.stack.spur/build/mvm
R building/linux64ARMv8/pharo.stack.spur/plugins.ext
R building/linux64ARMv8/pharo.stack.spur/plugins.ext.all
R building/linux64ARMv8/pharo.stack.spur/plugins.int
R building/linux64x64/pharo.cog.spur.minheadless/build.assert.itimerheartbeat/mvm
R building/linux64x64/pharo.cog.spur.minheadless/build.assert/mvm
R building/linux64x64/pharo.cog.spur.minheadless/build.debug.itimerheartbeat/mvm
R building/linux64x64/pharo.cog.spur.minheadless/build.debug/mvm
R building/linux64x64/pharo.cog.spur.minheadless/build.itimerheartbeat/mvm
R building/linux64x64/pharo.cog.spur.minheadless/build/mvm
R building/linux64x64/pharo.cog.spur.minheadless/makeallclean
R building/linux64x64/pharo.cog.spur.minheadless/makealldirty
R building/macos32x86/common.minheadless/Makefile.app
R building/macos32x86/common.minheadless/Makefile.app.newspeak
R building/macos32x86/common.minheadless/Makefile.app.squeak
R building/macos32x86/common.minheadless/Makefile.clangversion
R building/macos32x86/common.minheadless/Makefile.flags
R building/macos32x86/common.minheadless/Makefile.lib.extra
R building/macos32x86/common.minheadless/Makefile.plugin
R building/macos32x86/common.minheadless/Makefile.rules
R building/macos32x86/common.minheadless/Makefile.sources
R building/macos32x86/common.minheadless/Makefile.vm
R building/macos32x86/common.minheadless/mkInternalPluginsList.sh
R building/macos32x86/common.minheadless/mkNamedPrims.sh
R building/macos32x86/pharo.cog.spur.minheadless/Makefile
R building/macos32x86/pharo.cog.spur.minheadless/mvm
R building/macos32x86/pharo.cog.spur.minheadless/plugins.ext
R building/macos32x86/pharo.cog.spur.minheadless/plugins.int
R building/macos64ARMv8/pharo.stack.spur.lowcode/Makefile
R building/macos64ARMv8/pharo.stack.spur.lowcode/mvm
R building/macos64ARMv8/pharo.stack.spur.lowcode/plugins.ext
R building/macos64ARMv8/pharo.stack.spur.lowcode/plugins.int
R building/macos64ARMv8/pharo.stack.spur/Makefile
R building/macos64ARMv8/pharo.stack.spur/mvm
R building/macos64ARMv8/pharo.stack.spur/plugins.ext
R building/macos64ARMv8/pharo.stack.spur/plugins.int
Log Message:
-----------
Removes selected unused (i.e. no CI) build templates: *.minheadless, pharo.* for ARM, nsnac.cog.spur
Commit: 58965aada96126daf2557ef99aeb1ba645a6b625
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/58965aada96126daf2…
Author: Marcel Taeumel <marcel.taeumel(a)hpi.de>
Date: 2023-03-21 (Tue, 21 Mar 2023)
Changed paths:
M .github/workflows/extra-arm.yml
M .github/workflows/macos-arm.yml
M .github/workflows/macos.yml
Log Message:
-----------
Bump some GHA dependencies; remove last remaining pharo.* ARMv6 build -- remaining pharo.* builds only for x86/x64 in the monthly tier
Compare: https://github.com/OpenSmalltalk/opensmalltalk-vm/compare/fa509bdab0d9...58…
1
0
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3312.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3312
Author: eem
Time: 17 March 2023, 7:24:26.948309 pm
UUID: fe99b8e8-d402-49d2-a547-ec40f2407e0f
Ancestors: VMMaker.oscog-eem.3311
Merge VMMaker.oscog.seperateMarking-eem.3321:
Fix printStackPage:useCount: in the simulator.
=============== Diff against VMMaker.oscog-eem.3311 ===============
Item was changed:
----- Method: StackInterpreter>>printStackPage:useCount: (in category 'debug printing') -----
printStackPage: page useCount: n
<inline: false>
<var: #page type: #'StackPage *'>
+ self cCode: '' inSmalltalk: [page isInteger ifTrue: [^self printStackPage: (stackPages stackPageFor: page) useCount: n]].
+ self print: 'page ';
+ printHexPtrnp: (self cCode: [page] inSmalltalk: [page baseAddress]);
- self print: 'page '; printHexPtrnp: (self cCode: [page] inSmalltalk: [page baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page realStackLimit).
n >= 0 ifTrue:
[self print: ','; printNum: n].
self print: ') (trace: '; printNum: page trace; printChar: $).
(stackPages isFree: page) ifTrue:
[self print: ' (free)'].
page = stackPages mostRecentlyUsedPage ifTrue:
[self print: ' (MRU)'].
page prevPage = stackPages mostRecentlyUsedPage ifTrue:
[self print: ' (LRU)'].
self cr; tab; print: 'ba: ';
printHexPtrnp: page baseAddress; print: ' - sl: ';
printHexPtrnp: page realStackLimit; print: ' - sl-so: ';
printHexPtrnp: page realStackLimit - self stackLimitOffset; print: ' - la:';
printHexPtrnp: page lastAddress.
(stackPages isFree: page) ifFalse:
[self cr; tab; print: 'baseFP '; printHexPtrnp: page baseFP.
self "cr;" tab; print: 'headFP '; printHexPtrnp: page headFP.
self "cr;" tab; print: 'headSP '; printHexPtrnp: page headSP].
self cr; tab; print: 'prev '; printHexPtrnp: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page prevPage realStackLimit); printChar: $).
self tab; print: 'next '; printHexPtrnp: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page nextPage realStackLimit); printChar: $).
self cr!
1
0
18 Mar '23
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-eem.3321.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-eem.3321
Author: eem
Time: 17 March 2023, 7:22:31.670196 pm
UUID: fd9f113b-524a-45be-a347-babce195e901
Ancestors: VMMaker.oscog.seperateMarking-eem.3320
Fix printStackPage:useCount: in the simulator.
=============== Diff against VMMaker.oscog.seperateMarking-eem.3320 ===============
Item was changed:
----- Method: StackInterpreter>>printStackPage:useCount: (in category 'debug printing') -----
printStackPage: page useCount: n
<inline: false>
<var: #page type: #'StackPage *'>
+ self cCode: '' inSmalltalk: [page isInteger ifTrue: [^self printStackPage: (stackPages stackPageFor: page) useCount: n]].
+ self print: 'page ';
+ printHexPtrnp: (self cCode: [page] inSmalltalk: [page baseAddress]);
- self print: 'page '; printHexPtrnp: (self cCode: [page] inSmalltalk: [page baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page realStackLimit).
n >= 0 ifTrue:
[self print: ','; printNum: n].
self print: ') (trace: '; printNum: page trace; printChar: $).
(stackPages isFree: page) ifTrue:
[self print: ' (free)'].
page = stackPages mostRecentlyUsedPage ifTrue:
[self print: ' (MRU)'].
page prevPage = stackPages mostRecentlyUsedPage ifTrue:
[self print: ' (LRU)'].
self cr; tab; print: 'ba: ';
printHexPtrnp: page baseAddress; print: ' - sl: ';
printHexPtrnp: page realStackLimit; print: ' - sl-so: ';
printHexPtrnp: page realStackLimit - self stackLimitOffset; print: ' - la:';
printHexPtrnp: page lastAddress.
(stackPages isFree: page) ifFalse:
[self cr; tab; print: 'baseFP '; printHexPtrnp: page baseFP.
self "cr;" tab; print: 'headFP '; printHexPtrnp: page headFP.
self "cr;" tab; print: 'headSP '; printHexPtrnp: page headSP].
self cr; tab; print: 'prev '; printHexPtrnp: (self cCode: 'page->prevPage' inSmalltalk: [page prevPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page prevPage realStackLimit); printChar: $).
self tab; print: 'next '; printHexPtrnp: (self cCode: 'page->nextPage' inSmalltalk: [page nextPage baseAddress]);
print: ' ('; printNum: (stackPages pageIndexFor: page nextPage realStackLimit); printChar: $).
self cr!
1
0
16 Mar '23
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-eem.3320.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-eem.3320
Author: eem
Time: 16 March 2023, 1:30:30.382071 pm
UUID: 8a2b74ee-9ebb-46bf-88a3-b25339d9dba9
Ancestors: VMMaker.oscog.seperateMarking-eem.3319
Finish merge of VMMaker.oscog-eem.3286
=============== Diff against VMMaker.oscog.seperateMarking-eem.3319 ===============
Item was changed:
----- Method: CogMethodSurrogate>>cmIsFullBlock (in category 'accessing') -----
cmIsFullBlock
"Answer the value of cpicHasMNUCaseOrCMIsFullBlock"
+ self assert: (self isCMMethodEtAl or: [self isCMBlock]).
- self assert: (self cmType = CMMethod or: [self cmType = CMBlock]).
^SistaV1BytecodeSet
ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock]
ifFalse: [false]!
Item was changed:
----- Method: CogMethodSurrogate>>cpicHasMNUCase (in category 'accessing') -----
cpicHasMNUCase
"Answer if the receiver has an MNU case."
<inline: true>
^SistaV1BytecodeSet
+ ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock and: [self isCMClosedPIC]]
- ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock and: [self cmType = CMClosedPIC]]
ifFalse: [self cpicHasMNUCaseOrCMIsFullBlock]!
Item was added:
+ ----- Method: CogMethodSurrogate>>isCMBlock (in category 'testing') -----
+ isCMBlock
+ ^self cmType = CMBlock!
Item was added:
+ ----- Method: CogMethodSurrogate>>isCMClosedPIC (in category 'testing') -----
+ isCMClosedPIC
+ ^self cmType = CMClosedPIC!
Item was added:
+ ----- Method: CogMethodSurrogate>>isCMFree (in category 'testing') -----
+ isCMFree
+ ^self cmType = CMFree!
Item was added:
+ ----- Method: CogMethodSurrogate>>isCMOpenPIC (in category 'testing') -----
+ isCMOpenPIC
+ ^self cmType = CMOpenPIC!
Item was changed:
----- Method: CogVMSimulator>>ceMNUFromPICMNUMethod:receiver: (in category 'trampolines') -----
ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr
| cPIC |
cPIC := self cCoerceSimple: self stackTop - cogit mnuOffset to: #'CogMethod *'.
+ self assert: (cPIC isCMClosedPIC or: [cPIC isCMOpenPIC]).
- self assert: (cPIC cmType = CMClosedPIC or: [cPIC cmType = CMOpenPIC]).
self mnuBreakpoint: cPIC selector receiver: nil.
^super ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr!
1
0
16 Mar '23
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-eem.3319.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-eem.3319
Author: eem
Time: 16 March 2023, 1:13:07.468868 pm
UUID: ced7d4b8-8e19-49a1-89bc-51bdee50f988
Ancestors: VMMaker.oscog.seperateMarking-eem.3318
Merge
VMMaker.oscog-eem.3284
VMMaker.oscog-mt.3285
VMMaker.oscog-eem.3282
=============== Diff against VMMaker.oscog.seperateMarking-eem.3318 ===============
Item was changed:
----- Method: ByteArray>>long32At: (in category '*VMMaker-accessing') -----
long32At: byteIndex
+ "Answer a 32-bit integer in platform native order starting at the given byte offset."
- "Store a 32bit signed integer starting at the given byte offset"
<primitive: #primitiveSignedInt32At module: #SqueakFFIPrims error: ec>
^self integerAt: byteIndex size: 4 signed: true!
Item was added:
+ ----- Method: ByteArray>>long32At:put: (in category '*VMMaker-accessing') -----
+ long32At: byteIndex put: aValue
+ "Store a 32bit signed integer starting at the given byte offset"
+ <primitive: #primitiveSignedInt32AtPut module: #SqueakFFIPrims error: ec>
+ ^self integerAt: byteIndex put: aValue size: 4 signed: true!
Item was changed:
----- Method: ByteArray>>long64At: (in category '*VMMaker-accessing') -----
+ long64At: byteIndex
+ "Answer a 64-bit integer in platform native order starting at the given byte offset."
- long64At: index
- "Answer a 64-bit integer in platform native order."
<primitive: #primitiveSignedInt64At module: #SqueakFFIPrims error: ec>
+ ^self integerAt: byteIndex size: 8 signed: true!
- ^self integerAt: index size: 8 signed: true!
Item was changed:
----- Method: ByteArray>>long64At:put: (in category '*VMMaker-accessing') -----
long64At: index put: value
+ "Store a 64-bit integer in platform native order starting at the given byte offset."
+ <primitive: #primitiveSignedInt64AtPut module: #SqueakFFIPrims error: ec>
- "I store 64-bit integers in platform native order."
- <primitive: #primitiveSignedInt648At module: #SqueakFFIPrims error: ec>
^self integerAt: index put: value size: 8 signed: true!
Item was changed:
----- Method: ByteArray>>longAt: (in category '*VMMaker-accessing') -----
longAt: byteIndex
+ "Answer a 32-bit integer in platform native order starting at the given byte offset."
- "Store a 32-bit signed integer starting at the given byte offset"
<primitive: #primitiveSignedInt32At module: #SqueakFFIPrims error: ec>
^self integerAt: byteIndex size: 4 signed: true!
Item was changed:
----- Method: ByteArray>>longAt:put: (in category '*VMMaker-accessing') -----
longAt: byteIndex put: aValue
"Store a 32bit signed integer starting at the given byte offset"
+ <primitive: #primitiveSignedInt32AtPut module: #SqueakFFIPrims error: ec>
^self integerAt: byteIndex put: aValue size: 4 signed: true!
Item was changed:
----- Method: ByteArray>>unsignedLong64At: (in category '*VMMaker-accessing') -----
unsignedLong64At: byteOffset
+ "Answer a 64-bit unsigned integer in platform native order starting at the given byte offset."
- "Answer a 64-bit integer in platform native order."
<primitive: #primitiveUnsignedInt64At module: #SqueakFFIPrims error: ec>
^self integerAt: byteOffset size: 8 signed: false!
Item was changed:
----- Method: ByteArray>>unsignedLong64At:put: (in category '*VMMaker-accessing') -----
unsignedLong64At: byteOffset put: value
+ "Store a 64-bit unsigned integer in platform native order starting at the given byte offset."
+ <primitive: #primitiveUnsignedInt64AtPut module: #SqueakFFIPrims error: ec>
- "I store 64-bit integers in Smalltalk (little-endian) order."
^self integerAt: byteOffset put: value size: 8 signed: false!
Item was changed:
----- Method: CoInterpreter>>asCogHomeMethod: (in category 'frame access') -----
asCogHomeMethod: aCogMethod
"Coerce either a CMMethod or a CMBlock to the home CMMethod"
<var: #aCogMethod type: #'CogBlockMethod *'>
<returnTypeC: #'CogMethod *'>
+ ^aCogMethod isCMMethodEtAl
- ^aCogMethod cmType = CMMethod
ifTrue: [self cCoerceSimple: aCogMethod to: #'CogMethod *']
ifFalse: [aCogMethod cmHomeMethod]!
Item was changed:
----- Method: CoInterpreter>>backupContext:toBlockingSendTo: (in category 'process primitive support') -----
backupContext: suspendedContext toBlockingSendTo: conditionVariable
"Support for primitiveSuspend.
Assume suspendedContext is that of a process waiting on a condition variable.
Backup the PC of suspendedContext to the send that entered the wait state.
primitiveEnterCriticalSection pushes false for blocked waiters. false must be
replaced by the condition variable."
"The suspendedContext is in one of six states, hence six cases:
1 & 2: single context with bytecode pc or single context with machine code pc
3 & 4: married to machine code frame in embedded (v3) block or machine code frame in method/full block
5 & 6: married to interpreter frame with saved ip or interpreter frame with pushed pc"
| theMethod pc sp theIP theNewIP theFP thePage |
self assert: (objectMemory isContext: suspendedContext).
theMethod := objectMemory fetchPointer: MethodIndex ofObject: suspendedContext.
"cases 1 & 2"
(self isSingleContext: suspendedContext) ifTrue:
[pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: suspendedContext.
sp := objectMemory fetchPointer: StackPointerIndex ofObject: suspendedContext.
self assert: ((objectMemory isIntegerObject: pc) and: [(objectMemory integerValueOf: pc) ~= 0]).
self assert: ((objectMemory isIntegerObject: sp) and: [(objectMemory integerValueOf: sp) > 0]).
"case 2"
(pc := objectMemory integerValueOf: pc) < 0 ifTrue: "context with machine code pc; must map..."
[pc := objectMemory integerValueOf: (self mustMapMachineCodePC: pc context: suspendedContext)].
theIP := theMethod + objectMemory baseHeaderSize + pc - 1.
theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
pc := theNewIP - theMethod - objectMemory baseHeaderSize + 1.
objectMemory
storePointerUnchecked: InstructionPointerIndex
ofObject: suspendedContext
withValue: (objectMemory integerObjectOf: pc).
sp := (objectMemory integerValueOf: sp) + ReceiverIndex. "implicitly converts to 0 relative"
self assert: ((objectMemory fetchPointer: sp ofObject: suspendedContext) = objectMemory falseObject
or: [(objectMemory fetchPointer: sp ofObject: suspendedContext) = conditionVariable]).
objectMemory storePointer: sp ofObject: suspendedContext withValue: conditionVariable.
^self].
self assert: (self isMarriedOrWidowedContext: suspendedContext).
self deny: (self isWidowedContextNoConvert: suspendedContext).
theFP := self frameOfMarriedContext: suspendedContext.
thePage := stackPages stackPageFor: theFP.
self deny: thePage = stackPage.
self assert: theFP = thePage headFP.
(self isMachineCodeFrame: theFP)
ifTrue: "cases 3 & 4"
[| mcpc startBcpc cogMethod |
mcpc := stackPages longAt: thePage headSP. "a machine code pc... it must be converted..."
cogMethod := self mframeCogMethod: theFP.
+ cogMethod isCMBlock "case 3"
- cogMethod cmType = CMBlock "case 3"
ifTrue: [self assert: (self frameStackedReceiver: theFP numArgs: cogMethod cmNumArgs)
= (objectMemory fetchPointer: ClosureIndex ofObject: suspendedContext).
startBcpc := self startPCOfClosure: (objectMemory fetchPointer: ClosureIndex ofObject: suspendedContext)]
ifFalse: [startBcpc := self startPCOfMethod: theMethod]. "case 4"
theIP := cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethod.
theIP := theIP + theMethod + objectMemory baseHeaderSize.
theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
self convertFrame: theFP toInterpreterFrame: theIP - theNewIP]
ifFalse: "cases 5&6"
[theIP := stackPages longAt: thePage headSP.
theIP = cogit ceReturnToInterpreterPC
ifTrue: "case 5"
[theIP := (self iframeSavedIP: theFP) + 1. "fetchByte uses pre-increment; must + 1 to point at correct bytecode..."
theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
self iframeSavedIP: theFP put: theNewIP - 1] "fetchByte uses pre-increment; must - 1 to fetch correct bytecode..."
ifFalse: "case 6"
[theIP := theIP + 1. "fetchByte uses pre-increment; must + 1 to point at correct bytecode..."
self assert: (self validInstructionPointer: theIP inMethod: theMethod framePointer: theFP).
theNewIP := self perform: pcPreviousToFunction with: theIP with: theMethod.
self assert: (theNewIP < theIP and: [theIP - theNewIP <= 3]).
stackPages longAt: thePage headSP put: theNewIP - 1]]. "fetchByte uses pre-increment; must - 1 to fetch correct bytecode..."
self assert: ((stackPages longAt: thePage headSP + objectMemory wordSize) = objectMemory falseObject
or: [(stackPages longAt: thePage headSP + objectMemory wordSize) = conditionVariable]).
stackPages longAt: thePage headSP + objectMemory wordSize put: conditionVariable!
Item was changed:
----- Method: CoInterpreter>>bytecodePCFor:cogMethod:startBcpc: (in category 'frame access') -----
bytecodePCFor: theIP cogMethod: cogMethod startBcpc: startBcpc
"Answer the mapping of the native pc theIP to a zero-relative bytecode pc.
See contextInstructionPointer:frame: for the explanation."
<var: #cogMethod type: #'CogMethod *'>
| cogMethodForIP mcpc |
<inline: true>
<var: #cogMethodForIP type: #'CogBlockMethod *'>
self assert: theIP < 0.
(theIP signedBitShift: -16) < -1 "See contextInstructionPointer:frame:"
ifTrue:
[cogMethodForIP := self cCoerceSimple: cogMethod asInteger - ((theIP signedBitShift: -16) * cogit blockAlignment)
to: #'CogBlockMethod *'.
+ self assert: cogMethodForIP isCMBlock.
- self assert: cogMethodForIP cmType = CMBlock.
self assert: cogMethodForIP cmHomeMethod = cogMethod.
mcpc := cogMethodForIP asInteger - theIP signedIntFromShort]
ifFalse:
[cogMethodForIP := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'.
+ self assert: cogMethodForIP isCMMethodEtAl.
- self assert: cogMethodForIP cmType = CMMethod.
mcpc := cogMethod asInteger - theIP.
"map any pcs in primitive code (i.e. return addresses for interpreter primitive calls) to the initial pc"
mcpc asUnsignedInteger < cogMethod stackCheckOffset ifTrue:
[^startBcpc]].
self assert: (mcpc between: cogMethod asInteger and: cogMethod asInteger + cogMethod blockSize).
^cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethodForIP!
Item was changed:
----- Method: CoInterpreter>>ceInterpretMethodFromPIC:receiver: (in category 'trampolines') -----
ceInterpretMethodFromPIC: aMethodObj receiver: rcvr
<api>
| pic primitiveIndex |
<var: #pic type: #'CogMethod *'>
"pop off inner return and locate open or closed PIC"
pic := self cCoerceSimple: self popStack - cogit interpretOffset to: #'CogMethod *'.
+ self assert: (pic isCMOpenPIC or: [pic isCMClosedPIC]).
- self assert: (pic cmType = CMOpenPIC or: [pic cmType = CMClosedPIC]).
"If found from an open PIC then it must be an uncogged method and, since it's been found
in the method cache, should be cogged if possible. If found from a closed PIC then at the
time the closed PIC was created the method was uncoggable, either because there was
no space, it had too many literals or it contained an illegal bytecode). So don't try and cog
it, but subsequently it may have been cogged via another path. If the method is, or ends up
cogged, jump to machine code, otherwise interpret."
+ pic isCMOpenPIC ifTrue:
- pic cmType = CMOpenPIC ifTrue:
[self assert: (self methodHasCogMethod: aMethodObj) not.
(self methodShouldBeCogged: aMethodObj) ifTrue:
[cogit cog: aMethodObj selector: pic selector]].
(self methodHasCogMethod: aMethodObj) ifTrue:
[self executeCogMethod: (self cogMethodOf: aMethodObj)
fromUnlinkedSendWithReceiver: rcvr
"NOTREACHED"].
messageSelector := pic selector.
newMethod := aMethodObj.
primitiveIndex := self primitiveIndexOf: aMethodObj.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject.
argumentCount := pic cmNumArgs.
instructionPointer := self popStack.
^self interpretMethodFromMachineCode
"NOTREACHED"!
Item was changed:
----- Method: CoInterpreter>>ceMNUFromPICMNUMethod:receiver: (in category 'trampolines') -----
ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr
<api>
| cPIC primitiveIndex |
<var: #cPIC type: #'CogMethod *'>
self assert: (objectMemory addressCouldBeOop: rcvr).
self assert: (aMethodObj = 0
or: [(objectMemory addressCouldBeObj: aMethodObj)
and: [objectMemory isOopCompiledMethod: aMethodObj]]).
self sendBreakpoint: (objectMemory splObj: SelectorDoesNotUnderstand) receiver: rcvr.
cPIC := self cCoerceSimple: self popStack - cogit mnuOffset to: #'CogMethod *'.
+ self assert: (cPIC isCMClosedPIC or: [cPIC isCMOpenPIC]).
- self assert: (cPIC cmType = CMClosedPIC or: [cPIC cmType = CMOpenPIC]).
argumentCount := cPIC cmNumArgs.
messageSelector := cPIC selector.
aMethodObj ~= 0 ifTrue:
[instructionPointer := self popStack.
self createActualMessageTo: (objectMemory fetchClassOf: rcvr).
(self maybeMethodHasCogMethod: aMethodObj) ifTrue:
[self push: instructionPointer.
self executeCogMethod: (self cogMethodOf: aMethodObj)
fromUnlinkedSendWithReceiver: rcvr.
"NOTREACHED"
self assert: false].
newMethod := aMethodObj.
primitiveIndex := self primitiveIndexOf: aMethodObj.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject.
^self interpretMethodFromMachineCode].
"handleMNU:InMachineCodeTo:classForMessage: assumes lkupClass is set, since every other use is
after a lookupMethodNoMNUEtcInClass: call, which sets lkupClass. Here we must set it manually.
Global variables. Bah!!"
self handleMNU: SelectorDoesNotUnderstand
InMachineCodeTo: rcvr
classForMessage: (lkupClass := objectMemory fetchClassOf: rcvr).
"NOTREACHED"
self assert: false!
Item was changed:
----- Method: CoInterpreter>>ceSendFromInLineCacheMiss: (in category 'trampolines') -----
ceSendFromInLineCacheMiss: cogMethodOrPIC
"Send from an Open PIC when the first-level method lookup probe has failed,
or to continue when PIC creation has failed (e.g. because we're out of code space),
or when a send has failed due to a forwarded receiver."
<api>
<var: #cogMethodOrPIC type: #'CogMethod *'>
| numArgs rcvr classTag classObj errSelIdx |
"self printFrame: stackPage headFP WithSP: stackPage headSP"
"self printStringOf: selector"
numArgs := cogMethodOrPIC cmNumArgs.
rcvr := self stackValue: numArgs + 1. "skip return pc"
self assert: (objectMemory addressCouldBeOop: rcvr).
classTag := objectMemory fetchClassTagOf: rcvr.
argumentCount := numArgs.
false ifTrue: "would like to assert this but must also allow for an interpretable method in the cache."
+ [self deny: (cogMethodOrPIC isCMOpenPIC
- [self deny: (cogMethodOrPIC cmType = CMOpenPIC
and: [self newMethodInLookupCacheAt: cogMethodOrPIC selector and: classTag])].
(self lookupInMethodCacheSel: cogMethodOrPIC selector classTag: classTag)
ifTrue:"check for coggability because method is in the cache"
[self
ifAppropriateCompileToNativeCode: newMethod
selector: cogMethodOrPIC selector]
ifFalse:
[(objectMemory isOopForwarded: cogMethodOrPIC selector) ifTrue:
[self handleForwardedSelectorFaultFor: cogMethodOrPIC selector.
^self ceSendFromInLineCacheMiss: cogMethodOrPIC].
(objectMemory isForwardedClassTag: classTag) ifTrue:
[self handleForwardedSendFaultForReceiver: rcvr stackDelta: 1 "skip return pc".
^self ceSendFromInLineCacheMiss: cogMethodOrPIC].
messageSelector := cogMethodOrPIC selector.
classObj := objectMemory classForClassTag: classTag.
(errSelIdx := self lookupOrdinaryNoMNUEtcInClass: classObj) ~= 0 ifTrue:
[self handleMNU: errSelIdx InMachineCodeTo: rcvr classForMessage: classObj.
"NOTREACHED"
self assert: false]].
instructionPointer := self popStack.
(self maybeMethodHasCogMethod: newMethod) ifTrue:
[self executeNewMethod.
self assert: false
"NOTREACHED"].
^self interpretMethodFromMachineCode
"NOTREACHED"!
Item was changed:
----- Method: CoInterpreter>>encodedNativePCOf:cogMethod: (in category 'frame access') -----
encodedNativePCOf: mcpc cogMethod: cogMethod
"Encode the mcpc in cogMethod as a value that can be stashed in a context.
Mapping native pcs to bytecode pcs is quite expensive, requiring a search
through the method map. We mitigate this cost by deferring mapping until
we really have to, which is when a context's instruction pointer is accessed
by Smalltalk code. But to defer mapping we have to be able to distinguish
machine code from bytecode pcs, which we do by using negative values for
machine code pcs.
As a whorish performance hack we also include the block method offset in
the pc of a block. The least significant 16 bits are the native pc and the most
significant 15 bits are the block start, in block alignment units. So when
mapping back we can find the start of the block.
See mustMapMachineCodePC:context: for the code that does the actual mapping."
<var: #cogMethod type: #'CogBlockMethod *'>
| homeMethod blockOffset |
<var: #homeMethod type: #'CogMethod *'>
mcpc = cogit ceCannotResumePC ifTrue:
[^HasBeenReturnedFromMCPCOop].
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[^objectMemory integerObjectOf: cogMethod asInteger - mcpc].
homeMethod := cogMethod cmHomeMethod.
blockOffset := homeMethod asInteger - cogMethod asInteger / cogit blockAlignment.
^objectMemory integerObjectOf: ((blockOffset bitShift: 16) bitOr: (cogMethod asInteger - mcpc bitAnd: 16rFFFF))!
Item was changed:
----- Method: CoInterpreter>>marryFrame:SP:copyTemps: (in category 'frame access') -----
marryFrame: theFP SP: theSP copyTemps: copyTemps
"Marry an unmarried frame. This means creating a spouse context
initialized with a subset of the frame's state that references the frame.
For the default closure implementation we do not need to copy temps.
Different closure implementations may require temps to be copied.
This method is important enough for performance to be worth streamlining.
Override to set the ``has context'' flag appropriately for both machine code and interpreter frames
and to streamline the machine code/interpreter differences.."
| theContext methodFieldOrObj closureOrNil rcvr numSlots numArgs numStack numTemps |
<inline: true>
<var: #theFP type: #'char *'>
<var: #theSP type: #'char *'>
<var: #cogMethod type: #'CogMethod *'>
self assert: (self frameHasContext: theFP) not.
self assert: (self isBaseFrame: theFP) not. "base frames must aready be married for cannotReturn: processing"
"The SP is expected to be pointing at the last oop on the stack, not at the pc"
self assert: (objectMemory addressCouldBeOop: (objectMemory longAt: theSP)).
"Decide how much of the stack to preserve in widowed contexts. Preserving too much
state will potentially hold onto garbage. Holding onto too little may mean that a dead
context isn't informative enough in a debugging situation. If copyTemps is false (as it
is in the default closure implementation) compromise, retaining only the arguments with
no temporaries. Note that we still set the stack pointer to its current value, but stack
contents other than the arguments are nil."
methodFieldOrObj := self frameMethodField: theFP.
methodFieldOrObj asUnsignedInteger < objectMemory startOfMemory "inline (self isMachineCodeFrame: theFP)"
ifTrue:
[| cogMethod |
stackPages
longAt: theFP + FoxMethod
put: methodFieldOrObj + MFMethodFlagHasContextFlag.
cogMethod := self cCoerceSimple: (methodFieldOrObj bitAnd: MFMethodMask) to: #'CogMethod *'.
numArgs := cogMethod cmNumArgs.
+ cogMethod isCMMethodEtAl
- cogMethod cmType = CMMethod
ifTrue:
[closureOrNil := cogMethod cmIsFullBlock
ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs]
ifFalse: [objectMemory nilObject]]
ifFalse:
[cogMethod := (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod.
closureOrNil := self frameStackedReceiver: theFP numArgs: numArgs].
numSlots := (self methodHeaderIndicatesLargeFrame: cogMethod methodHeader)
ifTrue: [LargeContextSlots]
ifFalse: [SmallContextSlots].
methodFieldOrObj := cogMethod methodObject.
rcvr := self mframeReceiver: theFP.
numStack := self stackPointerIndexForMFrame: theFP WithSP: theSP numArgs: numArgs]
ifFalse:
[self setIFrameHasContext: theFP.
numArgs := self iframeNumArgs: theFP.
numSlots := (self methodHeaderIndicatesLargeFrame: (objectMemory methodHeaderOf: methodFieldOrObj))
ifTrue: [LargeContextSlots]
ifFalse: [SmallContextSlots].
closureOrNil := (self iframeIsBlockActivation: theFP)
ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs]
ifFalse: [objectMemory nilObject].
rcvr := self iframeReceiver: theFP.
numStack := self stackPointerIndexForIFrame: theFP WithSP: theSP numArgs: numArgs].
theContext := objectMemory eeInstantiateMethodContextSlots: numSlots.
self setFrameContext: theFP to: theContext.
"Mark context as married by setting its sender to the frame pointer plus SmallInteger
tags and the InstructionPointer to the saved fp (which ensures correct alignment
w.r.t. the frame when we check for validity)"
objectMemory storePointerUnchecked: SenderIndex
ofObject: theContext
withValue: (self withSmallIntegerTags: theFP).
objectMemory storePointerUnchecked: InstructionPointerIndex
ofObject: theContext
withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)).
objectMemory storePointerUnchecked: StackPointerIndex
ofObject: theContext
withValue: (objectMemory integerObjectOf: numStack).
objectMemory storePointerUnchecked: MethodIndex
ofObject: theContext
withValue: methodFieldOrObj.
objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil.
objectMemory storePointerUnchecked: ReceiverIndex
ofObject: theContext
withValue: rcvr.
1 to: numArgs do:
[:i|
objectMemory storePointerUnchecked: ReceiverIndex + i
ofObject: theContext
withValue: (self temporary: i - 1 in: theFP)].
copyTemps ifTrue:
[numTemps := self frameNumTemps: theFP.
1 to: numTemps do:
[:i|
objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs
ofObject: theContext
withValue: (self temporary: i - 1 in: theFP)].
numArgs := numArgs + numTemps].
numArgs + 1 to: numStack do:
[:i|
objectMemory storePointerUnchecked: ReceiverIndex + i
ofObject: theContext
withValue: objectMemory nilObject].
self assert: (self frameHasContext: theFP).
self assert: (self frameOfMarriedContext: theContext) = theFP.
self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext).
^theContext!
Item was changed:
----- Method: CoInterpreter>>printCogMethod: (in category 'debug printing') -----
printCogMethod: cogMethod
<export: true> "useful for VM debugging; use export: so it will be accessible on win32"
<api>
<var: #cogMethod type: #'CogMethod *'>
| address primitive |
self cCode: ''
inSmalltalk:
[transcript ensureCr.
cogMethod isInteger ifTrue:
[^self printCogMethod: (self cCoerceSimple: cogMethod to: #'CogMethod *')]].
address := cogMethod asInteger.
self printHex: address;
print: ' <-> ';
printHex: address + cogMethod blockSize.
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[self print: ': method: ';
printHex: cogMethod methodObject.
primitive := self primitiveIndexOfMethod: cogMethod methodObject
header: cogMethod methodHeader.
primitive ~= 0 ifTrue:
[self print: ' prim '; printNum: primitive].
(objectMemory addressCouldBeObj: cogMethod methodObject) ifTrue:
[cogMethod cmIsFullBlock
ifTrue: [self print: ' [full]']
ifFalse:
[(objectMemory addressCouldBeObj: (self methodClassOf: cogMethod methodObject)) ifTrue:
[self space; printNameOfClass: (self methodClassOf: cogMethod methodObject) count: 2]]]].
+ cogMethod isCMBlock ifTrue:
- cogMethod cmType = CMBlock ifTrue:
[self print: ': block home: ';
printHex: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod asUnsignedInteger].
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[self print: ': Closed PIC N: ';
printHex: cogMethod cPICNumCases].
+ cogMethod isCMOpenPIC ifTrue:
- cogMethod cmType = CMOpenPIC ifTrue:
[self print: ': Open PIC '].
self print: ' selector: '; printHex: cogMethod selector.
cogMethod selector = objectMemory nilObject
ifTrue: [| s |
+ (cogMethod isCMMethodEtAl
- (cogMethod cmType = CMMethod
and: [(s := self maybeSelectorOfMethod: cogMethod methodObject) notNil])
ifTrue: [self print: ' (nil: '; printStringOf: s; print: ')']
ifFalse: [self print: ' (nil)']]
ifFalse: [self space; printStringOf: cogMethod selector].
self cr!
Item was changed:
----- Method: CoInterpreter>>updateStackZoneReferencesToCompiledCodePreCompactionOnPage: (in category 'frame access') -----
updateStackZoneReferencesToCompiledCodePreCompactionOnPage: thePage
<var: #thePage type: #'StackPage *'>
<inline: true>
| theFP callerFP theIPPtr theIP theMethodField theFlags theMethod |
theIPPtr := thePage headSP.
theFP := thePage headFP.
[(self isMachineCodeFrame: theFP) ifTrue:
[theMethodField := self frameMethodField: theFP.
theFlags := theMethodField bitAnd: MFMethodFlagsMask.
theMethod := self cCoerceSimple: theMethodField - theFlags to: #'CogMethod *'.
+ theMethod isCMBlock ifTrue:
- theMethod cmType = CMBlock ifTrue:
[theMethod := (self cCoerceSimple: theMethodField - theFlags to: #'CogBlockMethod *') cmHomeMethod].
theIP := (stackPages longAt: theIPPtr) asUnsignedInteger.
(theIP ~= cogit ceCannotResumePC
and: [self asserta: (theIP >= theMethod asUnsignedInteger
and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)])]) ifTrue:
[stackPages
longAt: theIPPtr
put: theIP + theMethod objectHeader].
stackPages
longAt: theFP + FoxMethod
put: theMethodField + theMethod objectHeader].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := theFP + FoxCallerSavedIP.
theFP := callerFP]!
Item was changed:
----- Method: CogBlockMethod>>cpicHasMNUCase (in category 'accessing') -----
cpicHasMNUCase
"Answer if the receiver has an MNU case."
<inline: true>
^SistaV1BytecodeSet
+ ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock and: [self isCMClosedPIC]]
- ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock and: [self cmType = CMClosedPIC]]
ifFalse: [cpicHasMNUCaseOrCMIsFullBlock]!
Item was added:
+ ----- Method: CogBlockMethod>>isCMBlock (in category 'testing') -----
+ isCMBlock
+ <inline: true>
+ ^self cmType = CMBlock!
Item was added:
+ ----- Method: CogBlockMethod>>isCMClosedPIC (in category 'testing') -----
+ isCMClosedPIC
+ <inline: true>
+ ^self cmType = CMClosedPIC!
Item was added:
+ ----- Method: CogBlockMethod>>isCMFree (in category 'testing') -----
+ isCMFree
+ <inline: true>
+ ^self cmType = CMFree!
Item was added:
+ ----- Method: CogBlockMethod>>isCMOpenPIC (in category 'testing') -----
+ isCMOpenPIC
+ <inline: true>
+ ^self cmType = CMOpenPIC!
Item was changed:
----- Method: CogMethodZone>>addToOpenPICList: (in category 'accessing') -----
addToOpenPICList: anOpenPIC
<var: #anOpenPIC type: #'CogMethod *'>
+ self assert: anOpenPIC isCMOpenPIC.
+ self assert: (openPICList == nil or: [openPICList isCMOpenPIC]).
- self assert: anOpenPIC cmType = CMOpenPIC.
- self assert: (openPICList == nil
- or: [openPICList cmType = CMOpenPIC]).
cogit assertValidDualZoneWriteAddress: anOpenPIC.
anOpenPIC nextOpenPIC: openPICList asUnsignedInteger.
openPICList := cogit cCoerceSimple: anOpenPIC asUnsignedInteger - cogit getCodeToDataDelta to: #'CogMethod *'.
self cCode: '' inSmalltalk: [self deny: openPICList isInteger]!
Item was changed:
----- Method: CogMethodZone>>addToUnpairedMethodList: (in category 'accessing') -----
addToUnpairedMethodList: aCogMethod
<option: #NewspeakVM>
<var: #aCogMethod type: #'CogMethod *'>
+ self assert: aCogMethod isCMMethodEtAl.
- self assert: aCogMethod cmType = CMMethod.
self assert: (cogit noAssertMethodClassAssociationOf: aCogMethod methodObject) = objectMemory nilObject.
self assert: (unpairedMethodList == nil
+ or: [(self cCoerceSimple: unpairedMethodList to: #'CogMethod *') isCMMethodEtAl]).
- or: [(self cCoerceSimple: unpairedMethodList to: #'CogMethod *') cmType = CMMethod]).
cogit assertValidDualZoneWriteAddress: aCogMethod.
aCogMethod nextMethodOrIRCs: unpairedMethodList.
unpairedMethodList := aCogMethod asUnsignedInteger - cogit getCodeToDataDelta!
Item was changed:
----- Method: CogMethodZone>>clearCogCompiledCode (in category 'jit - api') -----
clearCogCompiledCode
"Free all methods. Do it the slow way to keep methodBytesFreedSinceLastCompaction accurate."
<inline: true>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
NewspeakVM ifTrue: [unpairedMethodList := nil].
cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod asUnsignedInteger < mzFreeStart] whileTrue:
+ [cogMethod isCMMethodEtAl ifTrue:
- [cogMethod cmType = CMMethod ifTrue:
[self freeMethod: cogMethod].
cogMethod := self methodAfter: cogMethod].
self manageFrom: baseAddress to: limitAddress!
Item was changed:
----- Method: CogMethodZone>>clearSavedPICUsageCount: (in category 'compaction') -----
clearSavedPICUsageCount: cogMethod
"For Sista, where we want PICs to last so they can be observed, we need to keep PICs unless
they are definitely unused. So we need to identify unused PICs. So in planCompact, zero the
usage counts of all PICs, saving the actual usage count in blockEntryOffset. Then in
relocateMethodsPreCompaction (actually in relocateIfCallOrMethodReference:mcpc:delta:)
restore the usage counts of used PICs. Finally in compactCompiledCode, clear the blockEntryOffset
of the unused PICs; they will then have a zero count and be reclaimed in the next code compaction."
<inline: #always>
(SistaVM
+ and: [cogMethod isCMClosedPIC]) ifTrue:
- and: [cogMethod cmType = CMClosedPIC]) ifTrue:
[cogMethod blockEntryOffset: 0]!
Item was changed:
----- Method: CogMethodZone>>compactCompiledCode (in category 'compaction') -----
compactCompiledCode
| objectHeaderValue source dest writableVersion bytes |
<var: #source type: #'CogMethod *'>
<var: #dest type: #'CogMethod *'>
compactionInProgress := true.
methodCount := 0.
objectHeaderValue := objectMemory nullHeaderForMachineCodeMethod.
source := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
self voidOpenPICList. "The(se) list(s) will be rebuilt with the current live set"
self voidUnpairedMethodList.
[source < self limitZony
+ and: [source isCMFree not]] whileTrue:
- and: [source cmType ~= CMFree]] whileTrue:
[self assert: (cogit cogMethodDoesntLookKosher: source) = 0.
writableVersion := cogit writableMethodFor: source.
writableVersion objectHeader: objectHeaderValue.
source cmUsageCount > 0 ifTrue:
[writableVersion cmUsageCount: source cmUsageCount // 2].
self maybeLinkOnUnpairedMethodList: source.
self clearSavedPICUsageCount: writableVersion.
+ source isCMOpenPIC ifTrue:
- source cmType = CMOpenPIC ifTrue:
[self addToOpenPICList: writableVersion].
methodCount := methodCount + 1.
source := self methodAfter: source].
source >= self limitZony ifTrue:
[^self halt: 'no free methods; cannot compact.'].
dest := source.
[source < self limitZony] whileTrue:
[self assert: (cogit maybeFreeCogMethodDoesntLookKosher: source) = 0.
bytes := source blockSize.
+ source isCMFree ifFalse:
- source cmType ~= CMFree ifTrue:
[methodCount := methodCount + 1.
cogit
codeMemmove: dest _: source _: bytes;
maybeFlushWritableZoneFrom: dest asUnsignedInteger to: dest asUnsignedInteger + bytes.
(writableVersion := cogit writableMethodFor: dest) objectHeader: objectHeaderValue.
+ dest isCMMethodEtAl
- dest cmType = CMMethod
ifTrue:
["For non-Newspeak there should be a one-to-one mapping between bytecoded and
cog methods. For Newspeak not necessarily, but only for anonymous accessors."
"Only update the original method's header if it is referring to this CogMethod."
(coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger
ifTrue:
[coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]
ifFalse:
[self assert: (cogit noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject.
self linkOnUnpairedMethodList: dest]]
ifFalse:
[self clearSavedPICUsageCount: writableVersion.
+ dest isCMOpenPIC ifTrue:
- dest cmType = CMOpenPIC ifTrue:
[self addToOpenPICList: writableVersion]].
dest cmUsageCount > 0 ifTrue:
[writableVersion cmUsageCount: dest cmUsageCount // 2].
cogit maybeFlushWritableZoneFrom: dest asUnsignedInteger to: (dest + 1) asUnsignedInteger.
dest := coInterpreter cCoerceSimple: dest asUnsignedInteger + bytes to: #'CogMethod *'].
source := coInterpreter cCoerceSimple: source asUnsignedInteger + bytes to: #'CogMethod *'].
mzFreeStart := dest asUnsignedInteger.
methodBytesFreedSinceLastCompaction := 0.
compactionInProgress := false!
Item was changed:
----- Method: CogMethodZone>>findPreviouslyCompiledVersionOf:with: (in category 'accessing') -----
findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop
"Newspeak uses a set of methods to implement accessors, a setter and a getter for
each inst var offset (e.g. 0 to 255). These accessors are installed under the relevant
selectors in different method dictionaries as required. These methods effectively
have multiple selectors. The current inline cache design stores the selector of a
linked send in the header of the target method. So this requires a one-to-many
mapping of bytecoded method to cog method, with the bytecoded method referring
directly to only one cog method, which will have a specific selector, not necessarily
the right one. It is therefore worth-while searching for a cog method on this bytecoded
method that has the right selector. To speed up the search we maintain all such unpaired
methods on the unpairedMethodList, which is linked through nextMethodOrIRCs."
<returnTypeC: #'CogMethod *'>
<option: #NewspeakVM>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
((coInterpreter methodHasCogMethod: aMethodObj)
and: [(coInterpreter methodClassAssociationOf: aMethodObj) = objectMemory nilObject]) ifTrue:
[cogMethod := self cCoerceSimple: unpairedMethodList to: #'CogMethod *'.
[cogMethod notNil] whileTrue:
+ [self assert: cogMethod isCMMethodEtAl.
- [self assert: cogMethod cmType = CMMethod.
(cogMethod selector = aSelectorOop
and: [cogMethod methodObject = aMethodObj]) ifTrue:
[^cogMethod].
cogMethod := self cCoerceSimple: cogMethod nextMethodOrIRCs to: #'CogMethod *']].
^nil!
Item was changed:
----- Method: CogMethodZone>>firstBogusYoungReferrer (in category 'young referers') -----
firstBogusYoungReferrer
"Answer that all entries in youngReferrers are in-use and have the cmRefersToYoung flag set.
Used to check that the youngreferrers pruning routines work correctly."
| pointer cogMethod |
<doNotGenerate>
(youngReferrers > limitAddress
or: [youngReferrers < mzFreeStart]) ifTrue:
[^#invalidListPointers].
pointer := youngReferrers.
[pointer < limitAddress] whileTrue:
[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
+ cogMethod isCMFree ifFalse:
- cogMethod cmType ~= CMFree ifTrue:
[cogMethod cmRefersToYoung ifFalse:
[^cogMethod].
(self occurrencesInYoungReferrers: cogMethod) ~= 1 ifTrue:
[^cogMethod]].
pointer := pointer + objectMemory wordSize].
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < mzFreeStart] whileTrue:
+ [cogMethod isCMFree ifFalse:
- [cogMethod cmType ~= CMFree ifTrue:
[(self occurrencesInYoungReferrers: cogMethod) ~= (cogMethod cmRefersToYoung ifTrue: [1] ifFalse: [0]) ifTrue:
[^cogMethod]].
cogMethod := self methodAfter: cogMethod]..
^nil!
Item was changed:
----- Method: CogMethodZone>>kosherYoungReferrers (in category 'young referers') -----
kosherYoungReferrers
"Answer that all entries in youngReferrers are in-use and have the cmRefersToYoung flag set.
Used to check that the youngreferrers pruning routines work correctly."
<api>
| pointer cogMethod prevMethod |
<var: #pointer type: #usqInt>
(youngReferrers > limitAddress
or: [youngReferrers < mzFreeStart]) ifTrue:
[^false].
pointer := youngReferrers.
[pointer < limitAddress] whileTrue:
[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
+ cogMethod isCMFree ifFalse:
- cogMethod cmType ~= CMFree ifTrue:
[cogMethod cmRefersToYoung ifFalse:
[^false].
(self occurrencesInYoungReferrers: cogMethod) ~= 1 ifTrue:
[^false]].
pointer := pointer + objectMemory wordSize].
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
[prevMethod := cogMethod.
+ cogMethod isCMFree ifFalse:
- cogMethod cmType ~= CMFree ifTrue:
[(self occurrencesInYoungReferrers: cogMethod) ~= (cogMethod cmRefersToYoung ifTrue: [1] ifFalse: [0]) ifTrue:
[^false]].
cogMethod := self methodAfter: cogMethod.
cogMethod = prevMethod ifTrue:
[^false]].
^true!
Item was changed:
----- Method: CogMethodZone>>maybeLinkOnUnpairedMethodList: (in category 'compaction') -----
maybeLinkOnUnpairedMethodList: cogMethod
<inline: #always>
NewspeakVM ifTrue:
+ [(cogMethod isCMMethodEtAl
- [(cogMethod cmType = CMMethod
and: [(coInterpreter rawHeaderOf: cogMethod methodObject) asInteger ~= cogMethod asInteger]) ifTrue:
[(cogit writableMethodFor: cogMethod) nextMethodOrIRCs: unpairedMethodList.
unpairedMethodList := cogMethod asUnsignedInteger]]!
Item was changed:
----- Method: CogMethodZone>>methodsCompiledToMachineCodeInto: (in category 'method zone introspection') -----
methodsCompiledToMachineCodeInto: arrayObj
<api>
<var: #cogMethod type: #'CogMethod *'>
| cogMethod methodIndex |
methodIndex := 0.
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl ifTrue:
- [cogMethod cmType = CMMethod ifTrue:
[objectMemory
storePointerUnchecked: methodIndex
ofObject: arrayObj
withValue: cogMethod methodObject.
methodIndex := methodIndex + 1].
cogMethod := self methodAfter: cogMethod].
^ methodIndex
!
Item was changed:
----- Method: CogMethodZone>>methodsDo: (in category 'simulation only') -----
methodsDo: aBlock
<doNotGenerate>
| cogMethod |
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
+ [cogMethod isCMFree not ifTrue:
- [cogMethod cmType ~= CMFree ifTrue:
[aBlock value: cogMethod].
cogMethod := self methodAfter: cogMethod]
"<api>
<returnTypeC: #void>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
[cogMethod cmType ~= CMFree ifTrue:
[aBlock value: cogMethod].
cogMethod := self methodAfter: cogMethod]"!
Item was changed:
----- Method: CogMethodZone>>planCompaction (in category 'compaction') -----
planCompaction
"Some methods have been freed. Compute how much each survivor needs to
move during the ensuing compaction and record it in the objectHeader field.
For Sista, where we want PICs to last so they can be observed, we need to keep PICs unless
they are definitely unused. So we need to identify unused PICs. So in planCompact, zero the
usage counts of all PICs, saving the actual usage count in blockEntryOffset. Then in
relocateMethodsPreCompaction (actually in relocateIfCallOrMethodReference:mcpc:delta:)
restore the usage counts of used PICs. Finally in compactCompiledCode, clear the blockEntryOffset
of the unused PICs; they will then have a zero count and be reclaimed in the next code compaction."
| delta cogMethod |
<var: #cogMethod type: #'CogMethod *'>
delta := 0.
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod asUnsignedInteger < mzFreeStart] whileTrue:
+ [cogMethod isCMFree
- [cogMethod cmType = CMFree
ifTrue: [delta := delta - cogMethod blockSize]
ifFalse:
[self assert: (cogit cogMethodDoesntLookKosher: cogMethod) = 0.
(cogit writableMethodFor: cogMethod) objectHeader: delta.
SistaVM ifTrue:
[self savePICUsageCount: cogMethod]].
cogMethod := self methodAfter: cogMethod]!
Item was changed:
----- Method: CogMethodZone>>printCogMethodsWithMethod: (in category 'printing') -----
printCogMethodsWithMethod: methodOop
<api>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
+ [(cogMethod isCMFree not
- [(cogMethod cmType ~= CMFree
and: [cogMethod methodObject = methodOop]) ifTrue:
[coInterpreter printCogMethod: cogMethod].
cogMethod := self methodAfter: cogMethod]!
Item was changed:
----- Method: CogMethodZone>>printCogMethodsWithPrimitive: (in category 'printing') -----
printCogMethodsWithPrimitive: primIdx
<api>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
+ [(cogMethod isCMMethodEtAl
- [(cogMethod cmType = CMMethod
and: [primIdx = (coInterpreter primitiveIndexOfMethod: cogMethod methodObject
header: cogMethod methodHeader)]) ifTrue:
[coInterpreter printCogMethod: cogMethod].
cogMethod := self methodAfter: cogMethod]!
Item was changed:
----- Method: CogMethodZone>>printCogMethodsWithSelector: (in category 'printing') -----
printCogMethodsWithSelector: selectorOop
<api>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod < self limitZony] whileTrue:
+ [(cogMethod isCMFree not
- [(cogMethod cmType ~= CMFree
and: [cogMethod selector = selectorOop]) ifTrue:
[coInterpreter printCogMethod: cogMethod].
cogMethod := self methodAfter: cogMethod]!
Item was changed:
----- Method: CogMethodZone>>printCogYoungReferrers (in category 'printing') -----
printCogYoungReferrers
<api>
<returnTypeC: #void>
| pointer cogMethod |
<var: #cogMethod type: #'CogMethod *'>
pointer := youngReferrers.
[pointer < limitAddress] whileTrue:
[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
cogMethod cmRefersToYoung ifFalse:
[coInterpreter print: '*'].
+ cogMethod isCMFree ifTrue:
- cogMethod cmType = CMFree ifTrue:
[coInterpreter print: '!!'].
+ (cogMethod cmRefersToYoung and: [cogMethod isCMFree not]) ifFalse:
- (cogMethod cmRefersToYoung and: [cogMethod cmType ~= CMFree]) ifFalse:
[coInterpreter print: ' '].
coInterpreter printCogMethod: cogMethod.
pointer := pointer + objectMemory wordSize]!
Item was changed:
----- Method: CogMethodZone>>relocateAndPruneYoungReferrers (in category 'young referers') -----
relocateAndPruneYoungReferrers
| source dest next cogMethod |
<var: #source type: #usqInt>
<var: #dest type: #usqInt>
<var: #next type: #usqInt>
<var: #cogMethod type: #'CogMethod *'>
<inline: false>
self assert: youngReferrers <= limitAddress.
youngReferrers = limitAddress ifTrue:
[^nil].
dest := limitAddress.
[next := dest - objectMemory wordSize.
next >= youngReferrers
+ and: [(cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: next) to: #'CogMethod *') isCMFree not
- and: [(cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: next) to: #'CogMethod *') cmType ~= CMFree
and: [cogMethod cmRefersToYoung]]] whileTrue:
[cogMethod objectHeader ~= 0 ifTrue:
[cogit codeLongAt: next put: cogMethod asInteger + cogMethod objectHeader].
dest := next].
self assert: dest >= youngReferrers.
source := dest - objectMemory wordSize.
[source >= youngReferrers] whileTrue:
[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: source) to: #'CogMethod *'.
+ (cogMethod isCMFree not
- (cogMethod cmType ~= CMFree
and: [cogMethod cmRefersToYoung]) ifTrue:
[self assert: source < (dest - objectMemory wordSize).
cogMethod objectHeader ~= 0 ifTrue:
[cogMethod := coInterpreter
cCoerceSimple: cogMethod asInteger + cogMethod objectHeader asInteger
to: #'CogMethod *'].
cogit codeLongAt: (dest := dest - objectMemory wordSize) put: cogMethod asInteger].
source := source - objectMemory wordSize].
youngReferrers := dest.
"this assert must be deferred until after compaction. See the end of compactCogCompiledCode"
"self assert: self kosherYoungReferrers"!
Item was changed:
----- Method: CogMethodZone>>relocateMethodsPreCompaction (in category 'compaction') -----
relocateMethodsPreCompaction
"All surviving methods have had the amount they are going to relocate by
stored in their objectHeader fields. Relocate all relative calls so that after
the compaction of both the method containing each call and the call target
the calls invoke the same target."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := cogit cCoerceSimple: baseAddress to: #'CogMethod *'.
[cogMethod asUnsignedInteger < mzFreeStart] whileTrue:
+ [cogMethod isCMFree ifFalse:
+ [cogMethod isCMClosedPIC
- [cogMethod cmType ~= CMFree ifTrue:
- [cogMethod cmType = CMClosedPIC
ifTrue: [cogit relocateCallsInClosedPIC: cogMethod]
ifFalse: [cogit relocateCallsAndSelfReferencesInMethod: cogMethod]].
cogMethod := self methodAfter: cogMethod].
self relocateAndPruneYoungReferrers.
^true!
Item was changed:
----- Method: CogMethodZone>>removeFromOpenPICList: (in category 'accessing') -----
removeFromOpenPICList: anOpenPIC
<var: #anOpenPIC type: #'CogMethod *'>
| prevPIC |
<var: #prevPIC type: #'CogMethod *'>
+ self assert: anOpenPIC isCMOpenPIC.
- self assert: anOpenPIC cmType = CMOpenPIC.
openPICList ifNil: [^nil]. "As it is when compacting or unlinking all sends"
+ self assert: (openPICList isCMOpenPIC
- self assert: (openPICList cmType = CMOpenPIC
and: [openPICList nextOpenPIC isNil
+ or: [(self cCoerceSimple: openPICList nextOpenPIC to: #'CogMethod *') isCMOpenPIC]]).
- or: [(self cCoerceSimple: openPICList nextOpenPIC to: #'CogMethod *') cmType = CMOpenPIC]]).
anOpenPIC = openPICList ifTrue:
["N.B. Use self rather than coInterpreter to avoid attempting to cast nil.
Conversion to CogMethod done in the nextOpenPIC accessor."
openPICList := self cCoerceSimple: anOpenPIC nextOpenPIC to: #'CogMethod *'.
^nil].
prevPIC := openPICList.
[self assert: (prevPIC ~~ nil
+ and: [prevPIC isCMOpenPIC]).
- and: [prevPIC cmType = CMOpenPIC]).
prevPIC nextOpenPIC = anOpenPIC asUnsignedInteger ifTrue:
[(cogit writableMethodFor: prevPIC) nextOpenPIC: anOpenPIC nextOpenPIC.
^nil].
prevPIC := self cCoerceSimple: prevPIC nextOpenPIC to: #'CogMethod *'.
true] whileTrue!
Item was changed:
----- Method: CogMethodZone>>removeFromUnpairedMethodList: (in category 'accessing') -----
removeFromUnpairedMethodList: aCogMethod
<option: #NewspeakVM>
<var: #aCogMethod type: #'CogMethod *'>
| prevMethod |
<var: #prevMethod type: #'CogMethod *'>
+ self assert: aCogMethod isCMMethodEtAl.
- self assert: aCogMethod cmType = CMMethod.
aCogMethod asUnsignedInteger = unpairedMethodList ifTrue:
[unpairedMethodList := aCogMethod nextMethodOrIRCs.
^nil].
prevMethod := self cCoerceSimple: unpairedMethodList to: #'CogMethod *'.
[prevMethod notNil] whileTrue:
+ [self assert: (prevMethod ~~ nil and: [prevMethod isCMMethodEtAl]).
- [self assert: (prevMethod ~~ nil and: [prevMethod cmType = CMMethod]).
prevMethod nextMethodOrIRCs = aCogMethod asUnsignedInteger ifTrue:
[prevMethod nextMethodOrIRCs: aCogMethod nextMethodOrIRCs.
^nil].
prevMethod := self cCoerceSimple: prevMethod nextMethodOrIRCs to: #'CogMethod *']!
Item was changed:
----- Method: CogMethodZone>>restorePICUsageCount: (in category 'compaction') -----
restorePICUsageCount: cogMethod
"For Sista, where we want PICs to last so they can be observed, we need to keep PICs unless
they are definitely unused. So we need to identify unused PICs. So in planCompact, zero the
usage counts of all PICs, saving the actual usage count in blockEntryOffset. Then in
relocateMethodsPreCompaction (actually in relocateIfCallOrMethodReference:mcpc:delta:)
restore the usage counts of used PICs. Finally in compactCompiledCode, clear the blockEntryOffset
of the unused PICs; they will then have a zero count and be reclaimed in the next code compaction."
<var: #cogMethod type: #'CogMethod *'>
<option: #SistaVM>
+ (cogMethod isCMClosedPIC
- (cogMethod cmType = CMClosedPIC
and: [cogMethod blockEntryOffset ~= 0]) ifTrue:
[cogMethod
cmUsageCount: cogMethod blockEntryOffset;
blockEntryOffset: 0]!
Item was changed:
----- Method: CogMethodZone>>savePICUsageCount: (in category 'compaction') -----
savePICUsageCount: cogMethod
"For Sista, where we want PICs to last so they can be observed, we need to keep PICs unless
they are definitely unused. So we need to identify unused PICs. So in planCompact, zero the
usage counts of all PICs, saving the actual usage count in blockEntryOffset. Then in
relocateMethodsPreCompaction (actually in relocateIfCallOrMethodReference:mcpc:delta:)
restore the usage counts of used PICs. Finally in compactCompiledCode, clear the blockEntryOffset
of the unused PICs; they will then have a zero count and be reclaimed in the next code compaction."
<var: #cogMethod type: #'CogMethod *'>
<option: #SistaVM>
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[cogMethod
blockEntryOffset: cogMethod cmUsageCount;
cmUsageCount: 0]!
Item was changed:
----- Method: CogMethodZone>>shouldFreeMethod:given: (in category 'compaction') -----
shouldFreeMethod: cogMethod given: freeableUsage
"Answer if cogMethod should be freed in the current pass of freeOlderMethodsForCompaction.
For Sista, where we want PICs to last so they can be observed, we need to keep PICs unless
they are definitely unused. So we need to identify unused PICs. So in planCompact, zero the
usage counts of all PICs, saving the actual usage count in blockEntryOffset. Then in
relocateMethodsPreCompaction (actually in relocateIfCallOrMethodReference:mcpc:delta:)
restore the usage counts of used PICs. Finally in compactCompiledCode, clear the blockEntryOffset
of the unused PICs; they will then have a zero count and be reclaimed in the next code compaction."
+
<var: #cogMethod type: #'CogMethod *'>
<inline: true>
^SistaVM
ifTrue:
+ [cogMethod isCMMethodEtAl
+ ifTrue: [cogMethod cmUsageCount <= freeableUsage]
+ ifFalse: [cogMethod isCMFree not and: [cogMethod cmUsageCount = 0]]]
- [cogMethod cmType = CMMethod
- ifTrue: [cogMethod cmUsageCount <= freeableUsage]
- ifFalse: [cogMethod cmType ~= CMFree
- and: [cogMethod cmUsageCount = 0]]]
ifFalse:
+ [cogMethod isCMFree not
+ and: [cogMethod cmUsageCount <= freeableUsage]]!
- [cogMethod cmType ~= CMFree
- and: [cogMethod cmUsageCount <= freeableUsage]]!
Item was changed:
----- Method: CogMethodZone>>summarizeZone (in category 'printing') -----
summarizeZone
<doNotGenerate>
| pointer cogMethod ny nf nn |
<var: #cogMethod type: #'CogMethod *'>
self printCogMethodsSummarizing: true.
self printOpenPICListSummarizing: true.
ny := nf := nn := 0.
pointer := youngReferrers.
[pointer < limitAddress] whileTrue:
[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
cogMethod cmRefersToYoung ifTrue:
[ny := ny + 1].
+ cogMethod isCMFree ifTrue:
- cogMethod cmType = CMFree ifTrue:
[nf := nf + 1].
+ (cogMethod cmRefersToYoung or: [cogMethod isCMFree]) ifFalse:
- (cogMethod cmRefersToYoung or: [cogMethod cmType = CMFree]) ifFalse:
[nn := nn + 1].
pointer := pointer + objectMemory wordSize].
coInterpreter print: 'num free '; printNum: nf; print: ' num young '; printNum: ny; print: ' num neither '; printNum: nn; cr!
Item was changed:
----- Method: CogMethodZone>>voidYoungReferrersPostTenureAll (in category 'jit - api') -----
voidYoungReferrersPostTenureAll
<var: #cogMethod type: #'CogMethod *'>
| pointer cogMethod |
<var: #pointer type: #usqInt>
<var: #cogMethod type: #'CogMethod *'>
self assert: youngReferrers <= limitAddress.
pointer := youngReferrers.
[pointer < limitAddress] whileTrue:
[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
+ cogMethod isCMFree ifFalse:
- cogMethod cmType ~= CMFree ifTrue:
[cogMethod cmRefersToYoung: false].
pointer := pointer + objectMemory wordSize].
youngReferrers := limitAddress!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>genFetchRegArgsForPerformWithArguments: (in category 'primitive generators') -----
genFetchRegArgsForPerformWithArguments: sizeReg
+ "The arguments are in an array in Arg1Reg. Its size is in sizeReg.
- "The arguments are imn an array in Arg1Reg. Its size is in sizeReg.
Load Arg0Reg and Arg1Reg with the first two slots.
Since objects always have at least one slot and are aligned to 64-bits
it is safe to load both args without checking."
cogit
MoveMw: objectMemory baseHeaderSize r: Arg1Reg R: Arg0Reg;
MoveMw: objectMemory baseHeaderSize + self wordSize r: Arg1Reg R: Arg1Reg.
^0!
Item was changed:
----- Method: CogRegisterAllocatingSimStackEntry>>isMergedWithTargetEntry: (in category 'comparing') -----
isMergedWithTargetEntry: targetEntry
"The receiver is a simStackEntry at a jump to the corresponding simStackEntry at the jump's target.
Answer if no merge is required for the jump."
+ <var: 'targetEntry' type: #'CogSimStackEntry *'>
- <var: 'ssEntry' type: #'CogSimStackEntry *'>
spilled ~= targetEntry spilled ifTrue: "push or pop required"
[^false].
(liveRegister = NoReg and: [targetEntry liveRegister ~= NoReg]) ifTrue: "register load required"
[^false].
(self isSameEntryAs: targetEntry) ifTrue:
[^liveRegister = targetEntry liveRegister].
(type = SSConstant and: [targetEntry type = SSRegister and: [liveRegister = targetEntry register]]) ifTrue:
[^true].
"self: const =1 (16r1) (live: Extra4Reg) {172} vs reg ReceiverResultReg {127}"
"self: reg ReceiverResultReg {95} vs reg Extra5Reg {85}"
"self: (bo ReceiverResultReg+296 (live: Extra5Reg) {88} vs reg ReceiverResultReg {84}"
"self: const =1 (16r1) (spilled) {167} vs spill @ FPReg-48 {122}"
((type = SSConstant and: [targetEntry type = SSRegister and: [liveRegister ~= targetEntry registerOrNone]])
or: [(type = SSRegister and: [targetEntry type = SSRegister and: [register ~= targetEntry registerOrNone]])
or: [(type = SSBaseOffset and: [register = ReceiverResultReg and: [targetEntry type = SSRegister]])
or: [(type = SSConstant and: [targetEntry type = SSSpill])]]]) ifFalse:
[self halt: 'comment the incompatible pair please'].
^false!
Item was changed:
----- Method: Cogit>>addCogMethodsToHeapMap (in category 'debugging') -----
addCogMethodsToHeapMap
<api>
"Perform an integrity/leak check using the heapMap.
Set a bit at each cog method's header."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl ifTrue:
- [cogMethod cmType = CMMethod ifTrue:
[coInterpreter heapMapAtWord: cogMethod Put: 1].
cogMethod := methodZone methodAfter: cogMethod]!
Item was changed:
----- Method: Cogit>>allCogMethodsFor: (in category 'disassembly') -----
allCogMethodsFor: cogMethod
<doNotGenerate>
| blockEntry end methods pc |
cogMethod isInteger ifTrue: [^self allCogMethodsFor: (self cogMethodSurrogateAt: cogMethod)].
+ cogMethod isCMBlock ifTrue:
- cogMethod cmType = CMBlock ifTrue:
[^self allCogMethodsFor: cogMethod cmHomeMethod].
+ (cogMethod isCMMethodEtAl not
- (cogMethod cmType ~= CMMethod
or: [cogMethod blockEntryOffset = 0]) ifTrue:
[^{cogMethod}].
methods := OrderedCollection with: cogMethod.
pc := blockEntry := cogMethod blockEntryOffset + cogMethod asInteger.
end := (self mapEndFor: cogMethod) - 1.
[pc < end] whileTrue:
[| targetpc |
targetpc := blockEntry.
(backEnd isJumpAt: pc) ifTrue:
[targetpc := backEnd jumpTargetPCAt: pc.
targetpc < blockEntry ifTrue:
[methods add: (self cCoerceSimple: targetpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *')]].
pc := pc + (backEnd instructionSizeAt: pc)].
^methods sort!
Item was changed:
----- Method: Cogit>>assertValidDualZone (in category 'debugging') -----
assertValidDualZone
"{self firstInvalidDualZoneAddress. self firstInvalidDualZoneAddress + codeToDataDelta }"
"{self firstInvalidDualZoneAddress hex. (self firstInvalidDualZoneAddress + codeToDataDelta) hex }"
+ "[:fidza| {fidza. objectMemory longAt: fidza. objectMemory longAt: fidza + codeToDataDelta } collect: #hex] value: self firstInvalidDualZoneAddress"
- "{(objectMemory longAt: self firstInvalidDualZoneAddress) hex. (objectMemory longAt: self firstInvalidDualZoneAddress + codeToDataDelta) hex }"
"self armDisassembleDualZoneAnomalies"
"self armPrintDualZoneAnomalies"
+ <cmacro: '() true'>
+ self assert: self firstInvalidDualZoneAddress isNil!
- self cCode: ''
- inSmalltalk: [self assert: self firstInvalidDualZoneAddress isNil]!
Item was changed:
----- Method: Cogit>>cPICCompactAndIsNowEmpty: (in category 'in-line cacheing') -----
cPICCompactAndIsNowEmpty: cPIC
"Scan the CPIC for target methods that have been freed and eliminate them.
Since the first entry cannot be eliminated, answer that the PIC should be
freed if the first entry is to a free target. Answer if the PIC is now empty or should be freed."
<var: #cPIC type: #'CogMethod *'>
| pc entryPoint targetMethod targets tags methods used |
<var: #targetMethod type: #'CogMethod *'>
<var: #tags declareC: 'int tags[MaxCPICCases]'>
<var: #targets declareC: 'sqInt targets[MaxCPICCases]'>
<var: #methods declareC: 'sqInt methods[MaxCPICCases]'>
+ self cCode: '' inSmalltalk:
- self cCode: [] inSmalltalk:
[tags := CArrayAccessor on: (Array new: MaxCPICCases).
targets := CArrayAccessor on: (Array new: MaxCPICCases).
methods := CArrayAccessor on: (Array new: MaxCPICCases)].
used := 0.
1 to: cPIC cPICNumCases do:
[:i| | valid |
pc := self addressOfEndOfCase: i inCPIC: cPIC.
entryPoint := i = 1
ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
valid := true.
"Collect all target triples except for triples whose entry-point is a freed method"
(cPIC containsAddress: entryPoint) ifFalse:
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ self assert: (targetMethod isCMMethodEtAl or: [targetMethod isCMFree]).
+ targetMethod isCMFree ifTrue:
- self assert: (targetMethod cmType = CMMethod or: [targetMethod cmType = CMFree]).
- targetMethod cmType = CMFree ifTrue:
[i = 1 ifTrue: [^true]. "cannot filter out the first entry cuz classTag is at point of send."
valid := false]].
valid ifTrue:
[tags at: used put: (i > 1 ifTrue: [backEnd literal32BeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize]).
targets at: used put: entryPoint.
methods at: used put: (backEnd literalBeforeFollowingAddress: pc - (i = 1
ifTrue: [backEnd jumpLongByteSize]
ifFalse: [backEnd jumpLongConditionalByteSize + backEnd cmpC32RTempByteSize])).
used := used + 1]].
used = cPIC cPICNumCases ifTrue:
[^false].
used = 0 ifTrue:
[^true].
(self writableMethodFor: cPIC) cPICNumCases: used.
used = 1 ifTrue:
[pc := self addressOfEndOfCase: 2 inCPIC: cPIC.
self rewriteCPIC: cPIC caseJumpTo: pc.
^false].
"the first entry cannot change..."
1 to: used - 1 do:
[:i|
pc := self addressOfEndOfCase: i + 1 inCPIC: cPIC.
self rewriteCPICCaseAt: pc tag: (tags at: i) objRef: (methods at: i) target: (targets at: i)].
"finally, rewrite the jump 3 instr before firstCPICCaseOffset to jump to the beginning of this new case"
self rewriteCPIC: cPIC caseJumpTo: pc - cPICCaseSize.
^false!
Item was changed:
----- Method: Cogit>>cPICHasFreedTargets: (in category 'in-line cacheing') -----
cPICHasFreedTargets: cPIC
"scan the CPIC for target methods that have been freed. "
<var: #cPIC type: #'CogMethod *'>
| pc entryPoint targetMethod |
- <var: #targetMethod type: #'CogMethod *'>
1 to: cPIC cPICNumCases do:
[:i|
pc := self addressOfEndOfCase: i inCPIC: cPIC.
entryPoint := i = 1
ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
"Find target from jump. Ignore jumps to the interpret and MNU calls within this PIC"
(cPIC containsAddress: entryPoint) ifFalse:
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ self assert: (targetMethod isCMMethodEtAl or: [targetMethod isCMFree]).
+ targetMethod isCMFree ifTrue:
- self assert: (targetMethod cmType = CMMethod or: [targetMethod cmType = CMFree]).
- targetMethod cmType = CMFree ifTrue:
[^true]]].
^false!
Item was changed:
----- Method: Cogit>>ceSICMiss: (in category 'in-line cacheing') -----
ceSICMiss: receiver
"An in-line cache check in a method has failed. The failing entry check has jumped
to the ceMethodAbort abort call at the start of the method which has called this routine.
If possible allocate a closed PIC for the current and existing classes.
The stack looks like:
receiver
args
sender return address
sp=> ceMethodAbort call return address
So we can find the method that did the failing entry check at
ceMethodAbort call return address - missOffset
and we can find the send site from the outer return address."
<api>
<static: true>
| pic innerReturn outerReturn entryPoint targetMethod newTargetMethodOrNil errorSelectorOrNil cacheTag extent result |
<var: #pic type: #'CogMethod *'>
<var: #targetMethod type: #'CogMethod *'>
"Whether we can relink to a PIC or not we need to pop off the inner return and identify the target method."
innerReturn := coInterpreter popStack asUnsignedInteger.
targetMethod := self cCoerceSimple: innerReturn - missOffset to: #'CogMethod *'.
(objectMemory isOopForwarded: receiver) ifTrue:
[^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
outerReturn := coInterpreter stackTop asUnsignedInteger.
self assert: (outerReturn between: methodZoneBase and: methodZone freeStart).
entryPoint := backEnd callTargetFromReturnAddress: outerReturn.
self assert: targetMethod selector ~= objectMemory nilObject.
self assert: targetMethod asInteger + cmEntryOffset = entryPoint.
self lookup: targetMethod selector
for: receiver
methodAndErrorSelectorInto:
[:method :errsel|
newTargetMethodOrNil := method.
errorSelectorOrNil := errsel].
"We assume lookupAndCog:for: will *not* reclaim the method zone"
self assert: outerReturn = coInterpreter stackTop.
cacheTag := objectRepresentation inlineCacheTagForInstance: receiver.
((errorSelectorOrNil notNil and: [errorSelectorOrNil ~= SelectorDoesNotUnderstand])
or: [(objectRepresentation inlineCacheTagIsYoung: cacheTag)
or: [(backEnd inlineCacheTagAt: outerReturn) = self picAbortDiscriminatorValue
or: [newTargetMethodOrNil isNil
or: [objectMemory isYoung: newTargetMethodOrNil]]]]) ifTrue:
[result := self patchToOpenPICFor: targetMethod selector
numArgs: targetMethod cmNumArgs
receiver: receiver.
self assert: result not. "If patchToOpenPICFor:.. returns we're out of code memory"
^coInterpreter ceSendFromInLineCacheMiss: targetMethod].
self ensureWritableCodeZone.
"See if an Open PIC is already available."
pic := methodZone openPICWithSelector: targetMethod selector.
(pic isNil or: [self allowEarlyOpenPICPromotion not]) ifTrue:
["otherwise attempt to create a closed PIC for the two cases."
pic := self cogPICSelector: targetMethod selector
numArgs: targetMethod cmNumArgs
Case0Method: targetMethod
Case1Method: newTargetMethodOrNil
tag: cacheTag
isMNUCase: errorSelectorOrNil = SelectorDoesNotUnderstand.
(pic asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
["For some reason the PIC couldn't be generated, most likely a lack of code memory.
Continue as if this is an unlinked send."
pic asInteger = InsufficientCodeSpace ifTrue:
[coInterpreter callForCogCompiledCodeCompaction].
self ensureExecutableCodeZone.
^coInterpreter ceSendFromInLineCacheMiss: targetMethod]].
"Relink the send site to the pic. If to an open PIC then reset the cache tag to the selector,
for the benefit of the cacheTag assert check in checkIfValidOopRef:pc:cogMethod: et al."
+ extent := pic isCMOpenPIC
- extent := pic cmType = CMOpenPIC
ifTrue:
[backEnd
rewriteInlineCacheAt: outerReturn
tag: (backEnd
inlineCacheValueForSelector: targetMethod selector
in: coInterpreter mframeHomeMethodExport)
target: pic asInteger + cmEntryOffset]
ifFalse:
[backEnd
rewriteCallAt: outerReturn
target: pic asInteger + cmEntryOffset].
self assertValidDualZoneFrom: pic asUnsignedInteger to: pic asUnsignedInteger + closedPICSize.
"These also implicitly flush the read/write mapped dual zone to the read/execute zone."
backEnd flushICacheFrom: pic asUnsignedInteger to: pic asUnsignedInteger + closedPICSize.
backEnd flushICacheFrom: outerReturn asUnsignedInteger - extent to: outerReturn asUnsignedInteger.
"Jump back into the pic at its entry in case this is an MNU (newTargetMethodOrNil is nil)"
coInterpreter
executeCogPIC: pic
fromLinkedSendWithReceiver: receiver
andCacheTag: (backEnd inlineCacheTagAt: outerReturn).
"NOTREACHED"
^nil!
Item was changed:
----- Method: Cogit>>checkIntegrityOfObjectReferencesInCode: (in category 'debugging') -----
checkIntegrityOfObjectReferencesInCode: gcModes
<api>
"Answer if all references to objects in machine-code are valid."
| cogMethod ok count |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
ok := true.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMFree not ifTrue:
- [cogMethod cmType ~= CMFree ifTrue:
[cogMethod cmRefersToYoung ifTrue:
[(count := methodZone occurrencesInYoungReferrers: cogMethod) ~= 1 ifTrue:
[coInterpreter print: 'young referrer CM '; printHex: cogMethod asInteger.
count = 0
ifTrue: [coInterpreter print: ' is not in youngReferrers'; eekcr]
ifFalse: [coInterpreter print: ' is in youngReferrers '; printNum: count; print: ' times!!'; eekcr].
ok := false]].
(objectRepresentation checkValidOopReference: cogMethod selector) ifFalse:
[coInterpreter print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' selector'; eekcr.
ok := false].
+ cogMethod isCMMethodEtAl
- cogMethod cmType = CMMethod
ifTrue:
[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
(objectRepresentation checkValidObjectReference: cogMethod methodObject) ifFalse:
[coInterpreter print: 'object leak in CM '; printHex: cogMethod asInteger; print: ' methodObject'; eekcr.
ok := false].
(objectMemory isOopCompiledMethod: cogMethod methodObject) ifFalse:
[coInterpreter print: 'non-method in CM '; printHex: cogMethod asInteger; print: ' methodObject'; eekcr.
ok := false].
(self mapFor: cogMethod
performUntil: #checkIfValidOopRef:pc:cogMethod:
arg: cogMethod) ~= 0
ifTrue: [ok := false].
(objectRepresentation hasSpurMemoryManagerAPI
or: [gcModes anyMask: GCModeNewSpace]) ifTrue:
[(((objectMemory isYoungObject: cogMethod methodObject)
or: [objectMemory isYoung: cogMethod selector])
and: [cogMethod cmRefersToYoung not]) ifTrue:
[coInterpreter print: 'CM '; printHex: cogMethod asInteger; print: ' refers to young but not marked as such'; eekcr.
ok := false]]]
ifFalse:
+ [cogMethod isCMClosedPIC
- [cogMethod cmType = CMClosedPIC
ifTrue:
[(self checkValidObjectReferencesInClosedPIC: cogMethod) ifFalse:
[ok := false]]
ifFalse:
+ [cogMethod isCMOpenPIC
- [cogMethod cmType = CMOpenPIC
ifTrue:
[(self mapFor: cogMethod
performUntil: #checkIfValidOopRef:pc:cogMethod:
arg: cogMethod) ~= 0
ifTrue: [ok := false]]]]].
cogMethod := methodZone methodAfter: cogMethod].
^ok!
Item was changed:
----- Method: Cogit>>cleanUpFailingCogCodeConstituents: (in category 'profiling primitives') -----
cleanUpFailingCogCodeConstituents: cogMethodArg
<var: #cogMethodArg type: #'CogMethod *'>
<inline: #never> "i.e. this should never be called, so keep it out of the main path."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := cogMethodArg.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMClosedPIC ifTrue:
- [cogMethod cmType = CMClosedPIC ifTrue:
[cogMethod methodObject: 0].
cogMethod := methodZone methodAfter: cogMethod].
"would like to assert this, but it requires the leak checked be run :-(
self assert: self allMachineCodeObjectReferencesValid."
coInterpreter popRemappableOop.
^nil!
Item was changed:
----- Method: Cogit>>codeRangesFor: (in category 'disassembly') -----
codeRangesFor: cogMethod
"Answer a sequence of ranges of code for the main method and all of the blocks in a CogMethod.
N.B. These are in order of block dispatch, _not_ necessarily address order in the method."
<doNotGenerate>
| pc end blockEntry starts |
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[end := false
ifTrue: [cogMethod asInteger + cPICEndOfCodeOffset - backEnd jumpLongByteSize]
ifFalse: [cogMethod asInteger + closedPICSize - 1].
^{ CogCodeRange
from: cogMethod asInteger + (self sizeof: CogMethod)
to: end
cogMethod: cogMethod
startpc: nil }].
end := (self mapEndFor: cogMethod) - 1.
cogMethod blockEntryOffset = 0 ifTrue:
[^{ CogCodeRange
from: cogMethod asInteger + (self sizeof: CogMethod)
to: end
cogMethod: cogMethod
+ startpc: (cogMethod isCMOpenPIC ifFalse:
- startpc: (cogMethod cmType ~= CMOpenPIC ifTrue:
[coInterpreter startPCOfMethodHeader: cogMethod methodHeader]) }].
pc := blockEntry := cogMethod blockEntryOffset + cogMethod asInteger.
starts := OrderedCollection with: cogMethod.
[pc < end] whileTrue:
[| targetpc |
targetpc := blockEntry.
(backEnd isJumpAt: pc) ifTrue:
[targetpc := backEnd jumpTargetPCAt: pc.
targetpc < blockEntry ifTrue:
[starts add: (self cCoerceSimple: targetpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *')]].
pc := pc + (backEnd instructionSizeAt: pc)].
starts := starts asSortedCollection.
^(1 to: starts size + 1) collect:
[:i| | cogSubMethod nextpc |
i <= starts size
ifTrue:
[cogSubMethod := starts at: i.
nextpc := i < starts size ifTrue: [(starts at: i + 1) address] ifFalse: [blockEntry].
CogCodeRange
from: cogSubMethod address + (self sizeof: cogSubMethod)
to: nextpc - 1
cogMethod: cogSubMethod
startpc: (i = 1
ifTrue: [coInterpreter startPCOfMethodHeader: cogMethod methodHeader]
ifFalse: [cogSubMethod startpc])]
ifFalse:
[CogCodeRange
from: blockEntry
to: end]]!
Item was changed:
----- Method: Cogit>>cogCodeConstituents: (in category 'profiling primitives') -----
cogCodeConstituents: withDetails
"Answer the contents of the code zone as an array of pair-wise element, address in ascending address order.
Answer a string for a runtime routine or abstract label (beginning, end, etc), a CompiledMethod for a CMMethod,
or a selector (presumably a Symbol) for a PIC.
If withDetails is true
- answer machine-code to bytecode pc mapping information for methods
- answer class, target pair information for closed PIC
N.B. Since the class tag for the first case of a closed PIC is stored at the send site, it must be collected
by scanning methods (see collectCogConstituentFor:Annotation:Mcpc:Bcpc:Method:). Since closed PICs
are never shared they always come after the method that references them, so we don't need an extra pass
to collect the first case class tags, which are (temporarily) assigned to each closed PIC's methodObject field.
But we do need to reset the methodObject fields to zero. This is done in createPICData:, unless memory
runs out, in which case it is done by cleanUpFailingCogCodeConstituents:."
<api>
| count cogMethod constituents label value |
<var: #cogMethod type: #'CogMethod *'>
count := trampolineTableIndex / 2 + 3. "+ 3 for start, freeStart and end"
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMFree ifFalse:
- [cogMethod cmType ~= CMFree ifTrue:
[count := count + 1].
cogMethod := methodZone methodAfter: cogMethod].
constituents := coInterpreter instantiateClass: coInterpreter classArray indexableSize: count * 2.
constituents ifNil:
[^constituents].
coInterpreter pushRemappableOop: constituents.
((label := objectMemory stringForCString: 'CogCode') isNil
or: [(value := self positiveMachineIntegerFor: codeBase) isNil]) ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: 0 ofObject: (self maybeTopRemapped: constituents) withValue: label;
storePointerUnchecked: 1 ofObject: (self maybeTopRemapped: constituents) withValue: value.
0 to: trampolineTableIndex - 1 by: 2 do:
[:i|
((label := objectMemory stringForCString: (trampolineAddresses at: i)) isNil
or: [(value := self positiveMachineIntegerFor: (trampolineAddresses at: i + 1) asUnsignedInteger) isNil]) ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: 2 + i ofObject: (self maybeTopRemapped: constituents) withValue: label;
storePointerUnchecked: 3 + i ofObject: (self maybeTopRemapped: constituents) withValue: value].
count := trampolineTableIndex + 2.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMFree ifFalse:
- [cogMethod cmType ~= CMFree ifTrue:
[| profileData |
profileData := self profileDataFor: cogMethod withDetails: withDetails.
profileData ifNil: [^self cleanUpFailingCogCodeConstituents: cogMethod].
coInterpreter
storePointerUnchecked: count
ofObject: (self maybeTopRemapped: constituents)
withValue: profileData.
value := withDetails
ifTrue: [self collectCogMethodConstituent: cogMethod]
ifFalse: [self positiveMachineIntegerFor: cogMethod asUnsignedInteger].
value ifNil: [^self cleanUpFailingCogCodeConstituents: cogMethod].
coInterpreter
storePointerUnchecked: count + 1
ofObject: (self maybeTopRemapped: constituents)
withValue: value.
count := count + 2].
cogMethod := methodZone methodAfter: cogMethod].
((label := objectMemory stringForCString: 'CCFree') isNil
or: [(value := self positiveMachineIntegerFor: methodZone zoneFree) isNil]) ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: count ofObject: (self maybeTopRemapped: constituents) withValue: label;
storePointerUnchecked: count + 1 ofObject: (self maybeTopRemapped: constituents) withValue: value.
((label := objectMemory stringForCString: 'CCEnd') isNil
or: [(value := self positiveMachineIntegerFor: methodZone zoneEnd) isNil]) ifTrue:
[coInterpreter popRemappableOop.
^nil].
coInterpreter
storePointerUnchecked: count + 2 ofObject: (self maybeTopRemapped: constituents) withValue: label;
storePointerUnchecked: count + 3 ofObject: (self maybeTopRemapped: constituents) withValue: value.
constituents := coInterpreter popRemappableOop.
coInterpreter beRootIfOld: constituents.
"would like to assert this, but it requires the leak checked be run :-(
self assert: self allMachineCodeObjectReferencesValid."
^constituents!
Item was changed:
----- Method: Cogit>>cogMethodDoesntLookKosher: (in category 'debugging') -----
cogMethodDoesntLookKosher: cogMethod
"Check that the header fields onf a non-free method are consistent with
the type. Answer 0 if it is ok, otherwise answer a code for the error."
<api>
<inline: false>
<var: #cogMethod type: #'CogMethod *'>
((cogMethod blockSize bitAnd: objectMemory wordSize - 1) ~= 0
or: [cogMethod blockSize < (self sizeof: CogMethod)
or: [cogMethod blockSize >= 32768]]) ifTrue:
[^1].
+ cogMethod isCMFree ifTrue: [^2].
- cogMethod cmType = CMFree ifTrue: [^2].
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[(objectMemory isIntegerObject: cogMethod methodHeader) ifFalse:
[^11].
(objectRepresentation couldBeObject: cogMethod methodObject) ifFalse:
[^12].
(cogMethod stackCheckOffset > 0
and: [cogMethod stackCheckOffset < cmNoCheckEntryOffset]) ifTrue:
[^13].
(SistaVM
and: [objectRepresentation canPinObjects
and: [cogMethod counters ~= 0]]) ifTrue:
[(objectRepresentation couldBeDerivedObject: cogMethod counters) ifFalse:
[^14]].
(NewspeakVM
and: [objectRepresentation canPinObjects
and: [cogMethod nextMethodOrIRCs ~= 0]]) ifTrue:
[(cogMethod nextMethodOrIRCs < methodZone zoneEnd)
ifTrue: "check the nextMethod (unpairedMethodList) unless we're compacting."
[(methodZone compactionInProgress
or: [cogMethod nextMethodOrIRCs = (methodZone methodFor: cogMethod nextMethodOrIRCs asVoidPointer) asUnsignedInteger]) ifFalse:
[^15]]
ifFalse:
[(objectRepresentation couldBeDerivedObject: cogMethod nextMethodOrIRCs) ifFalse:
[^16]]].
^0].
+ cogMethod isCMOpenPIC ifTrue:
- cogMethod cmType = CMOpenPIC ifTrue:
[cogMethod blockSize ~= openPICSize ifTrue:
[^21].
cogMethod methodHeader ~= 0 ifTrue:
[^22].
"Check the nextOpenPIC link unless we're compacting"
cogMethod objectHeader >= 0 ifTrue:
[(cogMethod methodObject = 0
or: [methodZone compactionInProgress
or: [cogMethod methodObject = (methodZone methodFor: cogMethod methodObject asVoidPointer) asUnsignedInteger]]) ifFalse:
[^23]].
cogMethod stackCheckOffset ~= 0 ifTrue:
[^24].
^0].
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[cogMethod blockSize ~= closedPICSize ifTrue:
[^31].
(cogMethod cPICNumCases between: 1 and: MaxCPICCases) ifFalse:
[^32].
cogMethod methodHeader ~= 0 ifTrue:
[^33].
cogMethod methodObject ~= 0 ifTrue:
[^34].
^0].
^9!
Item was changed:
----- Method: Cogit>>cogMethodOrBlockSurrogateAt: (in category 'simulation only') -----
cogMethodOrBlockSurrogateAt: address
<doNotGenerate>
| surrogate |
surrogate := self cogMethodSurrogateAt: address.
+ ^surrogate isCMBlock
- ^surrogate cmType = CMBlock
ifTrue: [self cogBlockMethodSurrogateAt: address]
ifFalse: [surrogate]!
Item was changed:
----- Method: Cogit>>collectCogConstituentFor:Annotation:Mcpc:Bcpc:Method: (in category 'profiling primitives') -----
collectCogConstituentFor: descriptor Annotation: isBackwardBranchAndAnnotation Mcpc: mcpc Bcpc: bcpc Method: cogMethodArg
<var: #descriptor type: #'BytecodeDescriptor *'>
<var: #mcpc type: #'char *'>
<var: #cogMethodArg type: #'void *'>
<var: #targetMethod type: #'CogMethod *'>
| address entryPoint |
descriptor ifNil: [^0].
descriptor isMapped ifFalse: [^0].
address := self positiveMachineIntegerFor: mcpc asUnsignedInteger.
address ifNil: [^PrimErrNoMemory]. "This cannot trigger a GC but fails if not enough space in Eden,"
"Assumes we write the values into topRemappableOop"
coInterpreter
storePointerUnchecked: cogConstituentIndex
ofObject: coInterpreter topRemappableOop
withValue: address.
coInterpreter
storePointerUnchecked: cogConstituentIndex + 1
ofObject: coInterpreter topRemappableOop
withValue: (objectMemory integerObjectOf: bcpc).
cogConstituentIndex := cogConstituentIndex + 2.
"Collect any first case classTags for closed PICs."
((isBackwardBranchAndAnnotation noMask: 1)
and: [self isSendAnnotation: isBackwardBranchAndAnnotation >> 1]) ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue: "send is linked"
[self targetMethodAndSendTableFor: entryPoint annotation: isBackwardBranchAndAnnotation >> 1 into:
[:targetMethod :sendTable|
+ targetMethod isCMClosedPIC ifTrue:
- targetMethod cmType = CMClosedPIC ifTrue:
[targetMethod methodObject: (objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: mcpc asInteger))]]]].
^0!
Item was changed:
----- Method: Cogit>>collectCogMethodConstituent: (in category 'profiling primitives') -----
collectCogMethodConstituent: cogMethod
"Answer a description of the mapping between machine code pointers and bytecode pointers for the Cog Method.
First value is the address of the cog method.
Following values are pairs of machine code pc and bytecode pc"
<var: #cogMethod type: #'CogMethod *'>
<var: #cogBlockMethod type: #'CogBlockMethod *'>
| nSlots errCode cogBlockMethod address data |
+ cogMethod isCMMethodEtAl
- (cogMethod cmType = CMMethod)
ifFalse: [^self positiveMachineIntegerFor: cogMethod asUnsignedInteger ].
cogBlockMethod := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'.
cogBlockMethod stackCheckOffset = 0 "isFrameless ?"
ifTrue: [^self positiveMachineIntegerFor: cogMethod asUnsignedInteger].
nSlots := ((objectMemory byteSizeOf: cogMethod methodObject) - (coInterpreter startPCOfMethodHeader: cogMethod methodHeader)) * 2 + objectMemory minSlotsForShortening + 1."+1 for first address"
data := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: nSlots.
data ifNil: [^nil].
coInterpreter pushRemappableOop: data.
"The iteration assumes the object is the top remappable oop"
address := (self positiveMachineIntegerFor: cogMethod asUnsignedInteger).
address ifNil: [coInterpreter popRemappableOop. ^nil].
coInterpreter
storePointerUnchecked: 0
ofObject: coInterpreter topRemappableOop
withValue: address.
cogConstituentIndex := 1.
errCode := self
mapFor: cogBlockMethod
bcpc: (coInterpreter startPCOfMethod: cogMethod methodObject)
performUntil: #collectCogConstituentFor:Annotation:Mcpc:Bcpc:Method:
arg: cogMethod asVoidPointer.
errCode ~= 0 ifTrue: [coInterpreter popRemappableOop. ^nil].
cogConstituentIndex < nSlots ifTrue:
[objectMemory shorten: coInterpreter topRemappableOop toIndexableSize: cogConstituentIndex].
^coInterpreter popRemappableOop.!
Item was changed:
----- Method: Cogit>>compactPICsWithFreedTargets (in category 'compaction') -----
compactPICsWithFreedTargets
| cogMethod count |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
count := 0.
[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod isCMClosedPIC
- [(cogMethod cmType = CMClosedPIC
and: [self cPICCompactAndIsNowEmpty: cogMethod]) ifTrue:
[(self writableMethodFor: cogMethod) cmType: CMFree].
cogMethod := methodZone methodAfter: cogMethod.
count := count + 1].
self assert: count = methodZone numMethods!
Item was changed:
----- Method: Cogit>>createCPICData: (in category 'profiling primitives') -----
createCPICData: cPIC
"Answer an Array of the PIC's selector, followed by class and targetMethod/doesNotUnderstand: for each entry in the PIC."
<var: #cPIC type: #'CogMethod *'>
| picData |
<var: #targetMethod type: #'CogMethod *'>
self assert: (cPIC methodObject = 0 or: [objectMemory addressCouldBeOop: cPIC methodObject]).
picData := objectMemory instantiateClass: objectMemory classArray indexableSize: cPIC cPICNumCases * 2 + 1.
picData ifNil: [^picData].
objectMemory storePointerUnchecked: 0 ofObject: picData withValue: cPIC selector.
1 to: cPIC cPICNumCases do:
[:i| | pc entryPoint target targetMethod class |
pc := self addressOfEndOfCase: i inCPIC: cPIC.
i = 1
ifTrue:
[class := cPIC methodObject. "first case may have been collected and stored here by collectCogConstituentFor:Annotation:Mcpc:Bcpc:Method:"
class = 0 ifTrue: [class := objectMemory nilObject]. "cPIC is unreferenced; likely evolved to OpenPIC"
entryPoint := backEnd jumpLongTargetBeforeFollowingAddress: pc]
ifFalse:
[class := objectRepresentation classForInlineCacheTag:
(backEnd literal32BeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize).
entryPoint := backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
"Find target from jump. A jump to the MNU entry-point should collect #doesNotUnderstand:"
(cPIC containsAddress: entryPoint)
ifTrue:
[target := objectMemory splObj: SelectorDoesNotUnderstand]
ifFalse:
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ self assert: targetMethod isCMMethodEtAl.
- self assert: targetMethod cmType = CMMethod.
target := targetMethod methodObject].
objectMemory
storePointerUnchecked: i * 2 - 1 ofObject: picData withValue: class;
storePointerUnchecked: i * 2 ofObject: picData withValue: target].
objectMemory beRootIfOld: picData.
cPIC methodObject: 0. "restore invariant."
^picData!
Item was changed:
----- Method: Cogit>>disassembleMethod:on: (in category 'disassembly') -----
disassembleMethod: surrogateOrAddress on: aStream
<doNotGenerate>
| cogMethod mapEntries codeRanges |
cogMethod := surrogateOrAddress isInteger
ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress]
ifFalse: [surrogateOrAddress].
+ cogMethod isCMBlock ifTrue:
- cogMethod cmType = CMBlock ifTrue:
[^self disassembleMethod: cogMethod cmHomeMethod on: aStream].
disassemblingMethod ifNil:
[^[disassemblingMethod := cogMethod.
self disassembleMethod: surrogateOrAddress on: aStream] ensure:
[disassemblingMethod := nil]].
self printMethodHeader: cogMethod on: aStream.
mapEntries := Dictionary new.
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[cogMethod cmIsFullBlock
ifTrue:
[mapEntries
at: cogMethod asInteger + cbNoSwitchEntryOffset put: 'noSwitchEntry';
at: cogMethod asInteger + cbEntryOffset put: 'entry']
ifFalse:
[mapEntries
at: cogMethod asInteger + cmNoCheckEntryOffset put: 'noCheckEntry';
at: cogMethod asInteger + cmEntryOffset put: 'entry']].
+ cogMethod isCMClosedPIC
- cogMethod cmType = CMClosedPIC
ifTrue: "Since Tim R's lovely work on Closed PICs, PIC cases go backwards..."
[mapEntries at: cogMethod asInteger + firstCPICCaseOffset put: 'ClosedPICCase', MaxCPICCases printString.
1 to: MaxCPICCases - 1 do:
[:i|
mapEntries
at: cogMethod asInteger + firstCPICCaseOffset + (i * cPICCaseSize)
put: 'ClosedPICCase', (MaxCPICCases - i) printString]]
ifFalse:
[self mapFor: cogMethod
performUntil: #collectMapEntry:address:into:
arg: mapEntries].
NewspeakVM ifTrue:
[objectRepresentation canPinObjects ifFalse:
[mapEntries keys do:
[:a|
(mapEntries at: a) = #IsNSSendCall ifTrue:
[mapEntries
at: a + backEnd jumpShortByteSize
put: {'Class'. #disassembleCachedOop:. (objectMemory wordSize)};
at: a + backEnd jumpShortByteSize + objectMemory bytesPerOop
put: {'ImplicitReceiver'. #disassembleCachedOop:. (objectMemory wordSize)}]]]].
"This would all be far more elegant and simple if we used blocks.
But there are no blocks in C and the basic enumerators here need
to be used in the real VM. Apologies."
(codeRanges := self codeRangesFor: cogMethod) do:
[:range|
+ (cogMethod isCMMethodEtAl) ifTrue:
- (cogMethod cmType = CMMethod) ifTrue:
[mapEntries keysAndValuesDo:
[:mcpc :label| | bcpc selectorOrNone |
(((range includes: mcpc) or: [range last + 1 = mcpc])
and: [(AnnotationsWithBytecodePCs includes: label)
and: [range cogMethod stackCheckOffset > 0]]) ifTrue:
[bcpc := self bytecodePCFor: mcpc startBcpc: range startpc in: range cogMethod.
bcpc ~= 0 ifTrue:
[label = #IsSendCall
ifTrue:
[selectorOrNone := (self selectorForSendAt: mcpc annotation: IsSendCall in: cogMethod methodObject).
(selectorOrNone isInteger and: [objectMemory addressCouldBeOop: selectorOrNone]) ifTrue:
[selectorOrNone := objectMemory stringOf: selectorOrNone].
selectorOrNone := ' ', selectorOrNone]
ifFalse: [selectorOrNone := ''].
mapEntries
at: mcpc
put: label, selectorOrNone, ' bc ', bcpc printString, '/', (bcpc + 1) printString]]]].
(cogMethod blockEntryOffset ~= 0
and: [range first = (cogMethod blockEntryOffset + cogMethod asInteger)])
ifTrue:
[aStream nextPutAll: 'blockEntry:'; cr.
self blockDispatchFor: cogMethod
perform: #disassemble:from:to:arg:
arg: aStream]
ifFalse:
[range first > (cogMethod address + cmNoCheckEntryOffset) ifTrue:
[self printMethodHeader: range cogMethod
on: aStream].
self maybeNoteStartpcFor: range.
self disassembleFrom: range first to: range last labels: mapEntries on: aStream]].
aStream nextPutAll: 'startpc: '; print: codeRanges first startpc; cr.
+ (cogMethod isCMMethodEtAl
+ or: [cogMethod isCMOpenPIC]) ifTrue:
- (cogMethod cmType = CMMethod
- or: [cogMethod cmType = CMOpenPIC]) ifTrue:
[[self mapFor: cogMethod
performUntil: #printMapEntry:mcpc:args:
arg: { aStream. codeRanges. cogMethod }]
on: AssertionFailure
do: [:ex|
ex primitiveChangeClassTo: ResumableVMError basicNew. ":) :) :)"
ex resume: nil]].
^cogMethod!
Item was changed:
----- Method: Cogit>>ensureExecutableCodeZone (in category 'memory access') -----
ensureExecutableCodeZone
"On some platforms run-time calls may be required to enable execution and disable
write-protect of the code zone. This is sequenced by ensuring that the code zone is
executable most of the time. Note that any code space modification requires an
icache flush (on processors with such an icache). Hence the least invasive time to
ensure code is executable is post icache flush. Making sure code is writable can be
done either before any bulk edit (e.g. code zone reclamation) or as part of any fine-
grained code modification (e.g. setting an anonymous method's selector)."
<inline: #always>
self cppIf: #DUAL_MAPPED_CODE_ZONE
ifFalse:
[backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
[self cCode: nil inSmalltalk: [| currentAPISelector |
"What's all this crap? We're trying to catch cases where ensureExecutableCodeZone
is called without first calling ensureWritableCodeZone, and vice verse. But there are
lots of exceptions where code is not modified but executability is turned on unnecessarily.
The list of exceptions follows."
currentAPISelector := self debugAPISelector.
self assert: (codeZoneIsExecutableNotWritable not
or: [currentAPISelector == #mapObjectReferencesInMachineCode:
+ or: [currentAPISelector == #freeUnmarkedMachineCode
+ or: [currentAPISelector == #cogitPostGCAction:
+ or: [currentAPISelector == #ceSICMiss:
+ or: [currentAPISelector == #ceCPICMiss:receiver:
+ or: [currentAPISelector == #unlinkSendsOf:isMNUSelector:
+ or: [currentAPISelector == #unlinkSendsTo:andFreeIf:
+ or: [currentAPISelector == #unlinkSendsToMethodsSuchThat:AndFreeIf:
+ or: [currentAPISelector == #followMovableLiteralsAndUpdateYoungReferrers]]]]]]]]])].
- or: [currentAPISelector == #cogitPostGCAction:
- or: [currentAPISelector == #ceSICMiss:
- or: [currentAPISelector == #ceCPICMiss:receiver:
- or: [currentAPISelector == #unlinkSendsOf:isMNUSelector:
- or: [currentAPISelector == #unlinkSendsTo:andFreeIf:
- or: [currentAPISelector == #unlinkSendsToMethodsSuchThat:AndFreeIf:
- or: [currentAPISelector == #followMovableLiteralsAndUpdateYoungReferrers]]]]]]]])].
backEnd makeCodeZoneExecutable.
self cCode: nil inSmalltalk: [codeZoneIsExecutableNotWritable := true. debugAPISelector := self debugAPISelector]]]!
Item was changed:
----- Method: Cogit>>entryPointTagIsSelector: (in category 'in-line cacheing') -----
entryPointTagIsSelector: entryPoint
"Answer if the entryPoint's tag is expected to be a selector reference, as opposed to a class tag."
^entryPoint < methodZoneBase
or: [(entryPoint bitAnd: entryPointMask) = uncheckedEntryAlignment
or: [(entryPoint bitAnd: entryPointMask) = checkedEntryAlignment
+ and: [(self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *') isCMOpenPIC]]]!
- and: [(self cCoerceSimple: entryPoint - cmEntryOffset to: #'CogMethod *') cmType = CMOpenPIC]]]!
Item was changed:
----- Method: Cogit>>fillInCPICHeader:numArgs:numCases:hasMNUCase:selector: (in category 'generate machine code') -----
fillInCPICHeader: pic numArgs: numArgs numCases: numCases hasMNUCase: hasMNUCase selector: selector
"Fill in the header for the ClosedPIC pic. This may be located at the writable mapping."
<var: #pic type: #'CogMethod *'>
<inline: true>
self assert: (objectMemory isYoung: selector) not.
pic cmType: CMClosedPIC.
pic objectHeader: 0.
pic blockSize: closedPICSize.
pic methodObject: 0.
pic methodHeader: 0.
pic selector: selector.
pic cmNumArgs: numArgs.
pic cmHasMovableLiteral: false.
pic cmRefersToYoung: false.
pic cmUsageCount: self initialClosedPICUsageCount.
pic cpicHasMNUCase: hasMNUCase.
pic cPICNumCases: numCases.
pic blockEntryOffset: 0.
+ self assert: pic isCMClosedPIC.
- self assert: pic cmType = CMClosedPIC.
self assert: pic selector = selector.
self assert: pic cmNumArgs = numArgs.
self assert: pic cPICNumCases = numCases.
self assert: closedPICSize = (methodZone roundUpLength: closedPICSize).
self maybeEnableSingleStep
"No simulateDualCodeZoneWriteFor:; we do all the simulated copying in the sender..."!
Item was changed:
----- Method: Cogit>>fillInOPICHeader:numArgs:selector: (in category 'generate machine code') -----
fillInOPICHeader: pic numArgs: numArgs selector: selector
"Fill in the header for the OpenPIC pic. This may be located at the writable mapping."
<var: #pic type: #'CogMethod *'>
<inline: true>
pic cmType: CMOpenPIC.
pic objectHeader: 0.
pic blockSize: openPICSize.
"pic methodObject: 0.""This is also the nextOpenPIC link so don't initialize it"
methodZone addToOpenPICList: pic.
pic methodHeader: 0.
pic selector: selector.
pic cmNumArgs: numArgs.
pic cmHasMovableLiteral: (objectMemory isNonImmediate: selector).
(pic cmRefersToYoung: (objectMemory isYoung: selector)) ifTrue:
[methodZone addToYoungReferrers: pic].
pic cmUsageCount: self initialOpenPICUsageCount.
pic cpicHasMNUCase: false.
pic cPICNumCases: 0.
pic blockEntryOffset: 0.
"This also implicitly flushes the read/write mapped dual zone to the read/execute zone."
backEnd flushICacheFrom: pic asUnsignedInteger - codeToDataDelta to: pic asUnsignedInteger - codeToDataDelta + openPICSize.
+ self assert: pic isCMOpenPIC.
- self assert: pic cmType = CMOpenPIC.
self assert: pic selector = selector.
self assert: pic cmNumArgs = numArgs.
self assert: (backEnd callTargetFromReturnAddress: pic asInteger - codeToDataDelta + missOffset) = (self picAbortTrampolineFor: numArgs).
self assert: openPICSize = (methodZone roundUpLength: openPICSize).
self assertValidDualZoneFrom: pic asUnsignedInteger - codeToDataDelta to: pic asUnsignedInteger - codeToDataDelta + openPICSize.
self maybeEnableSingleStep!
Item was changed:
----- Method: Cogit>>findMethodForStartBcpc:inHomeMethod: (in category 'method map') -----
findMethodForStartBcpc: startbcpc inHomeMethod: cogMethod
<api>
<var: #cogMethod type: #'CogMethod *'>
<returnTypeC: #'CogBlockMethod *'>
"Find the CMMethod or CMBlock that has zero-relative startbcpc as its first bytecode pc.
As this is for cannot resume processing and/or conversion to machine-code on backward
branch, it doesn't have to be fast. Enumerate block returns and map to bytecode pcs."
+ self assert: cogMethod isCMMethodEtAl.
- self assert: cogMethod cmType = CMMethod.
startbcpc = (coInterpreter startPCOfMethodHeader: cogMethod methodHeader) ifTrue:
[^self cCoerceSimple: cogMethod to: #'CogBlockMethod *'].
self assert: cogMethod blockEntryOffset ~= 0.
^self cCoerceSimple: (self blockDispatchTargetsFor: cogMethod
perform: #findBlockMethodWithEntry:startBcpc:
arg: startbcpc)
to: #'CogBlockMethod *'!
Item was changed:
----- Method: Cogit>>firstMappedPCFor: (in category 'method map') -----
firstMappedPCFor: cogMethod
<var: #cogMethod type: #'CogMethod *'>
<inline: true>
+ ^(cogMethod isCMMethodEtAl and: [cogMethod cmIsFullBlock])
- ^(cogMethod cmType < CMClosedPIC and: [cogMethod cmIsFullBlock])
ifTrue: [cogMethod asUnsignedInteger + cbNoSwitchEntryOffset]
ifFalse: [cogMethod asUnsignedInteger + cmNoCheckEntryOffset]!
Item was changed:
----- Method: Cogit>>freePICsWithFreedTargets (in category 'compaction') -----
freePICsWithFreedTargets
| cogMethod count |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
count := 0.
[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod isCMClosedPIC
+ and: [self cPICHasFreedTargets: cogMethod]) ifTrue:
+ [(self writableMethodFor: cogMethod) cmType: CMFree].
- [(cogMethod cmType = CMClosedPIC
- and: [self cPICHasFreedTargets: cogMethod]) ifTrue:
- [cogMethod cmType: CMFree].
cogMethod := methodZone methodAfter: cogMethod.
count := count + 1].
self assert: count = methodZone numMethods!
Item was changed:
----- Method: Cogit>>freeUnmarkedMachineCode (in category 'jit - api') -----
freeUnmarkedMachineCode
"Free machine-code methods whose compiled methods are unmarked
and open PICs whose selectors are not marked, and closed PICs that
refer to unmarked objects."
<api>
<option: #SpurObjectMemory>
| cogMethod freedMethod |
self moveProfileToMethods. "simulation only..."
freedMethod := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod isCMMethodEtAl
- [(cogMethod cmType = CMMethod
and: [(objectMemory isMarked: cogMethod methodObject) not]) ifTrue:
[freedMethod := true.
methodZone freeMethod: cogMethod].
+ (cogMethod isCMOpenPIC
- (cogMethod cmType = CMOpenPIC
and: [(objectMemory isImmediate: cogMethod selector) not
and: [(objectMemory isMarked: cogMethod selector) not]]) ifTrue:
[freedMethod := true.
methodZone freeMethod: cogMethod].
+ (cogMethod isCMClosedPIC
- (cogMethod cmType = CMClosedPIC
and: [self closedPICRefersToUnmarkedObject: cogMethod]) ifTrue:
[freedMethod := true.
methodZone freeMethod: cogMethod].
cogMethod := methodZone methodAfter: cogMethod].
freedMethod ifTrue:
[self unlinkSendsToFree].
self ensureExecutableCodeZone!
Item was changed:
----- Method: Cogit>>linkedSuperSendCacheTags (in category 'analysis') -----
linkedSuperSendCacheTags
"An example; answer the cache tags for linked super sends. They should all be
selectors because super sends don't have their cache tag rewritten when linked."
<doNotGenerate>
| cacheTags |
cacheTags := Set new.
methodZone methodsDo:
[:m|
+ m isCMMethodEtAl ifTrue:
- m cmType = CMMethod ifTrue:
[self sendSitesIn: m do:
[:a :mcpc| | entryPoint |
entryPoint := backEnd callTargetFromReturnAddress: mcpc.
entryPoint > methodZoneBase ifTrue:
[self offsetAndSendTableFor: entryPoint
annotation: a
into:
[:off :table|
off = cmNoCheckEntryOffset ifTrue:
[cacheTags add: (backEnd inlineCacheTagAt: mcpc)]]]]]].
^cacheTags!
Item was changed:
----- Method: Cogit>>mapFor:bcpc:performUntil:arg: (in category 'method map') -----
mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg
"Machine-code <-> bytecode pc mapping support. Evaluate functionSymbol
for each mcpc, bcpc pair in the map until the function returns non-zero,
answering that result, or 0 if it fails to. To cut down on number of arguments.
and to be usable for both pc-mapping and method introspection, we encode
the annotation and the isBackwardBranch flag in the same parameter.
Guilty as charged."
<var: #cogMethod type: #'CogBlockMethod *'>
<var: #functionSymbol declareC: 'sqInt (*functionSymbol)(BytecodeDescriptor *desc, sqInt annotationAndIsBackwardBranch, char *mcpc, sqInt bcpc, void *arg)'>
<var: #arg type: #'void *'>
<inline: true>
| isInBlock mcpc bcpc endbcpc map mapByte homeMethod aMethodObj result
latestContinuation byte descriptor bsOffset nExts annotation |
<var: #descriptor type: #'BytecodeDescriptor *'>
<var: #homeMethod type: #'CogMethod *'>
self assert: cogMethod stackCheckOffset > 0.
mcpc := cogMethod asUnsignedInteger + cogMethod stackCheckOffset.
"The stack check maps to the start of the first bytecode,
the first bytecode being effectively after frame build."
result := self perform: functionSymbol
with: nil
with: 0 + (HasBytecodePC << 1)
with: (self cCoerceSimple: mcpc to: #'char *')
with: startbcpc
with: arg.
result ~= 0 ifTrue:
[^result].
bcpc := startbcpc.
"In both CMMethod and CMBlock cases find the start of the map and
skip forward to the bytecode pc map entry for the stack check."
+ cogMethod isCMMethodEtAl
- cogMethod cmType = CMMethod
ifTrue:
[isInBlock := cogMethod cmIsFullBlock.
homeMethod := self cCoerceSimple: cogMethod to: #'CogMethod *'.
self assert: startbcpc = (coInterpreter startPCOfMethodHeader: homeMethod methodHeader).
map := self mapStartFor: homeMethod.
annotation := (objectMemory byteAt: map) >> AnnotationShift.
self assert: (annotation = IsAbsPCReference
or: [annotation = IsObjectReference
or: [annotation = IsRelativeCall
or: [annotation = IsDisplacementX2N]]]).
latestContinuation := startbcpc.
aMethodObj := homeMethod methodObject.
endbcpc := (objectMemory numBytesOf: aMethodObj) - 1.
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
"If the method has a primitive, skip it and the error code store, if any;
Logically. these come before the stack check and so must be ignored."
bcpc := bcpc + (self deltaToSkipPrimAndErrorStoreIn: aMethodObj
header: homeMethod methodHeader)]
ifFalse:
[isInBlock := true.
self assert: bcpc = cogMethod startpc.
homeMethod := cogMethod cmHomeMethod.
map := self findMapLocationForMcpc: cogMethod asUnsignedInteger + (self sizeof: CogBlockMethod)
inMethod: homeMethod.
self assert: map ~= 0.
annotation := (objectMemory byteAt: map) >> AnnotationShift.
self assert: (annotation >> AnnotationShift = HasBytecodePC "fiducial"
or: [annotation >> AnnotationShift = IsDisplacementX2N]).
[(annotation := (objectMemory byteAt: map) >> AnnotationShift) ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1. "skip fiducial; i.e. the map entry for the pc immediately following the method header."
aMethodObj := homeMethod methodObject.
bcpc := startbcpc - (self blockCreationBytecodeSizeForHeader: homeMethod methodHeader).
bsOffset := self bytecodeSetOffsetForHeader: homeMethod methodHeader.
byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
endbcpc := self nextBytecodePCFor: descriptor at: bcpc exts: -1 in: aMethodObj.
bcpc := startbcpc].
nExts := 0.
self inlineCacheTagsAreIndexes ifTrue:
[enumeratingCogMethod := homeMethod].
"Now skip up through the bytecode pc map entry for the stack check."
[(objectMemory byteAt: map) >> AnnotationShift ~= HasBytecodePC] whileTrue:
[map := map - 1].
map := map - 1.
[(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue: "defensive; we exit on bcpc"
[mapByte >= FirstAnnotation
ifTrue:
[| nextBcpc isBackwardBranch |
annotation := mapByte >> AnnotationShift.
mcpc := mcpc + ((mapByte bitAnd: DisplacementMask) * backEnd codeGranularity).
(self isPCMappedAnnotation: annotation) ifTrue:
[(annotation = IsSendCall
and: [(mapByte := objectMemory byteAt: map - 1) >> AnnotationShift = IsAnnotationExtension]) ifTrue:
[annotation := annotation + (mapByte bitAnd: DisplacementMask).
map := map - 1].
[byte := (objectMemory fetchByte: bcpc ofObject: aMethodObj) + bsOffset.
descriptor := self generatorAt: byte.
isInBlock
ifTrue: [bcpc >= endbcpc ifTrue: [^0]]
ifFalse:
[(descriptor isReturn and: [bcpc >= latestContinuation]) ifTrue: [^0].
(descriptor isBranch or: [descriptor isBlockCreation]) ifTrue:
[| targetPC |
targetPC := self latestContinuationPCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
latestContinuation := latestContinuation max: targetPC].
latestContinuation := self maybeUnsafeJumpContinuation: latestContinuation at: bcpc for: descriptor in: aMethodObj].
nextBcpc := self nextBytecodePCFor: descriptor at: bcpc exts: nExts in: aMethodObj.
descriptor isMapped
or: [isInBlock and: [descriptor isMappedInBlock]]] whileFalse:
[bcpc := nextBcpc.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
isBackwardBranch := descriptor isBranch
and: [self isBackwardBranch: descriptor at: bcpc exts: nExts in: aMethodObj].
result := self perform: functionSymbol
with: descriptor
with: (isBackwardBranch ifTrue: [annotation << 1 + 1] ifFalse: [annotation << 1])
with: (self cCoerceSimple: mcpc to: #'char *')
with: (isBackwardBranch ifTrue: [bcpc - (2 * nExts)] ifFalse: [bcpc])
with: arg.
result ~= 0 ifTrue:
[^result].
bcpc := nextBcpc.
nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]]
ifFalse:
[self assert: (mapByte >> AnnotationShift = IsDisplacementX2N
or: [mapByte >> AnnotationShift = IsAnnotationExtension]).
mapByte < (IsAnnotationExtension << AnnotationShift) ifTrue:
[mcpc := mcpc + ((mapByte - DisplacementX2N << AnnotationShift) * backEnd codeGranularity)]].
map := map - 1].
^0!
Item was changed:
----- Method: Cogit>>markAndTraceMachineCodeForNewSpaceGC (in category 'jit - api') -----
markAndTraceMachineCodeForNewSpaceGC
"Free any methods that refer to unmarked objects, unlinking sends to freed methods."
| pointer cogMethod |
<var: #cogMethod type: #'CogMethod *'>
objectMemory leakCheckNewSpaceGC ifTrue:
[self asserta: self allMachineCodeObjectReferencesValid].
codeModified := false.
pointer := methodZone youngReferrers.
[pointer < methodZone zoneEnd] whileTrue:
[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
cogMethod cmRefersToYoung ifTrue:
[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
+ self assert: (cogMethod isCMMethodEtAl
+ or: [cogMethod isCMOpenPIC]).
- self assert: (cogMethod cmType = CMMethod
- or: [cogMethod cmType = CMOpenPIC]).
(objectMemory isYoung: cogMethod selector) ifTrue:
[objectMemory markAndTrace: cogMethod selector].
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[(objectMemory isYoung: cogMethod methodObject) ifTrue:
[objectMemory markAndTrace: cogMethod methodObject].
self markYoungObjectsIn: cogMethod]].
pointer := pointer + objectMemory wordSize].
objectMemory leakCheckNewSpaceGC ifTrue:
[self asserta: self allMachineCodeObjectReferencesValid].
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
Item was changed:
----- Method: Cogit>>markAndTraceMachineCodeOfMarkedMethods (in category 'jit - api') -----
markAndTraceMachineCodeOfMarkedMethods
"Mark objects in machine-code of marked methods (or open PICs with marked selectors)."
<api>
<option: #SpurObjectMemory>
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
objectMemory leakCheckFullGC ifTrue:
[self asserta: self allMachineCodeObjectReferencesValid].
codeModified := false.
self markAndTraceObjectReferencesInGeneratedRuntime.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod isCMMethodEtAl
- [(cogMethod cmType = CMMethod
and: [objectMemory isMarked: cogMethod methodObject]) ifTrue:
[self markAndTraceLiteralsIn: cogMethod].
+ (cogMethod isCMOpenPIC
- (cogMethod cmType = CMOpenPIC
and: [(objectMemory isImmediate: cogMethod selector)
or: [objectMemory isMarked: cogMethod selector]]) ifTrue:
[self markAndTraceLiteralsIn: cogMethod].
cogMethod := methodZone methodAfter: cogMethod].
objectMemory leakCheckFullGC ifTrue:
[self asserta: self allMachineCodeObjectReferencesValid].
codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
Item was changed:
----- Method: Cogit>>markMethodAndReferents: (in category 'jit - api') -----
markMethodAndReferents: aCogMethod
<api>
<var: #aCogMethod type: #'CogBlockMethod *'>
| cogMethod writableMethod |
+ self assert: (aCogMethod isCMMethodEtAl
+ or: [aCogMethod isCMBlock]).
+ cogMethod := aCogMethod isCMMethodEtAl
- self assert: (aCogMethod cmType = CMMethod
- or: [aCogMethod cmType = CMBlock]).
- cogMethod := aCogMethod cmType = CMMethod
ifTrue: [self cCoerceSimple: aCogMethod to: #'CogMethod *']
ifFalse: [aCogMethod cmHomeMethod].
writableMethod := self writableMethodFor: cogMethod.
writableMethod cmUsageCount: CMMaxUsageCount.
self mapFor: cogMethod
performUntil: #incrementUsageOfTargetIfLinkedSend:mcpc:ignored:
arg: 0!
Item was changed:
----- Method: Cogit>>moveProfileToMethods (in category 'analysis') -----
moveProfileToMethods
"Simulation only counting of instructions per method/pic/trampoline..."
<cmacro: '() 0'>
"Whenever a change in the code zone is about to occur (e.g. compact code zone, free a method)
move all counts to the corresponding Smalltalk objects."
perMethodProfile ifNotNil:
[:pmp|
0 to: trampolineTableIndex - 3 by: 2 do:
[:i| | trampoline total |
total := 0.
trampoline := trampolineAddresses at: i + 1.
trampoline to: (trampolineAddresses at: i + 3) - 1 do:
[:pc| total := total + (instructionProfile at: pc)].
total > 0 ifTrue:
[perMethodProfile at: trampoline put: (perMethodProfile at: trampoline ifAbsent: 0) + total]].
methodZone methodsDo:
[:cogMethod| | total |
total := 0.
cogMethod + 1 to: cogMethod address + cogMethod blockSize do:
[:pc| total := total + (instructionProfile at: pc)].
total > 0 ifTrue:
+ [(cogMethod isCMMethodEtAl
- [(cogMethod cmType = CMMethod
ifTrue: [cogMethod methodObject]
ifFalse:
+ [(cogMethod isCMClosedPIC
+ or: [cogMethod isCMOpenPIC]) ifTrue:
- [(cogMethod cmType = CMClosedPIC
- or: [cogMethod cmType = CMOpenPIC]) ifTrue:
[cogMethod selector]]) ifNotNil:
[:thang|
perMethodProfile at: thang put: (perMethodProfile at: thang ifAbsent: 0) + total]]].
instructionProfile atAllPut: 0]!
Item was changed:
----- Method: Cogit>>noCogMethodsMaximallyMarked (in category 'compaction') -----
noCogMethodsMaximallyMarked
"Check that no method is maximally marked. A maximal mark is an indication the
method has been scanned to increase the usage count of its referent methods."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod isCMFree not
- [(cogMethod cmType ~= CMFree
and: [cogMethod cmUsageCount = CMMaxUsageCount]) ifTrue:
[^false].
cogMethod := methodZone methodAfter: cogMethod].
^true!
Item was changed:
----- Method: Cogit>>printMethodHeader:on: (in category 'disassembly') -----
printMethodHeader: cogMethod on: aStream
<doNotGenerate>
self cCode: ''
inSmalltalk:
[cogMethod isInteger ifTrue:
[^self printMethodHeader: (self cogMethodOrBlockSurrogateAt: cogMethod) on: aStream]].
aStream ensureCr.
cogMethod asInteger printOn: aStream base: 16.
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[aStream crtab; nextPutAll: 'objhdr: '.
cogMethod objectHeader printOn: aStream base: 16].
+ cogMethod isCMBlock ifTrue:
- cogMethod cmType = CMBlock ifTrue:
[aStream crtab; nextPutAll: 'homemth: '.
cogMethod cmHomeMethod asUnsignedInteger printOn: aStream base: 16.
aStream
nextPutAll: ' (offset '; print: cogMethod homeOffset; nextPut: $);
crtab; nextPutAll: 'startpc: '; print: cogMethod startpc].
aStream
crtab; nextPutAll: 'nArgs: '; print: cogMethod cmNumArgs;
tab; nextPutAll: 'type: '; print: cogMethod cmType.
+ (cogMethod cmType ~= 0 and: [cogMethod isCMBlock]) ifTrue:
- (cogMethod cmType ~= 0 and: [cogMethod cmType ~= CMBlock]) ifTrue:
[aStream crtab; nextPutAll: 'blksiz: '.
cogMethod blockSize printOn: aStream base: 16.
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[aStream crtab; nextPutAll: 'method: '.
cogMethod methodObject printOn: aStream base: 16.
aStream crtab; nextPutAll: 'mthhdr: '.
cogMethod methodHeader printOn: aStream base: 16].
aStream crtab; nextPutAll: 'selctr: '.
cogMethod selector printOn: aStream base: 16.
(coInterpreter lookupAddress: cogMethod selector) ifNotNil:
[:string| aStream nextPut: $=; nextPutAll: string].
cogMethod selector = objectMemory nilObject ifTrue:
[aStream space; nextPut: $(; nextPutAll: (coInterpreter stringOf: (coInterpreter maybeSelectorOfMethod: cogMethod methodObject)); nextPut: $)].
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[aStream crtab; nextPutAll: 'blkentry: '.
cogMethod blockEntryOffset printOn: aStream base: 16.
cogMethod blockEntryOffset ~= 0 ifTrue:
[aStream nextPutAll: ' => '.
cogMethod asInteger + cogMethod blockEntryOffset printOn: aStream base: 16]]].
+ cogMethod isCMClosedPIC
- cogMethod cmType = CMClosedPIC
ifTrue:
[aStream crtab; nextPutAll: 'cPICNumCases: '.
cogMethod cPICNumCases printOn: aStream base: 16.
aStream tab; nextPutAll: 'cpicHasMNUCase: ';
nextPutAll: (cogMethod cpicHasMNUCase ifTrue: ['yes'] ifFalse: ['no'])]
ifFalse:
[aStream crtab; nextPutAll: 'stackCheckOffset: '.
cogMethod stackCheckOffset printOn: aStream base: 16.
cogMethod stackCheckOffset > 0 ifTrue:
[aStream nextPut: $/.
cogMethod asInteger + cogMethod stackCheckOffset printOn: aStream base: 16].
+ cogMethod isCMBlock
- cogMethod cmType = CMBlock
ifTrue:
[aStream
crtab;
nextPutAll: 'cbUsesInstVars ';
nextPutAll: (cogMethod cbUsesInstVars ifTrue: ['yes'] ifFalse: ['no'])]
ifFalse:
[aStream
crtab;
nextPutAll: 'cmRefersToYoung: ';
nextPutAll: (cogMethod cmRefersToYoung ifTrue: ['yes'] ifFalse: ['no']);
tab;
nextPutAll: 'cmHasMovableLiteral: ';
nextPutAll: (cogMethod cmHasMovableLiteral ifTrue: ['yes'] ifFalse: ['no']);
tab;
nextPutAll: 'cmIsFullBlock: ';
nextPutAll: (cogMethod cmIsFullBlock ifTrue: ['yes'] ifFalse: ['no'])].
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[([cogMethod nextMethodOrIRCs] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
[:nmoircs| aStream crtab; nextPutAll: 'nextMethodOrIRCs: '.
nmoircs = 0 ifTrue: [aStream print: nmoircs] ifFalse: [coInterpreter printHex: nmoircs]].
([cogMethod counters] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil:
[:cntrs| aStream crtab; nextPutAll: 'counters: '.
cntrs = 0 ifTrue: [aStream print: cntrs] ifFalse: [coInterpreter printHex: cntrs]]]].
aStream cr; flush!
Item was changed:
----- Method: Cogit>>profileDataFor:withDetails: (in category 'profiling primitives') -----
profileDataFor: cogMethod withDetails: withDetails
"Answers characteristic data for the type of the cogMethod, answering
a CompiledMethod for a compiled method,
a selector for an open PIC
if withDetails then an array containing a selector followed by pairs of class and target method for a closed PIC, otherwise simply a selector."
<inline: true>
<var: #cogMethod type: #'CogMethod *'>
+ ^cogMethod isCMMethodEtAl
- ^cogMethod cmType = CMMethod
ifTrue: [cogMethod methodObject]
+ ifFalse: [(withDetails and: [cogMethod isCMClosedPIC])
- ifFalse: [(withDetails and: [cogMethod cmType = CMClosedPIC])
ifTrue: [self createCPICData: cogMethod]
ifFalse: [cogMethod selector]]!
Item was changed:
----- Method: Cogit>>relocateCallsAndSelfReferencesInMethod: (in category 'compaction') -----
relocateCallsAndSelfReferencesInMethod: cogMethod
<var: #cogMethod type: #'CogMethod *'>
| refDelta callDelta |
refDelta := cogMethod objectHeader.
callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
+ self assert: (cogMethod isCMMethodEtAl or: [cogMethod isCMOpenPIC]).
- self assert: (cogMethod cmType = CMMethod or: [cogMethod cmType = CMOpenPIC]).
self assert: (backEnd callTargetFromReturnAddress: cogMethod asInteger + missOffset)
+ = (cogMethod isCMMethodEtAl
- = (cogMethod cmType = CMMethod
ifTrue: [self methodAbortTrampolineFor: cogMethod cmNumArgs]
ifFalse: [self picAbortTrampolineFor: cogMethod cmNumArgs]).
backEnd relocateCallBeforeReturnPC: cogMethod asInteger + missOffset by: callDelta negated.
self mapFor: cogMethod
performUntil: #relocateIfCallOrMethodReference:mcpc:delta:
arg: refDelta asVoidPointer!
Item was changed:
----- Method: Cogit>>relocateCallsInClosedPIC: (in category 'compaction') -----
relocateCallsInClosedPIC: cPIC
<var: #cPIC type: #'CogMethod *'>
| refDelta callDelta pc entryPoint targetMethod |
<var: #targetMethod type: #'CogMethod *'>
refDelta := cPIC objectHeader.
callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
self assert: (backEnd callTargetFromReturnAddress: cPIC asInteger + missOffset)
= (self picAbortTrampolineFor: cPIC cmNumArgs).
backEnd relocateCallBeforeReturnPC: cPIC asInteger + missOffset by: callDelta negated.
pc := cPIC asInteger + firstCPICCaseOffset.
1 to: cPIC cPICNumCases do:
[:i|
pc := self addressOfEndOfCase: i inCPIC: cPIC.
entryPoint := i = 1
ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
(cPIC containsAddress: entryPoint)
ifTrue:
["Interpret/MNU"
backEnd zoneCallsAreRelative ifFalse: [
i = 1 ifTrue:
[backEnd
relocateJumpLongBeforeFollowingAddress: pc
by: refDelta]
ifFalse:
[backEnd
relocateJumpLongConditionalBeforeFollowingAddress: pc
by: refDelta]]]
ifFalse:
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ self assert: targetMethod isCMMethodEtAl.
- self assert: targetMethod cmType = CMMethod.
i = 1 ifTrue:
[backEnd
relocateJumpLongBeforeFollowingAddress: pc
by: (callDelta - targetMethod objectHeader) negated]
ifFalse:
[backEnd
relocateJumpLongConditionalBeforeFollowingAddress: pc
by: (callDelta - targetMethod objectHeader) negated]]].
self assert: cPIC cPICNumCases > 0.
"Finally relocate the load of the PIC and the jump to the overflow routine ceCPICMiss:receiver:"
backEnd relocateMethodReferenceBeforeAddress: (self addressOfEndOfCase: 2 inCPIC: cPIC)+ backEnd loadPICLiteralByteSize by: refDelta.
backEnd relocateJumpLongBeforeFollowingAddress: cPIC asInteger + cPICEndOfCodeOffset by: callDelta negated!
Item was changed:
----- Method: Cogit>>relocateIfCallOrMethodReference:mcpc:delta: (in category 'compaction') -----
relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: refDeltaArg
<var: #mcpc type: #'char *'>
<var: #refDeltaArg type: #'CogMethod *'> "To placate the C static type system..."
| refDelta callDelta entryPoint targetMethod unlinkedRoutine |
<var: #targetMethod type: #'CogMethod *'>
<var: #nsSendCache type: #'NSSendCache *'>
refDelta := self cCoerceSimple: refDeltaArg to: #sqInt.
callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
NewspeakVM ifTrue:
[| nsSendCache |
annotation = IsNSSendCall ifTrue:
["Retrieve the send cache before relocating the stub call. Fetching the send
cache asserts the stub call points below all the cogged methods, but
until this method is actually moved, the adjusted stub call may appear to
point to somewhere in the method zone."
nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
"Fix call to trampoline. This method is moving [delta] bytes, and calls are
relative, so adjust the call by -[delta] bytes"
backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
nsSendCache target ~= 0 ifTrue: "Send is linked"
[entryPoint := nsSendCache target.
targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ targetMethod isCMMethodEtAl
- targetMethod cmType = CMMethod
ifTrue: "send target not freed; just relocate. The cache has an absolute
target, so only adjust by the target method's displacement."
[nsSendCache target: entryPoint + targetMethod objectHeader]
ifFalse: "send target was freed, unlink"
[self voidNSSendCache: nsSendCache]].
^0]].
(self isPureSendAnnotation: annotation) ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint <= methodZoneBase ifTrue: "send is not linked; just relocate"
[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
^0].
"It's a linked send; find which kind."
self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:offset :sendTable|
targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
+ targetMethod isCMFree not ifTrue: "send target not freed; just relocate."
- targetMethod cmType ~= CMFree ifTrue: "send target not freed; just relocate."
[backEnd
relocateCallBeforeReturnPC: mcpc asInteger
by: (callDelta - targetMethod objectHeader) negated.
SistaVM ifTrue: "See comment in planCompaction"
[methodZone restorePICUsageCount: targetMethod].
^0].
"Target was freed; map back to an unlinked send; but include this method's reocation"
unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
unlinkedRoutine := unlinkedRoutine - callDelta.
backEnd
rewriteInlineCacheAt: mcpc asInteger
tag: (backEnd inlineCacheValueForSelector: targetMethod selector in: enumeratingCogMethod)
target: unlinkedRoutine.
^0]].
annotation = IsRelativeCall ifTrue:
[backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
^0].
annotation = IsAbsPCReference ifTrue:
[backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: refDelta].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>setSelectorOf:to: (in category 'jit - api') -----
setSelectorOf: cogMethod to: aSelectorOop
<api>
"If a method is compiled to machine code via a block entry it won't have a selector.
A subsequent send can find the method and hence fill in the selector."
<var: #cogMethod type: #'CogMethod *'>
"self disassembleMethod: cogMethod"
coInterpreter compilationBreakpoint: aSelectorOop isMNUCase: false.
+ self assert: cogMethod isCMMethodEtAl.
- self assert: cogMethod cmType = CMMethod.
self ensureWritableCodeZone.
(self writableMethodFor: cogMethod) selector: aSelectorOop.
(objectMemory isYoung: aSelectorOop) ifTrue:
[methodZone ensureInYoungReferrers: cogMethod].
self ensureExecutableCodeZone!
Item was changed:
----- Method: Cogit>>simulateCogCodeAt: (in category 'simulation only') -----
simulateCogCodeAt: address "<Integer>"
<doNotGenerate>
| stackZoneBase |
+ (InitializationOptions at: #DUAL_MAPPED_CODE_ZONE ifAbsent: [false]) ifFalse:
+ [backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
+ [self assert: codeZoneIsExecutableNotWritable]].
- backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
- [self assert: codeZoneIsExecutableNotWritable].
stackZoneBase := coInterpreter stackZoneBase.
processor pc: address.
[[[singleStep
ifTrue:
[[processor sp < stackZoneBase ifTrue: [self halt].
self recordProcessing.
self maybeBreakAt: processor pc] value. "So that the Debugger's Over steps over all this"
processorLock critical:
[processor
singleStepIn: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]]
ifFalse:
[processorLock critical:
[processor
runInMemory: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]].
"((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
[(self confirm: 'continue?') ifFalse:
[clickConfirm := false. self halt]]."
true] whileTrue]
on: ProcessorSimulationTrap
do: [:ex| ex applyTo: self].
true] whileTrue!
Item was changed:
----- Method: Cogit>>simulateLeafCallOf: (in category 'simulation only') -----
simulateLeafCallOf: someFunction
"Simulate execution of machine code that leaf-calls someFunction,
answering the result returned by someFunction."
"CogProcessorAlienInspector openFor: coInterpreter"
<doNotGenerate>
| priorSP priorPC priorLR spOnEntry bogusRetPC |
+ self cppIf: #DUAL_MAPPED_CODE_ZONE ifFalse:
+ [backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
+ [self assert: codeZoneIsExecutableNotWritable]].
- backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
- [self assert: codeZoneIsExecutableNotWritable].
self recordRegisters.
priorSP := processor sp.
priorPC := processor pc.
priorLR := backEnd hasLinkRegister ifTrue: [processor lr].
processor
simulateLeafCallOf: someFunction
nextpc: (bogusRetPC := 16rBADF00D5 roundTo: backEnd codeGranularity)
memory: coInterpreter memory.
spOnEntry := processor sp.
self recordInstruction: {'(simulated call of '. someFunction. ')'}.
^[[[processor pc between: self class guardPageSize and: methodZone zoneEnd] whileTrue:
[singleStep
ifTrue: [self recordProcessing.
self maybeBreakAt: processor pc.
processorLock critical:
[processor
singleStepIn: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]]
ifFalse: [processorLock critical:
[processor
runInMemory: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: methodZone zoneEnd]]]]
on: ProcessorSimulationTrap, Error
do: [:ex|
"Again this is a hack for the processor simulators not properly simulating returns to bogus addresses.
In this case BochsX64Alien doesn't do the right thing."
processor pc = bogusRetPC ifTrue:
[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}.
^processor cResultRegister].
ex isProcessorSimulationTrap ifFalse:
[ex pass].
ex applyTo: self.
ex type == #return ifTrue:
[^processor cResultRegister]].
processor pc = bogusRetPC ifTrue:
[self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
processor cResultRegister]
ensure:
[processor sp: priorSP.
processor pc: priorPC.
priorLR ifNotNil: [:lr| processor lr: lr]]!
Item was changed:
----- Method: Cogit>>sqMakeMemoryExecutableFrom:To:CodeToDataDelta: (in category 'initialization') -----
sqMakeMemoryExecutableFrom: startAddress To: endAddress CodeToDataDelta: codeToDataDeltaPtr
<doNotGenerate>
"Simulate setting executable permissions on the code zone. In production this will apply execute permission
to startAddress throguh endAddress - 1. If starting up in the DUAL_MAPPED_CODE_ZONE regime then it
will also create a writable mapping for the code zone and assign the distance from executable zone to the
+ writable zone through codeToDataDeltaPtr. If in this regime when simulating, the CogVMSimulator will
- writable zone throguh codeToDataDeltaPtr. If in this regime when simulating, the CogVMSimulator will
have allocated twice as much code memory as asked for (see CogVMSimulator openOn:extraMemory:) and
so simply set the delta to the code size."
(InitializationOptions at: #DUAL_MAPPED_CODE_ZONE ifAbsent: [false]) ifTrue:
+ [codeToDataDeltaPtr at: 0 put: coInterpreter cogCodeSize + Cogit guardPageSize]!
- [codeToDataDeltaPtr at: 0 put: coInterpreter cogCodeSize]!
Item was changed:
----- Method: Cogit>>subMethodsAsRangesFor: (in category 'method map') -----
subMethodsAsRangesFor: surrogateOrAddress
<doNotGenerate>
| cogMethod codeRanges |
cogMethod := surrogateOrAddress isInteger
ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress]
ifFalse: [surrogateOrAddress].
+ ^cogMethod isCMMethodEtAl ifTrue:
- ^cogMethod cmType = CMMethod ifTrue:
[codeRanges := self codeRangesFor: cogMethod.
^codeRanges size > 1 "omit the block dispatch range"
ifTrue: [codeRanges allButLast]
ifFalse: [codeRanges]]!
Item was changed:
----- Method: Cogit>>unlinkAllSends (in category 'jit - api') -----
unlinkAllSends
<api>
"Unlink all sends in cog methods."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase ifNil: [^self].
self ensureWritableCodeZone.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
methodZone voidOpenPICList.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl
- [cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfLinkedSend:pc:ignored:
arg: 0]
ifFalse:
+ [cogMethod isCMFree ifFalse:
- [cogMethod cmType ~= CMFree ifTrue:
[methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod].
"After updating inline caches we need to flush the icache."
backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart!
Item was changed:
----- Method: Cogit>>unlinkIfFreeOrLinkedSend:pc:of: (in category 'in-line cacheing') -----
unlinkIfFreeOrLinkedSend: annotation pc: mcpc of: theSelector
<var: #mcpc type: #'char *'>
<var: #theSelector type: #'CogMethod *'> "To placate the C static type system..."
- <var: #nsSendCache type: #'NSSendCache *'>
| entryPoint |
+ <var: #nsSendCache type: #'NSSendCache *'>
NewspeakVM ifTrue:
[| nsSendCache |
annotation = IsNSSendCall ifTrue:
[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
(entryPoint := nsSendCache target) ~= 0 ifTrue:
[ | targetMethod |
targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ (targetMethod isCMFree
- (targetMethod cmType = CMFree
or: [nsSendCache selector = (self cCoerceSimple: theSelector to: #sqInt)]) ifTrue:
[self voidNSSendCache: nsSendCache]].
^0 "keep scanning"]].
(self isPureSendAnnotation: annotation) ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase
ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
+ (targetMethod isCMFree
- (targetMethod cmType = CMFree
or: [targetMethod selector = (self cCoerceSimple: theSelector to: #sqInt)]) ifTrue:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfInvalidClassSend:pc:ignored: (in category 'in-line cacheing') -----
unlinkIfInvalidClassSend: annotation pc: mcpc ignored: superfluity
<var: #mcpc type: #'char *'>
<var: #nsSendCache type: #'NSSendCache *'>
| entryPoint |
NewspeakVM ifTrue:
[| nsSendCache |
annotation = IsNSSendCall ifTrue:
[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
(nsSendCache classTag ~= objectRepresentation illegalClassTag
and: [objectMemory isForwardedClassIndex: nsSendCache classTag]) ifTrue:
[self voidNSSendCache: nsSendCache]].
"Should we check if the enclosing object's class is forwarded as well?"
^0 "keep scanning"].
(self isPureSendAnnotation: annotation) ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue: "It's a linked send, but maybe a super send or linked to an OpenPIC, in which case the cache tag will be a selector...."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
((self annotationIsForUncheckedEntryPoint: annotation)
+ or: [targetMethod isCMOpenPIC]) ifFalse:
- or: [targetMethod cmType = CMOpenPIC]) ifFalse:
[(objectMemory isValidClassTag: (backEnd inlineCacheTagAt: mcpc asInteger)) ifFalse:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkIfLinkedSendToFree:pc:ignored: (in category 'in-line cacheing') -----
unlinkIfLinkedSendToFree: annotation pc: mcpc ignored: superfluity
<var: #mcpc type: #'char *'>
+ | entryPoint |
<var: #nsSendCache type: #'NSSendCache *'>
<var: #nsTargetMethod type: #'CogMethod *'>
- | entryPoint |
NewspeakVM ifTrue:
[| nsSendCache nsTargetMethod |
annotation = IsNSSendCall ifTrue:
[nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
(entryPoint := nsSendCache target) ~= 0 ifTrue: "It's a linked send."
[nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ nsTargetMethod isCMFree ifTrue:
- nsTargetMethod cmType = CMFree ifTrue:
[self voidNSSendCache: nsSendCache]].
^0 "keep scanning"]].
(self isPureSendAnnotation: annotation) ifTrue:
[entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue: "It's a linked send."
[self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
+ targetMethod isCMFree ifTrue:
- targetMethod cmType = CMFree ifTrue:
[self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
^0 "keep scanning"!
Item was changed:
----- Method: Cogit>>unlinkSendsLinkedForInvalidClasses (in category 'jit - api') -----
unlinkSendsLinkedForInvalidClasses
<api>
<option: #SpurObjectMemory>
"Unlink all sends in cog methods whose class tag is that of a forwarded class."
| cogMethod freedPIC |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase ifNil: [^self].
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
codeModified := freedPIC := false.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl
- [cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfInvalidClassSend:pc:ignored:
arg: 0]
ifFalse:
+ [(cogMethod isCMClosedPIC
- [(cogMethod cmType = CMClosedPIC
and: [self cPICHasForwardedClass: cogMethod]) ifTrue:
[methodZone freeMethod: cogMethod.
freedPIC := true]].
cogMethod := methodZone methodAfter: cogMethod].
freedPIC
ifTrue: [self unlinkSendsToFree]
ifFalse:
[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]]!
Item was changed:
----- Method: Cogit>>unlinkSendsOf:isMNUSelector: (in category 'jit - api') -----
unlinkSendsOf: selector isMNUSelector: isMNUSelector
<api>
"Unlink all sends in cog methods. Free all Closed PICs with the selector,
or with an MNU case if isMNUSelector. First check if any method actually
has the selector; if not there can't be any linked send to it. This routine
(including descendents) is performance critical. It contributes perhaps
30% of entire execution time in Compiler recompileAll."
| cogMethod mustScanAndUnlink |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase ifNil: [^self].
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
mustScanAndUnlink := false.
isMNUSelector
ifTrue:
[[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMFree ifFalse:
- [cogMethod cmType ~= CMFree ifTrue:
[cogMethod cpicHasMNUCase
ifTrue:
+ [self assert: cogMethod isCMClosedPIC.
- [self assert: cogMethod cmType = CMClosedPIC.
methodZone freeMethod: cogMethod.
mustScanAndUnlink := true]
ifFalse:
[cogMethod selector = selector ifTrue:
[mustScanAndUnlink := true.
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[methodZone freeMethod: cogMethod]]]].
cogMethod := methodZone methodAfter: cogMethod]]
ifFalse:
[[cogMethod < methodZone limitZony] whileTrue:
+ [(cogMethod isCMFree not
- [(cogMethod cmType ~= CMFree
and: [cogMethod selector = selector]) ifTrue:
[mustScanAndUnlink := true.
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[methodZone freeMethod: cogMethod]].
cogMethod := methodZone methodAfter: cogMethod]].
mustScanAndUnlink ifFalse:
[^self].
codeModified := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl ifTrue:
- [cogMethod cmType = CMMethod ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfFreeOrLinkedSend:pc:of:
arg: (self cCoerceSimple: selector to: #'CogMethod *')].
cogMethod := methodZone methodAfter: cogMethod].
codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart].
"And ensure code zone is executable. May merely have freed methods..."
self ensureExecutableCodeZone!
Item was changed:
----- Method: Cogit>>unlinkSendsTo:andFreeIf: (in category 'jit - api') -----
unlinkSendsTo: targetMethodObject andFreeIf: freeIfTrue
<api>
"Unlink all sends in cog methods to a particular target method.
If targetMethodObject isn't actually a method (perhaps being
used via invokeAsMethod) then there's nothing to do."
| cogMethod targetMethod freedPIC |
<var: #cogMethod type: #'CogMethod *'>
<var: #targetMethod type: #'CogMethod *'>
((objectMemory isOopCompiledMethod: targetMethodObject)
and: [coInterpreter methodHasCogMethod: targetMethodObject]) ifFalse:
[^self].
targetMethod := coInterpreter cogMethodOf: targetMethodObject.
methodZoneBase ifNil: [^self].
self ensureWritableCodeZone.
codeModified := freedPIC := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl
- [cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfLinkedSend:pc:to:
arg: targetMethod]
ifFalse:
+ [(cogMethod isCMClosedPIC
- [(cogMethod cmType = CMClosedPIC
and: [self cPIC: cogMethod HasTarget: targetMethod]) ifTrue:
[methodZone freeMethod: cogMethod.
freedPIC := true]].
cogMethod := methodZone methodAfter: cogMethod].
freeIfTrue ifTrue: [self freeMethod: targetMethod].
freedPIC
ifTrue: [self unlinkSendsToFree]
ifFalse:
[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]].
self ensureExecutableCodeZone!
Item was changed:
----- Method: Cogit>>unlinkSendsToFree (in category 'jit - api') -----
unlinkSendsToFree
<api>
"Unlink all sends in cog methods to free methods and/or pics."
| cogMethod |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase ifNil: [^self].
codeModified := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl
- [cogMethod cmType = CMMethod
ifTrue:
[self mapFor: cogMethod
performUntil: #unlinkIfLinkedSendToFree:pc:ignored:
arg: 0]
ifFalse:
+ [cogMethod isCMClosedPIC ifTrue:
- [cogMethod cmType = CMClosedPIC ifTrue:
[self assert: (self noTargetsFreeInClosedPIC: cogMethod)]].
cogMethod := methodZone methodAfter: cogMethod].
codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
Item was changed:
----- Method: Cogit>>unlinkSendsToMethodsSuchThat:AndFreeIf: (in category 'jit - api') -----
unlinkSendsToMethodsSuchThat: criterion AndFreeIf: freeIfTrue
<api>
"Unlink all sends in cog methods to methods with a machine code
primitive, and free machine code primitive methods if freeIfTrue.
To avoid having to scan PICs, free any and all PICs"
<var: 'criterion' declareC: 'sqInt (*criterion)(CogMethod *)'>
| cogMethod freedSomething |
<var: #cogMethod type: #'CogMethod *'>
methodZoneBase ifNil: [^self].
self cCode: nil inSmalltalk: [debugAPISelector := nil].
codeModified := freedSomething := false.
cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
[cogMethod < methodZone limitZony] whileTrue:
+ [cogMethod isCMMethodEtAl
- [cogMethod cmType = CMMethod
ifTrue:
[(freeIfTrue
and: [self perform: criterion with: cogMethod])
ifTrue:
[methodZone freeMethod: cogMethod.
freedSomething := true]
ifFalse:
[self mapFor: cogMethod
performUntil: #unlinkIfLinkedSend:pc:if:
arg: criterion]]
ifFalse:
+ [cogMethod isCMClosedPIC ifTrue:
- [cogMethod cmType = CMClosedPIC ifTrue:
[methodZone freeMethod: cogMethod.
freedSomething := true]].
cogMethod := methodZone methodAfter: cogMethod].
freedSomething
ifTrue: [self unlinkSendsToFree]
ifFalse:
[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]].
self ensureExecutableCodeZone!
Item was changed:
----- Method: RegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
genForwardersInlinedIdenticalOrNotIf: orNot
| nextPC branchDescriptor unforwardRcvr argReg targetPC
unforwardArg rcvrReg postBranchPC retry fixup
comparison rcvrConstant argConstant
needMergeToTarget needMergeToContinue |
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
- <var: #toContinueLabel type: #'AbstractInstruction *'>
- <var: #toTargetLabel type: #'AbstractInstruction *'>
<var: #comparison type: #'AbstractInstruction *'>
<var: #retry type: #'AbstractInstruction *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetPC := target ].
"If an operand is an annotable constant, it may be forwarded, so we need to store it into a
register so the forwarder check can jump back to the comparison after unforwarding the constant.
However, if one of the operand is an unnanotable constant, does not allocate a register for it
(machine code will use operations on constants) and does not generate forwarder checks."
unforwardRcvr := (self ssValue: 1) mayBeAForwarder.
unforwardArg := self ssTop mayBeAForwarder.
(unforwardRcvr not and: [unforwardArg not])
ifTrue: [^self genVanillaInlinedIdenticalOrNotIf: orNot].
self assert: (unforwardArg or: [unforwardRcvr]).
"We use reg for non annotable constants to avoid duplicating objRef."
rcvrConstant := objectRepresentation isUnannotatableConstant: (self ssValue: 1).
argConstant := objectRepresentation isUnannotatableConstant: self ssTop.
self
allocateEqualsEqualsRegistersArgNeedsReg: argConstant not
rcvrNeedsReg: rcvrConstant not
into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
"If not followed by a branch, resolve to true or false."
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
[^self
genIdenticalNoBranchArgIsConstant: argConstant
rcvrIsConstant: rcvrConstant
argReg: argReg
rcvrReg: rcvrReg
orNotIf: orNot].
self assert: (unforwardArg or: [unforwardRcvr]).
self ssPop: 2. "If we had moveAllButTop: 2 volatileSimStackEntriesToRegistersPreserving: we could avoid the extra ssPop:s"
self moveVolatileSimStackEntriesToRegistersPreserving:
(self allocatedRegisters bitOr: (argReg = NoReg
ifTrue: [self registerMaskFor: rcvrReg]
ifFalse:
[rcvrReg = NoReg
ifTrue: [self registerMaskFor: argReg]
ifFalse: [self registerMaskFor: rcvrReg and: argReg]])).
retry := self Label.
self ssPop: -2.
self genCmpArgIsConstant: argConstant rcvrIsConstant: rcvrConstant argReg: argReg rcvrReg: rcvrReg.
self ssPop: 2.
(self fixupAt: nextPC) notAFixup "The next instruction is dead. we can skip it."
ifTrue: [deadCode := true]
ifFalse: [self deny: deadCode]. "push dummy value below"
"self printSimStack; printSimStack: (self fixupAt: postBranchPC) mergeSimStack"
"If there are merges to be performed on the forward branches we have to execute
the merge code only along the path requiring that merge, and exactly once."
needMergeToTarget := self mergeRequiredForJumpTo: targetPC.
needMergeToContinue := self mergeRequiredForJumpTo: postBranchPC.
orNot == branchDescriptor isBranchTrue
ifFalse: "a == b ifTrue: ... or a ~~ b ifFalse: ... jump on equal to target pc"
[fixup := needMergeToContinue
ifTrue: [0] "jumps will fall-through to to-continue merge code"
ifFalse: [self ensureFixupAt: postBranchPC].
comparison := self JumpZero: (needMergeToTarget
ifTrue: [0] "comparison will be fixed up to to-target merge code"
ifFalse: [self ensureFixupAt: targetPC])]
ifTrue: "a == b ifFalse: ... or a ~~ b ifTrue: ... jump on equal to post-branch pc"
[fixup := needMergeToTarget
ifTrue: [0] "jumps will fall-through to to-target merge code"
ifFalse: [self ensureFixupAt: targetPC].
comparison := self JumpZero: (needMergeToContinue
ifTrue: [0] "comparison will be fixed up to to-continue merge code"
ifFalse: [self ensureFixupAt: postBranchPC])].
"The forwarders check(s) need(s) to jump back to the comparison (retry) if a forwarder is found,
else jump forward either to the next forwarder check or to the postBranch or branch target (fixup).
But if there is merge code along a path, the jump must be to the merge code."
(unforwardArg and: [unforwardRcvr]) ifTrue:
[objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: retry].
objectRepresentation
genEnsureOopInRegNotForwarded: (unforwardRcvr ifTrue: [rcvrReg] ifFalse: [argReg])
scratchReg: TempReg
ifForwarder: retry
ifNotForwarder: fixup.
"If fixup is zero then the ifNotForwarder path falls through to a Label which is interpreted
as either to-continue or to-target, depending on orNot == branchDescriptor isBranchTrue."
orNot == branchDescriptor isBranchTrue
ifFalse: "a == b ifTrue: ... or a ~~ b ifFalse: ... jump on equal to target pc"
[needMergeToContinue ifTrue: "fall-through to to-continue merge code"
[self Jump: (self ensureFixupAt: postBranchPC)].
needMergeToTarget ifTrue: "fixup comparison to to-target merge code"
[comparison jmpTarget: self Label.
self Jump: (self ensureFixupAt: targetPC)]]
ifTrue: "a == b ifFalse: ... or a ~~ b ifTrue: ... jump on equal to post-branch pc"
[needMergeToTarget ifTrue: "fall-through to to-target merge code"
[self Jump: (self ensureFixupAt: targetPC)].
needMergeToContinue ifTrue: "fixup comparison to to-continue merge code"
[comparison jmpTarget: self Label.
self Jump: (self ensureFixupAt: postBranchPC)]].
deadCode ifFalse: "duplicate the merge fixup's top of stack so as to avoid a false confict."
[self ssPushDesc: ((self fixupAt: nextPC) mergeSimStack at: simStackPtr + 1)].
^0!
Item was changed:
----- Method: SimpleStackBasedCogit>>genLookupForPerformNumArgs: (in category 'primitive generators') -----
genLookupForPerformNumArgs: numArgs
"Compile the code for a probe of the first-level method cache for a perform primitive.
The selector is assumed to be in Arg0Reg. Defer to adjustArgumentsForPerform: to
adjust the arguments before the jump to the method."
+ | jumpSelectorMiss jumpClassMiss jumpInterpret jumpBadNumArgs itsAHit cacheBaseReg |
- | jumpSelectorMiss jumpClassMiss jumpInterpret itsAHit cacheBaseReg |
- <var: #jumpSelectorMiss type: #'AbstractInstruction *'>
- <var: #jumpClassMiss type: #'AbstractInstruction *'>
- <var: #jumpInterpret type: #'AbstractInstruction *'>
- <var: #itsAHit type: #'AbstractInstruction *'>
"N.B. Can't assume TempReg already contains the tag because a method can
of course be invoked via the unchecked entry-point, e.g. as does perform:."
objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: SendNumArgsReg forEntry: false.
self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
cacheBaseReg := NoReg.
(backEnd isWithinMwOffsetRange: coInterpreter methodCacheAddress) ifFalse:
[self MoveCq: coInterpreter methodCacheAddress R: (cacheBaseReg := Extra0Reg)].
"Do first of three probes. See CoInterpreter>>lookupInMethodCacheSel:classTag:"
jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 0 baseRegOrNone: cacheBaseReg.
jumpClassMiss := self JumpNonZero: 0.
"Fetch the method, and check if it is cogged."
itsAHit := self MoveMw: (cacheBaseReg = NoReg
ifTrue: [coInterpreter methodCacheAddress + (MethodCacheMethod << objectMemory shiftForWord)]
ifFalse: [MethodCacheMethod << objectMemory shiftForWord])
r: ClassReg
R: SendNumArgsReg.
"If the method is not compiled fall back on the interpreter primitive."
objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
jumpInterpret := objectRepresentation genJumpImmediate: ClassReg.
+ "check the argument count; if it's wrong fall back on the interpreter primitive."
+ self genLoadcmNumArgsOf: ClassReg into: SendNumArgsReg.
+ self CmpCq: numArgs R: SendNumArgsReg.
+ jumpBadNumArgs := self JumpNonZero: 0.
+
"Adjust arguments and jump to the method's unchecked entry-point."
self AddCq: cmNoCheckEntryOffset R: ClassReg.
self adjustArgumentsForPerform: numArgs.
self JumpR: ClassReg.
"First probe missed. Do second of three probes. Shift hash right one and retry."
jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 1 baseRegOrNone: cacheBaseReg.
self JumpZero: itsAHit.
"Second probe missed. Do last probe. Shift hash right two and retry."
jumpSelectorMiss jmpTarget: self Label.
jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 2 baseRegOrNone: cacheBaseReg.
self JumpZero: itsAHit.
+ "Last probe missed/not jitted/bad num args. Caller will generate the call to fall back on the interpreter primitive."
- "Last probe missed. Caller will generate the call to fall back on the interpreter primitive."
jumpSelectorMiss jmpTarget:
+ (jumpInterpret jmpTarget:
+ (jumpBadNumArgs jmpTarget: self Label)).
- (jumpInterpret jmpTarget: self Label).
^0!
Item was changed:
----- Method: SistaCogit>>disassembleMethod:on: (in category 'disassembly') -----
disassembleMethod: surrogateOrAddress on: aStream
<doNotGenerate>
| cogMethod |
cogMethod := super disassembleMethod: surrogateOrAddress on: aStream.
+ (cogMethod isCMMethodEtAl
- (cogMethod cmType = CMMethod
and: [cogMethod counters ~= 0]) ifTrue:
[aStream nextPutAll: 'counters:'; cr.
0 to: (objectRepresentation numCountersFor: cogMethod counters) - 1 do:
[:i| | addr |
addr := i * CounterBytes + counters.
addr printOn: aStream base: 16.
aStream nextPut: $:; space.
(objectMemory long32At: addr) printOn: aStream base: 16.
aStream cr].
aStream flush]!
Item was changed:
----- Method: SistaCogit>>picDataForSendTo:methodClassIfSuper:at:bcpc: (in category 'method introspection') -----
picDataForSendTo: cogMethod methodClassIfSuper: methodClassOrNil at: sendMcpc bcpc: sendBcpc
"Answer a tuple with the send data for a linked send to cogMethod.
If the target is a CogMethod (monomorphic send) answer
{ bytecode pc, inline cache class, target method }
If the target is an open PIC (megamorphic send) answer
{ bytecode pc, nil, send selector }
If the target is a closed PIC (polymorphic send) answer
{ bytecode pc, first class, target method, second class, second target method, ... }"
<var: #cogMethod type: #'CogMethod *'>
<var: #sendMcpc type: #'char *'>
| tuple class |
tuple := objectMemory
eeInstantiateClassIndex: ClassArrayCompactIndex
format: objectMemory arrayFormat
+ numSlots: (cogMethod isCMClosedPIC
- numSlots: (cogMethod cmType = CMClosedPIC
ifTrue: [2 * cogMethod cPICNumCases + 1]
ifFalse: [3]).
tuple = 0 ifTrue:
[^0].
objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc).
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[class := methodClassOrNil ifNil:
[objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger)].
objectMemory
storePointer: 1 ofObject: tuple withValue: class;
storePointer: 2 ofObject: tuple withValue: cogMethod methodObject.
^tuple].
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[self populate: tuple withPICInfoFor: cogMethod firstCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger).
^tuple].
+ cogMethod isCMOpenPIC ifTrue:
- cogMethod cmType = CMOpenPIC ifTrue:
[objectMemory
storePointerUnchecked: 1 ofObject: tuple withValue: objectMemory nilObject;
storePointer: 2 ofObject: tuple withValue: cogMethod selector.
^tuple].
self error: 'invalid method type'.
^0 "to get Slang to type this method as answering sqInt"!
Item was changed:
----- Method: SistaCogit>>populate:withPICInfoFor:firstCacheTag: (in category 'method introspection') -----
populate: tuple withPICInfoFor: cPIC firstCacheTag: firstCacheTag
"Populate tuple (which must be large enough) with the ClosedPIC's target method class pairs.
The first entry in tuple contains the bytecode pc for the send, so skip the tuple's first field."
<var: #cPIC type: #'CogMethod *'>
| pc cacheTag classOop entryPoint targetMethod value |
<var: #targetMethod type: #'CogMethod *'>
1 to: cPIC cPICNumCases do:
[:i|
pc := self addressOfEndOfCase: i inCPIC: cPIC.
cacheTag := i = 1
ifTrue: [firstCacheTag]
ifFalse: [backEnd literalBeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize].
classOop := objectRepresentation classForInlineCacheTag: cacheTag.
objectMemory storePointer: i * 2 - 1 ofObject: tuple withValue: classOop.
entryPoint := i = 1
ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
"Find target from jump. A jump to the MNU entry-point should collect #doesNotUnderstand:"
(cPIC containsAddress: entryPoint)
ifTrue:
[value := objectMemory splObj: SelectorDoesNotUnderstand]
ifFalse:
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ self assert: targetMethod isCMMethodEtAl.
- self assert: targetMethod cmType = CMMethod.
value := targetMethod methodObject].
objectMemory storePointer: i * 2 ofObject: tuple withValue: value]!
Item was changed:
----- Method: SistaCogit>>printPICDataForMethods (in category 'tests') -----
printPICDataForMethods
<doNotGenerate>
methodZone methodsDo:
[:cogMethod|
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[(coInterpreter picDataFor: cogMethod) ifNotNil:
[:thePicData|
coInterpreter printOop: thePicData]]]!
Item was changed:
----- Method: SistaCogitClone>>disassembleMethod:on: (in category 'disassembly') -----
disassembleMethod: surrogateOrAddress on: aStream
<doNotGenerate>
| cogMethod |
cogMethod := super disassembleMethod: surrogateOrAddress on: aStream.
+ (cogMethod isCMMethodEtAl
- (cogMethod cmType = CMMethod
and: [cogMethod counters ~= 0]) ifTrue:
[aStream nextPutAll: 'counters:'; cr.
0 to: (objectRepresentation numCountersFor: cogMethod counters) - 1 do:
[:i| | addr |
addr := i * CounterBytes + counters.
addr printOn: aStream base: 16.
aStream nextPut: $:; space.
(objectMemory long32At: addr) printOn: aStream base: 16.
aStream cr].
aStream flush]!
Item was changed:
----- Method: SistaCogitClone>>genByteEqualsInlinePrimitiveResult:returnReg: (in category 'inline primitive generators') -----
genByteEqualsInlinePrimitiveResult: jmp returnReg: reg
"Byte equal is falling through if the result is true, or jumping using jmp if the result is false.
The method is required to set the jump target of jmp.
We look ahead for a branch and pipeline the jumps if possible..
ReturnReg is used only if not followed immediately by a branch."
| branchDescriptor nextPC postBranchPC targetBytecodePC localJump canElide |
+ <var: #jmp type: #'AbstractInstruction *'>
<var: #localJump type: #'AbstractInstruction *'>
<var: #branchDescriptor type: #'BytecodeDescriptor *'>
self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target |
branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
"Case 1 - not followed by a branch"
(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
ifFalse:
[self genMoveTrueR: reg.
localJump := self Jump: 0.
jmp jmpTarget: (self genMoveFalseR: reg).
localJump jmpTarget: self Label.
self ssPushRegister: reg.
^ 0].
"Case 2 - followed by a branch"
(self fixupAt: nextPC) notAFixup
ifTrue: "The next instruction is dead. we can skip it."
[deadCode := true.
self ensureFixupAt: targetBytecodePC.
self ensureFixupAt: postBranchPC ]
ifFalse:
[self ssPushConstant: objectMemory trueObject]. "dummy value"
"We can only elide the jump if the pc after nextPC is the same as postBranchPC.
Branch following means it may not be."
self nextDescriptorExtensionsAndNextPCInto:
[:iguana1 :iguana2 :iguana3 :followingPC| nextPC := followingPC].
canElide := deadCode and: [nextPC = postBranchPC].
branchDescriptor isBranchTrue
ifTrue:
[ self Jump: (self ensureNonMergeFixupAt: targetBytecodePC).
canElide
ifFalse: [ jmp jmpTarget: (self ensureNonMergeFixupAt: postBranchPC) ]
ifTrue: [ jmp jmpTarget: self Label ] ]
ifFalse: [ canElide ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC).
jmp jmpTarget: (self ensureNonMergeFixupAt: targetBytecodePC) ] ].
^0!
Item was changed:
----- Method: SistaCogitClone>>picDataForSendTo:methodClassIfSuper:at:bcpc: (in category 'method introspection') -----
picDataForSendTo: cogMethod methodClassIfSuper: methodClassOrNil at: sendMcpc bcpc: sendBcpc
"Answer a tuple with the send data for a linked send to cogMethod.
If the target is a CogMethod (monomorphic send) answer
{ bytecode pc, inline cache class, target method }
If the target is an open PIC (megamorphic send) answer
{ bytecode pc, nil, send selector }
If the target is a closed PIC (polymorphic send) answer
{ bytecode pc, first class, target method, second class, second target method, ... }"
<var: #cogMethod type: #'CogMethod *'>
<var: #sendMcpc type: #'char *'>
| tuple class |
tuple := objectMemory
eeInstantiateClassIndex: ClassArrayCompactIndex
format: objectMemory arrayFormat
+ numSlots: (cogMethod isCMClosedPIC
- numSlots: (cogMethod cmType = CMClosedPIC
ifTrue: [2 * cogMethod cPICNumCases + 1]
ifFalse: [3]).
tuple = 0 ifTrue:
[^0].
objectMemory storePointerUnchecked: 0 ofObject: tuple withValue: (objectMemory integerObjectOf: sendBcpc).
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[class := methodClassOrNil ifNil:
[objectRepresentation classForInlineCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger)].
objectMemory
storePointer: 1 ofObject: tuple withValue: class;
storePointer: 2 ofObject: tuple withValue: cogMethod methodObject.
^tuple].
+ cogMethod isCMClosedPIC ifTrue:
- cogMethod cmType = CMClosedPIC ifTrue:
[self populate: tuple withPICInfoFor: cogMethod firstCacheTag: (backEnd inlineCacheTagAt: sendMcpc asUnsignedInteger).
^tuple].
+ cogMethod isCMOpenPIC ifTrue:
- cogMethod cmType = CMOpenPIC ifTrue:
[objectMemory
storePointerUnchecked: 1 ofObject: tuple withValue: objectMemory nilObject;
storePointer: 2 ofObject: tuple withValue: cogMethod selector.
^tuple].
self error: 'invalid method type'.
^0 "to get Slang to type this method as answering sqInt"!
Item was changed:
----- Method: SistaCogitClone>>populate:withPICInfoFor:firstCacheTag: (in category 'method introspection') -----
populate: tuple withPICInfoFor: cPIC firstCacheTag: firstCacheTag
"Populate tuple (which must be large enough) with the ClosedPIC's target method class pairs.
The first entry in tuple contains the bytecode pc for the send, so skip the tuple's first field."
<var: #cPIC type: #'CogMethod *'>
| pc cacheTag classOop entryPoint targetMethod value |
<var: #targetMethod type: #'CogMethod *'>
1 to: cPIC cPICNumCases do:
[:i|
pc := self addressOfEndOfCase: i inCPIC: cPIC.
cacheTag := i = 1
ifTrue: [firstCacheTag]
ifFalse: [backEnd literalBeforeFollowingAddress: pc - backEnd jumpLongConditionalByteSize].
classOop := objectRepresentation classForInlineCacheTag: cacheTag.
objectMemory storePointer: i * 2 - 1 ofObject: tuple withValue: classOop.
entryPoint := i = 1
ifTrue: [backEnd jumpLongTargetBeforeFollowingAddress: pc]
ifFalse: [backEnd jumpLongConditionalTargetBeforeFollowingAddress: pc].
"Find target from jump. A jump to the MNU entry-point should collect #doesNotUnderstand:"
(cPIC containsAddress: entryPoint)
ifTrue:
[value := objectMemory splObj: SelectorDoesNotUnderstand]
ifFalse:
[targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
+ self assert: targetMethod isCMMethodEtAl.
- self assert: targetMethod cmType = CMMethod.
value := targetMethod methodObject].
objectMemory storePointer: i * 2 ofObject: tuple withValue: value]!
Item was changed:
----- Method: SistaCogitClone>>printPICDataForMethods (in category 'tests') -----
printPICDataForMethods
<doNotGenerate>
methodZone methodsDo:
[:cogMethod|
+ cogMethod isCMMethodEtAl ifTrue:
- cogMethod cmType = CMMethod ifTrue:
[(coInterpreter picDataFor: cogMethod) ifNotNil:
[:thePicData|
coInterpreter printOop: thePicData]]]!
1
0
16 Mar '23
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog.seperateMarking-eem.3318.mcz
==================== Summary ====================
Name: VMMaker.oscog.seperateMarking-eem.3318
Author: eem
Time: 16 March 2023, 12:58:42.178303 pm
UUID: 784966ef-ca2e-4538-b5a9-dc5504f30fed
Ancestors: VMMaker.oscog.seperateMarking-eem.3317
A few tweaks to the IGC code as part of getting to know it properly. Add a phase counter to SpurIncrementalGarbageCollector and use this in the printing of starting a phase. Add an assert to check that a traced stack page's contents are valid. This isn't quite finished yet; I plan to make (not marked,grey) an invalid state so that "black or grey" and "white" is just a marked bit test. SO for the moment BogusGrey is a misnomer.
Merge VMMaker.oscog-eem.3311.
Fix checkOkayStackPage: for Spur.
=============== Diff against VMMaker.oscog.seperateMarking-eem.3317 ===============
Item was changed:
----- Method: CoInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
incrementalMarkAndTraceStackPage: thePage
- | theSP theFP frameRcvrOffset callerFP oop marker |
<var: #thePage type: #'StackPage *'>
+ | theSP theFP frameRcvrOffset callerFP oop marker |
- <var: #theSP type: #'char *'>
- <var: #theFP type: #'char *'>
- <var: #frameRcvrOffset type: #'char *'>
- <var: #callerFP type: #'char *'>
<staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
<inline: false>
"do not remove. Necessary for resolving polymorphic receiver"
marker := objectMemory marker.
self assert: (stackPages isFree: thePage) not.
self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
self assert: thePage trace ~= StackPageTraced.
thePage trace: StackPageTraced.
theSP := thePage headSP.
+ theFP := thePage headFP.
- theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + objectMemory wordSize].
[frameRcvrOffset := self frameReceiverLocation: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
+ marker markAndScan: oop.
- (objectMemory isImmediate: oop) ifFalse:
- [marker markAndShouldScan: oop].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isContext: (self frameContext: theFP)).
+ marker markAndScan: (self frameContext: theFP)].
- marker markAndShouldScan: (self frameContext: theFP)].
(self isMachineCodeFrame: theFP)
ifTrue: [self markAndTraceMachineCodeMethod: (self mframeCogMethod: theFP)]
+ ifFalse: [marker markAndScan: (self iframeMethod: theFP)].
- ifFalse: [marker markAndShouldScan: (self iframeMethod: theFP)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP + objectMemory wordSize. "caller ip is ceBaseReturnPC"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
+ marker markAndScan: oop.
+ theSP := theSP + objectMemory wordSize].
+ self deny: (self whiteOrBogusGreyObjectsOnStackPage: thePage)!
- (objectMemory isImmediate: oop) ifFalse:
- [marker markAndShouldScan: oop].
- theSP := theSP + objectMemory wordSize]!
Item was changed:
----- Method: CoInterpreter>>mapVMRegisters (in category 'object memory support') -----
mapVMRegisters
"Map the oops in the interpreter's vm ``registers'' to their new values
during garbage collection or a become: operation."
"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.
c.f. followMethodNewMethodAndInstructionPointer.
Override to relocate the instructionPointer relative to newMethod, if required.
In the Cogit the VM may be in a machine code primitive when the GC is invoked.
However, because compaction moves several objects, it is possible for the
compacted method to overlap the pre-compacted newMethod and hence
there's a danger of updating instructionPointer twice."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
| ipdelta |
(objectMemory shouldRemapObj: method) ifTrue:
[ipdelta := (self method: method includesAddress: instructionPointer) ifTrue:
[instructionPointer - method].
method := objectMemory remapObj: method.
ipdelta ifNotNil:
[instructionPointer := method + ipdelta]].
(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
[ipdelta := (ipdelta isNil "don't relocate twice!!!!"
and: [self method: newMethod includesAddress: instructionPointer]) ifTrue:
[instructionPointer - newMethod].
newMethod := objectMemory remapObj: newMethod.
ipdelta ifNotNil:
[instructionPointer := newMethod + ipdelta]]!
Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveBenchmarkScavenge (in category 'benchmark primitives') -----
+ primitiveBenchmarkScavenge
+ <option: #VMBenchmarks>
+ <export: true>
+ self primitiveReturnTimeTakenFor:
+ [objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [objectMemory scavengingGC]
+ ifFalse: [objectMemory incrementalGC].
+ self integerObjectOf: (objectMemory bytesLeft: false)]!
Item was changed:
----- Method: CogStackPageSurrogate>>printOn: (in category 'printing') -----
printOn: aStream
super printOn: aStream.
+ aStream space.
+ self baseAddress printOn: aStream base: 16.
+ aStream nextPut: $@.
+ aStream space; print: address; nextPut: $/.
- aStream nextPut: $@; print: address; nextPut: $/.
address printOn: aStream base: 16!
Item was removed:
- ----- Method: CogVMSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- ^0!
Item was removed:
- ----- Method: InterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- ^0!
Item was changed:
SpurMarker subclass: #SpurAllAtOnceMarker
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+ !SpurAllAtOnceMarker commentStamp: 'eem 3/16/2023 10:17' prior: 0!
+ Marker implementation for the SpurStopTheWorldGarbageCollector. Marks all reachable objects in a single pass.
- !SpurAllAtOnceMarker commentStamp: 'WoC 12/2/2022 23:36' prior: 0!
- Marker implementation for the SpurStopTheWorldGarbageCollector. Marks all reachable objects
+ Instance Variables: inherited!
- Instance Variables
- !
Item was changed:
----- Method: SpurIncremental2PhaseGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
| startTime |
phase = InMarkingPhase
ifTrue: [ | finishedMarking |
marker isCurrentlyMarking
ifFalse: [self assert: manager allObjectsUnmarked.
manager segmentManager prepareForGlobalSweep].
coInterpreter cr; print: 'start marking '; tab; flush.
finishedMarking := marker incrementalMarkObjects.
"self assert: manager validObjectColors."
finishedMarking
ifTrue: [
"manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)]."
"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
We only know if they should get swept after the next marking -> keep them alive for this cycle"
self allocatorShouldAllocateBlack: true.
compactor setInitialSweepingEntity.
+ self phase: InSweepingPhase.
- phase := InSweepingPhase.
"marking is done and thus all forwarding from the last compaction references are resolved
-> we can use the now free segments that were compacted during the last cycle"
compactor freePastSegmentsAndSetSegmentToFill.
compactor assertNoSegmentBeingCompacted.
self assert: manager noObjectGrey.
coInterpreter cr; print: 'finish marking '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
checkFreeSpace: GCModeFull.
manager clearLeakMapAndMapMarkedOrYoungObjects.
coInterpreter checkStackIntegrity.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
0 to: manager numSegments - 1
do: [:i | | segInfo |
segInfo := manager segInfoAt: i.
coInterpreter cr; print: 'occupation from marking: '; printNum: (compactor occupationOf: segInfo) * 100; tab;
print: '('; printNum: (marker getLifeObjectCountOf: segInfo); print: ' objects -> ' ;printNum: (compactor sizeClaimedIn: segInfo) ; print: ' bytes)' ;flush].
manager printSegmentOccupationFromMarkedObjects.
^ self]
ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush. "manager runLeakCheckerFor: GCModeIncremental"]].
phase = InSweepingPhase
ifTrue: [
coInterpreter cr; print: 'start sweeping '; tab; flush.
compactor incrementalSweepAndCompact
ifTrue: [
self allocatorShouldAllocateBlack: false.
self assert: manager allObjectsWhite.
"self assert: manager allObjectsUnmarked."
coInterpreter cr; print: 'finish sweeping '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
+ self phase: InMarkingPhase.
- phase := InMarkingPhase.
fullGCWanted := false.
^ self]]!
Item was changed:
SpurGarbageCollector subclass: #SpurIncrementalGarbageCollector
+ instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags stopTheWorldGC fullGCWanted phaseCounter'
- instanceVariableNames: 'phase allAtOnceMarker checkSetGCFlags stopTheWorldGC fullGCWanted'
classVariableNames: 'InCompactingPhase InMarkingPhase InSweepingPhase'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
!SpurIncrementalGarbageCollector commentStamp: 'WoC 1/5/2023 21:36' prior: 0!
A SpurIncrementalGarbageCollector is a garbage collection algorithm. The GC is a mark and sweep with an additional compaction if certain conditions are fulfilled.
This class manages SpurIncrementalMarker and SpurIncrementalSweepAndCompact (which in turn manages SpurIncrementalCompactor and SpurIncrementalSweeper). The 3 classes
implementing the GC are therefore SpurIncrementalMarker, SpurIncrementalSweeper and SpurIncrementalCompactor.
Instance Variables
allAtOnceMarker: <SpurAllAtOnceMarker>
checkSetGCFlags: <Bool>
phase: <Number (InMarkingPhase|InSweepingPhase|InCompactingPhase)>
allAtOnceMarker
- an instance of SpurAllAtOnceMarker. We sometimes need parts of the old (stop-the-world) gc algorithm. This is the marking algorithm we can use through static polymorphism
checkSetGCFlags
- should we check if it ok to set gc flags or not
phase
- in which phase is the gc algorithm at the moment. Is either InMarkingPhase, InSweepingPhase or InCompactingPhase
!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>doIncrementalCollect (in category 'as yet unclassified') -----
doIncrementalCollect
| startTime |
phase = InMarkingPhase
ifTrue: [ | finishedMarking |
marker isCurrentlyMarking
ifFalse: [self assert: manager allObjectsUnmarked].
+ coInterpreter cr; print: 'start marking '; printNum: (phaseCounter := phaseCounter + 1); tab; flush.
- coInterpreter cr; print: 'start marking '; tab; flush.
finishedMarking := marker incrementalMarkObjects.
"self assert: manager validObjectColors."
finishedMarking
ifTrue: [
manager allPastSpaceObjectsDo: [:obj | self assert: (manager isWhite: obj)].
"when sweeping the mutator needs to allocate new objects black as we do not have any information about them.
We only know if they should get swept after the next marking -> keep them alive for this cycle"
self allocatorShouldAllocateBlack: true.
compactor setInitialSweepingEntity.
+ self phase: InSweepingPhase.
- phase := InSweepingPhase.
"marking is done and thus all forwarding from the last compaction references are resolved
-> we can use the now free segments that were compacted during the last cycle"
compactor freePastSegmentsAndSetSegmentToFill.
manager segmentManager prepareForGlobalSweep.
self assert: manager noObjectGrey.
coInterpreter cr; print: 'finish marking '; tab; flush.
+
-
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull excludeUnmarkedObjs: true classIndicesShouldBeValid: true;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
^ self]
+ ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.
+ manager runLeakCheckerFor: GCModeIncremental]].
- ifFalse: [coInterpreter cr; print: 'finish marking pass'; tab; flush.manager runLeakCheckerFor: GCModeIncremental]].
phase = InSweepingPhase
ifTrue: [
coInterpreter cr; print: 'start sweeping '; tab; flush.
compactor incrementalSweep
ifTrue: [
self allocatorShouldAllocateBlack: false.
manager allOldSpaceObjectsDo: [:ea | self assert: (manager isWhite: ea) ].
"self assert: manager allObjectsUnmarked."
coInterpreter cr; print: 'finish sweeping '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
compactor assertNoSegmentBeingCompacted.
+ self phase: InCompactingPhase.
- phase := InCompactingPhase.
^ self]].
phase = InCompactingPhase
ifTrue: [
"self cCode: 'raise(SIGINT)'."
coInterpreter cr; print: 'start compacting '; tab; flush.
compactor isCurrentlyCompacting
ifFalse: [manager printFreeSpaceStatistics].
compactor incrementalCompact
ifTrue: [
coInterpreter cr; print: 'finish compacting '; tab; flush.
startTime := coInterpreter ioUTCMicrosecondsNow.
manager
setCheckForLeaks: GCCheckFreeSpace + GCModeFull;
runLeakCheckerFor: GCModeFull;
checkFreeSpace: GCModeFull.
coInterpreter cr; print: 'time for internal check: '; printNum: coInterpreter ioUTCMicrosecondsNow - startTime; tab; flush.
+ self phase: InMarkingPhase.
- phase := InMarkingPhase.
fullGCWanted := false.
^ self]]!
Item was changed:
----- Method: SpurIncrementalGarbageCollector>>initialize (in category 'initialize-release') -----
initialize
super initialize.
checkSetGCFlags := true.
+ phase := InMarkingPhase. phaseCounter := 0.
- phase := InMarkingPhase.
fullGCWanted := false.
allAtOnceMarker := SpurAllAtOnceMarker new.
stopTheWorldGC := SpurStopTheWorldGarbageCollector new.
stopTheWorldGC marker: allAtOnceMarker.
stopTheWorldGC compactor: SpurPlanningCompactor new!
Item was changed:
SpurMarker subclass: #SpurIncrementalMarker
instanceVariableNames: 'isCurrentlyMarking'
classVariableNames: 'SlotLimitPerPass'
poolDictionaries: ''
category: 'VMMaker-SpurGarbageCollector'!
+ !SpurIncrementalMarker commentStamp: 'eem 3/16/2023 10:19' prior: 0!
+ Marker for the SpurIncrementalGarbageCollector. It mark objects in old space (and only in old space!!) incrementally, in batches.
- !SpurIncrementalMarker commentStamp: 'WoC 1/4/2023 00:21' prior: 0!
- Marker for the SpurIncrementalGarbageCollector. It is concipated to mark objects in old space (and only in old space!!) while beeing able to be interrupted
Roots are:
- Stack references
- hidden objects
- extra objects
+ - (surviving) young space objects
- - young space objects
Instance Variables
+ isCurrentlyMarking: <Boolean>
- isCurrentlyMarking: <Object>
isCurrentlyMarking
+ - true if in the mark phase!
- - xxxxx
- !
Item was added:
+ ----- Method: SpurIncrementalMarker>>markAndScan: (in category 'marking - incremental') -----
+ markAndScan: objOop
+ "marks the object (grey or black as neccessary) and returns if the object should be scanned
+ This is simply the non-inlined version of markAndShouldScan:"
+
+ <inline: #never>
+ ^self markAndShouldScan: objOop!
Item was changed:
----- Method: SpurIncrementalMarker>>markAndShouldScan: (in category 'marking - incremental') -----
markAndShouldScan: objOop
"marks the object (grey or black as neccessary) and returns if the object should be scanned
Objects that get handled later on get marked as black, as they are practically a leaf in the object tree (we scan them later on, so we cannot lose objects and do not
need to adhere to the tricolor invariant)"
| format |
<inline: true>
+ ((manager isImmediate: objOop)
+ or: [manager isYoung: objOop])
- (manager isYoung: objOop)
ifTrue: [^ false].
- (manager isImmediate: objOop) ifTrue:
- [^false].
-
self assert: (manager isForwarded: objOop) not.
"if it is marked we already did everything we needed to do and if is grey we already saw it and do not have to do anything here"
+ (manager isWhite: objOop) ifFalse:
- (manager isWhite: objOop) not ifTrue:
[^false].
format := manager formatOf: objOop.
(manager isPureBitsFormat: format) ifTrue: "avoid pushing non-pointer objects on the markStack."
["Avoid tracing classes of non-objects on the heap, e.g. IRC caches, Sista counters."
(manager classIndexOf: objOop) > manager lastClassIndexPun ifTrue:
[self markAndTraceClassOf: objOop].
"the object does not need to enter the marking stack as there are no pointer to visit -> it is already finished and we can make it black"
self blackenObject: objOop.
^false].
(manager isWeakFormat: format) ifTrue: "push weaklings on the weakling stack to scan later"
[manager push: objOop onObjStack: manager weaklingStack.
"do not follow weak references. They get scanned at the end of marking -> it should be ok to not follow the tricolor invariant"
self blackenObject: objOop.
^false].
((manager isEphemeronFormat: format)
and: [manager activeAndDeferredScan: objOop]) ifTrue:
[self blackenObject: objOop.
^false].
"we know it is an object that can contain we have to follow"
self pushOnMarkingStackAndMakeGrey: objOop.
^ true!
Item was added:
+ ----- Method: SpurMemoryManager>>isWhiteOrBogusGrey: (in category 'header access') -----
+ isWhiteOrBogusGrey: objOop
+ "Answer if the object is either white, or grey but unmarked"
+
+ ^(self isMarked: objOop) not!
Item was changed:
----- Method: SpurMemoryManager>>printHeaderOf: (in category 'debug printing') -----
printHeaderOf: objOop
<export: true> "useful for VM debugging; use export: not api, so it will be accessible on win32 and won't be written to cointerp.h"
"N.B. No safety bounds checks!!!! We need to look e.g. at corpses."
coInterpreter printHexnp: objOop.
(self hasOverflowHeader: objOop)
ifTrue: [coInterpreter
print: ' hdr16 slotf '; printHexnp: (self numSlotsOfAny: objOop - self allocationUnit);
print: ' slotc '; printHexnp: (self rawOverflowSlotsOf: objOop); space]
ifFalse: [coInterpreter print: ' hdr8 slots '; printHexnp: (self numSlotsOfAny: objOop)].
coInterpreter
space;
+ printChar: ((self isImmutable: objOop) ifTrue: [$I] ifFalse: [$i]);
- printChar: ((self isMarked: objOop) ifTrue: [$M] ifFalse: [$m]);
- printChar: ((self isGrey: objOop) ifTrue: [$G] ifFalse: [$g]);
printChar: ((self isPinned: objOop) ifTrue: [$P] ifFalse: [$p]);
printChar: ((self isRemembered: objOop) ifTrue: [$R] ifFalse: [$r]);
+ printChar: ((self isMarked: objOop) ifTrue: [$M] ifFalse: [$m]);
+ printChar: ((self isGrey: objOop) ifTrue: [$G] ifFalse: [$g]);
- printChar: ((self isImmutable: objOop) ifTrue: [$I] ifFalse: [$i]);
print: ' hash '; printHexnp: (self rawHashBitsOf: objOop);
print: ' fmt '; printHexnp: (self formatOf: objOop);
print: ' cidx '; printHexnp: (self classIndexOf: objOop);
cr!
Item was changed:
----- Method: SpurMemoryManager>>printHeaderTypeOf:on: (in category 'debug printing interpreter support') -----
printHeaderTypeOf: obj on: aStream
<var: 'aStream' type: #'FILE *'>
<inline: true>
+ ' hdr%d %c%c%c%c%c%c' f: aStream printf: {
- ' hdr%d %c%c%c%c%c' f: aStream printf: {
(self hasOverflowHeader: obj) ifTrue: [16] ifFalse: [8].
(self isImmutable: obj) ifTrue: [$i] ifFalse: [$.].
- (self isRemembered: obj) ifTrue: [$r] ifFalse: [$.].
(self isPinned: obj) ifTrue: [$p] ifFalse: [$.].
+ (self isRemembered: obj) ifTrue: [$r] ifFalse: [$.].
+ (self isMarked: obj)
+ ifTrue: [(self isGrey: obj) ifTrue: [$G] ifFalse: [$M]]
+ ifFalse: [(self isGrey: obj) ifTrue: [$!!] ifFalse: [$W]].
(self isMarked: obj) ifTrue: [$m] ifFalse: [$.].
(self isGrey: obj) ifTrue: [$g] ifFalse: [$.] }!
Item was changed:
----- Method: SpurSegmentManager>>segmentContainingObj: (in category 'accessing') -----
segmentContainingObj: objOop
+ "Answer the segment containing an object. This is mostly for assert checking, but
+ variations on the incremental GC may use it in anger. Binary search is (of course)
+ marginally slower than linear search for a single segment (e.g. in a 720k object heap,
+ 67.1ms vs 61.3ms, or 9.5% slower to derive the segment containing every old space
+ entity), but usefully faster for many segments (e.g. 92.7ms vs 116ms, or 20% faster
+ in the same heap extended with enough large arrays to require 11 segments; and this
+ is pessimal; there are fewer objects at high addresses since the large arrays are there)."
<export: true>
<returnTypeC: #'SpurSegmentInfo *'>
+ | high low mid seg |
+ low := 0. mid := numSegments // 2. high := numSegments - 1.
+ [seg := segments at: mid.
+ (self oop: objOop isGreaterThanOrEqualTo: seg segStart)
+ ifTrue:
+ [mid = high
+ ifTrue:
+ [^(self oop: objOop isLessThan: seg segLimit) ifTrue:
+ [seg]]
+ ifFalse:
+ [low := mid.
+ mid := mid + high + 1 // 2]]
+ ifFalse:
+ [high := mid - 1.
+ mid := low + mid // 2].
+ low <= high] whileTrue.
- numSegments - 1 to: 0 by: -1 do:
- [:i|
- objOop >= (segments at: i) segStart ifTrue:
- [^self addressOf: (segments at: i)]].
^nil!
Item was changed:
----- Method: StackInterpreter>>checkOkayStackPage: (in category 'debug support') -----
checkOkayStackPage: thePage
- | theSP theFP ok frameRcvrOffset callerFP oop |
<var: #thePage type: #'StackPage *'>
+ | theSP theFP ok frameRcvrOffset callerFP oop |
- <var: #theSP type: #'char *'>
- <var: #theFP type: #'char *'>
- <var: #frameRcvrOffset type: #'char *'>
- <var: #callerFP type: #'char *'>
<inline: false>
theSP := thePage headSP.
theFP := thePage headFP.
ok := true.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + objectMemory wordSize].
[frameRcvrOffset := self frameReceiverLocation: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
+ (objectMemory isImmediate: oop) ifFalse:
- (objectMemory isIntegerObject: oop) ifFalse:
[ok := ok & (self checkOkayFields: oop)].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isContext: (self frameContext: theFP)).
ok := ok & (self checkOkayFields: (self frameContext: theFP))].
ok := ok & (self checkOkayFields: (self frameMethodObject: theFP)).
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
theFP := callerFP].
theSP := self isCog
ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
+ (objectMemory isImmediate: oop) ifFalse:
- (objectMemory isIntegerObject: oop) ifFalse:
[ok := ok & (self checkOkayFields: oop)].
theSP := theSP + objectMemory wordSize].
^ok!
Item was changed:
----- Method: StackInterpreter>>incrementalMarkAndTraceStackPage: (in category 'object memory support') -----
incrementalMarkAndTraceStackPage: thePage
- | theSP theFP frameRcvrOffset callerFP oop marker |
<var: #thePage type: #'StackPage *'>
+ | theSP theFP frameRcvrOffset callerFP oop marker |
- <var: #theSP type: #'char *'>
- <var: #theFP type: #'char *'>
- <var: #frameRcvrOffset type: #'char *'>
- <var: #callerFP type: #'char *'>
<staticallyResolveReceiver: 'marker' to: #SpurIncrementalMarker>
<inline: false>
"do not remove. Necessary for resolving polymorphic receiver"
marker := objectMemory marker.
self assert: (stackPages isFree: thePage) not.
self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
thePage trace: StackPageTraced.
theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage ifFalse:
[theSP := theSP + objectMemory wordSize].
[frameRcvrOffset := self frameReceiverLocation: theFP.
[theSP <= frameRcvrOffset] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
+ marker markAndScan: oop.
- (objectMemory isImmediate: oop) ifFalse:
- [marker markAndShouldScan: oop].
theSP := theSP + objectMemory wordSize].
(self frameHasContext: theFP) ifTrue:
[self assert: (objectMemory isContext: (self frameContext: theFP)).
+ marker markAndScan: (self frameContext: theFP)].
+ marker markAndScan: (self iframeMethod: theFP).
- marker markAndShouldScan: (self frameContext: theFP)].
- marker markAndShouldScan: (self iframeMethod: theFP).
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
theFP := callerFP].
theSP := theFP + FoxCallerSavedIP. "caller ip is frameCallerContext in a base frame"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isOopForwarded: oop) ifTrue:
[oop := objectMemory followForwarded: oop.
stackPages longAt: theSP put: oop].
+ marker markAndScan: oop.
+ theSP := theSP + objectMemory wordSize].
+ self deny: (self whiteOrBogusGreyObjectsOnStackPage: thePage)!
- (objectMemory isImmediate: oop) ifFalse:
- [marker markAndShouldScan: oop].
- theSP := theSP + objectMemory wordSize]!
Item was changed:
----- Method: StackInterpreter>>incrementalMarkAndTraceStackPages (in category 'object memory support') -----
incrementalMarkAndTraceStackPages
"GC of pages. Throwing away all stack pages on full GC is simple but dangerous
because it causes us to allocate lots of contexts immediately before a GC.
Reclaiming pages whose top context is not referenced is poor because it would
take N incrementalGCs to reclaim N unused pages. Only the page whose top
context is not referred to by the bottom context of any other page would be
+ reclaimed. Not until the next GC would the page whose top context is the
- reclaimed. Not until the next GC would the page whose top contect is the
previously reclaimed page's base frame's bottom context be reclaimed.
Better is to not mark stack pages until their contexts are encountered. We can
eagerly trace the active page and the page reachable from its bottom context
if any, and so on. Other pages can be marked when we encounter a married
context."
| thePage |
<inline: false>
0 to: numStackPages - 1 do:
+ [:i|
+ thePage := stackPages stackPageAt: i.
+ (stackPages isFree: thePage) ifFalse:
+ [thePage trace ~= StackPageTraced
+ ifTrue: [self incrementalMarkAndTraceStackPage: thePage]
+ ifFalse: [self deny: (self whiteOrBogusGreyObjectsOnStackPage: thePage)]]].
+ ^nil!
- [:i|
- thePage := stackPages stackPageAt: i.
- (stackPages isFree: thePage) ifFalse:
- [self incrementalMarkAndTraceStackPage: thePage]].
- ^nil!
Item was changed:
----- Method: StackInterpreter>>mapVMRegisters (in category 'object memory support') -----
mapVMRegisters
"Map the oops in the interpreter's vm ``registers'' to their new values
during garbage collection or a become: operation."
"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.
c.f. followMethodNewMethodAndInstructionPointer."
+ <declareTypeForStaticPolymorphism: #SpurStopTheWorldGarbageCollector>
(objectMemory shouldRemapObj: method) ifTrue:
[instructionPointer := instructionPointer - method. "*rel to method"
method := objectMemory remapObj: method.
instructionPointer := instructionPointer + method]. "*rel to method"
(objectMemory shouldRemapOop: newMethod) ifTrue: "maybe oop due to object-as-method"
[newMethod := objectMemory remapObj: newMethod]!
Item was added:
+ ----- Method: StackInterpreter>>objectsInStackZoneDo: (in category 'object memory support') -----
+ objectsInStackZoneDo: aQuinaryBlock
+ "Evaluate aTrinaryBlock with the stackPage, frame pointer, stack pointer (location) and oop of all objects in all stack pages."
+ <doNotGenerate>
+ 0 to: numStackPages - 1 do:
+ [:i| | thePage |
+ thePage := stackPages stackPageAt: i.
+ (stackPages isFree: thePage) ifFalse:
+ [self objectsOnStackPage: thePage do: [:theFP :theSP :oop| aQuinaryBlock value: thePage value: theFP value: theSP value: oop]]]!
Item was added:
+ ----- Method: StackInterpreter>>objectsOnStackPage:do: (in category 'object memory support') -----
+ objectsOnStackPage: thePage do: aTrinaryBlock
+ "Evaluate aTrinaryBlock with the frame pointer, stack pointer (location) and oop of all objects in the stackPage."
+ <doNotGenerate>
+ | theSP theFP frameRcvrOffset callerFP |
+ self deny: (stackPages isFree: thePage).
+ self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
+
+ theSP := thePage headSP.
+ theFP := thePage headFP.
+ "Skip the instruction pointer on top of stack of inactive pages."
+ thePage = stackPage ifFalse:
+ [theSP := theSP + objectMemory wordSize].
+ [frameRcvrOffset := self frameReceiverLocation: theFP.
+ [theSP <= frameRcvrOffset] whileTrue:
+ [aTrinaryBlock value: theFP value: theSP value: (stackPages longAt: theSP).
+ theSP := theSP + objectMemory wordSize].
+ (self frameHasContext: theFP) ifTrue:
+ [self assert: (objectMemory isContext: (self frameContext: theFP)).
+ aTrinaryBlock value: theFP value: theFP + FoxThisContext value: (self frameContext: theFP)].
+ aTrinaryBlock value: theFP value: theFP + FoxMethod value: (self frameMethodObject: theFP).
+ (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
+ theFP := callerFP].
+ theSP := self isCog
+ ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
+ ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
+ [theSP <= thePage baseAddress] whileTrue:
+ [aTrinaryBlock value: theFP value: theSP value: (stackPages longAt: theSP).
+ theSP := theSP + objectMemory wordSize]!
Item was added:
+ ----- Method: StackInterpreter>>whiteObjectsOnStackPage: (in category 'debug support') -----
+ whiteObjectsOnStackPage: thePage
+ "Answer if the page refers directly to any white objects."
+ <var: #thePage type: #'StackPage *'>
+ | theSP theFP frameRcvrOffset callerFP oop |
+ theSP := thePage headSP.
+ theFP := thePage headFP.
+ "Skip the instruction pointer on top of stack of inactive pages."
+ thePage = stackPage ifFalse:
+ [theSP := theSP + objectMemory wordSize].
+ [frameRcvrOffset := self frameReceiverLocation: theFP.
+ [theSP <= frameRcvrOffset] whileTrue:
+ [oop := stackPages longAt: theSP.
+ ((objectMemory isNonImmediate: oop)
+ and: [objectMemory isWhite: oop]) ifTrue:
+ [^true].
+ theSP := theSP + objectMemory wordSize].
+ (self frameHasContext: theFP) ifTrue:
+ [self assert: (objectMemory isContext: (self frameContext: theFP)).
+ (objectMemory isWhite: (self frameContext: theFP)) ifTrue:
+ [^true]].
+ (objectMemory isWhite: (self frameMethodObject: theFP)) ifTrue:
+ [^true].
+ (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
+ theFP := callerFP].
+ theSP := self isCog
+ ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
+ ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
+ [theSP <= thePage baseAddress] whileTrue:
+ [oop := stackPages longAt: theSP.
+ ((objectMemory isNonImmediate: oop)
+ and: [objectMemory isWhite: oop]) ifTrue:
+ [^true].
+ theSP := theSP + objectMemory wordSize].
+ ^false!
Item was added:
+ ----- Method: StackInterpreter>>whiteOrBogusGreyObjectsOnStackPage: (in category 'debug support') -----
+ whiteOrBogusGreyObjectsOnStackPage: thePage
+ "Answer if the page refers directly to any white objects."
+ <var: #thePage type: #'StackPage *'>
+ | theSP theFP frameRcvrOffset callerFP oop |
+ theSP := thePage headSP.
+ theFP := thePage headFP.
+ "Skip the instruction pointer on top of stack of inactive pages."
+ thePage = stackPage ifFalse:
+ [theSP := theSP + objectMemory wordSize].
+ [frameRcvrOffset := self frameReceiverLocation: theFP.
+ [theSP <= frameRcvrOffset] whileTrue:
+ [oop := stackPages longAt: theSP.
+ ((objectMemory isNonImmediate: oop)
+ and: [(objectMemory isOldObject: oop)
+ and: [objectMemory isWhiteOrBogusGrey: oop]]) ifTrue:
+ [^true].
+ theSP := theSP + objectMemory wordSize].
+ (self frameHasContext: theFP) ifTrue:
+ [self assert: (objectMemory isContext: (oop := self frameContext: theFP)).
+ ((objectMemory isOldObject: oop)
+ and: [objectMemory isWhiteOrBogusGrey: oop]) ifTrue:
+ [^true]].
+ ((objectMemory isOldObject: (oop := self frameMethodObject: theFP))
+ and: [objectMemory isWhiteOrBogusGrey: oop]) ifTrue:
+ [^true].
+ (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
+ theFP := callerFP].
+ theSP := self isCog
+ ifTrue: [theFP + FoxCallerSavedIP + objectMemory wordSize] "caller ip is ceBaseReturnPC"
+ ifFalse: [theFP + FoxCallerSavedIP]. "caller ip is frameCallerContext in a base frame"
+ [theSP <= thePage baseAddress] whileTrue:
+ [oop := stackPages longAt: theSP.
+ ((objectMemory isNonImmediate: oop)
+ and: [(objectMemory isOldObject: oop)
+ and: [objectMemory isWhiteOrBogusGrey: oop]]) ifTrue:
+ [^true].
+ theSP := theSP + objectMemory wordSize].
+ ^false!
Item was removed:
- ----- Method: StackInterpreterSimulator>>sqMemoryExtraBytesLeft: (in category 'memory access') -----
- sqMemoryExtraBytesLeft: includingSwap
- ^0!
1
0
13 Mar '23
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!
1
0
[OpenSmalltalk/opensmalltalk-vm] e1f63d: CogVM source as per VMMaker.oscog-eem.3310
by Eliot Miranda 12 Mar '23
by Eliot Miranda 12 Mar '23
12 Mar '23
Branch: refs/heads/virtend
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: e1f63d78f437b25df2490c5d9f5eea1b6f5656fc
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/e1f63d78f437b25df2…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2023-03-11 (Sat, 11 Mar 2023)
Changed paths:
M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c
M src/plugins/SqueakFFIPrims/ARM64AppleFFIPlugin.c
M src/plugins/SqueakFFIPrims/ARM64FFIPlugin.c
M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c
M src/plugins/SqueakFFIPrims/RiscV64FFIPlugin.c
M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c
M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.3310
ThreadedFFIPlugin.
Fix ThreadedFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs:'s use of
ffiCheckReturn:With:in: so ffiCheckReturn:With:in: can be inlined.
ThreadedARM64FFIPlugin. pass structures as defined by the
ARM Procedure Call Standard for the ARM 64-bit Architecture,
IHI0055B_aapcs64.pdf, 22nd May 2013.
Fixes the crashes guarded for by FFIPluginTests>>#arm64Check.
1
0
[OpenSmalltalk/opensmalltalk-vm] fa509b: CogVM source as per VMMaker.oscog-eem.3310
by Eliot Miranda 12 Mar '23
by Eliot Miranda 12 Mar '23
12 Mar '23
Branch: refs/heads/Cog
Home: https://github.com/OpenSmalltalk/opensmalltalk-vm
Commit: fa509bdab0d91771e64b58c58eb96a927b81446c
https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/fa509bdab0d91771e6…
Author: Eliot Miranda <eliot.miranda(a)gmail.com>
Date: 2023-03-11 (Sat, 11 Mar 2023)
Changed paths:
M src/plugins/SqueakFFIPrims/ARM32FFIPlugin.c
M src/plugins/SqueakFFIPrims/ARM64AppleFFIPlugin.c
M src/plugins/SqueakFFIPrims/ARM64FFIPlugin.c
M src/plugins/SqueakFFIPrims/IA32FFIPlugin.c
M src/plugins/SqueakFFIPrims/RiscV64FFIPlugin.c
M src/plugins/SqueakFFIPrims/X64SysVFFIPlugin.c
M src/plugins/SqueakFFIPrims/X64Win64FFIPlugin.c
Log Message:
-----------
CogVM source as per VMMaker.oscog-eem.3310
ThreadedFFIPlugin.
Fix ThreadedFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs:'s use of
ffiCheckReturn:With:in: so ffiCheckReturn:With:in: can be inlined.
ThreadedARM64FFIPlugin. pass structures as defined by the
ARM Procedure Call Standard for the ARM 64-bit Architecture,
IHI0055B_aapcs64.pdf, 22nd May 2013.
Fixes the crashes guarded for by FFIPluginTests>>#arm64Check.
1
0