[Vm-dev] VM Maker: VMMaker.oscog-eem.3140.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Jan 19 19:35:38 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3140.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3140
Author: eem
Time: 19 January 2022, 11:35:24.48811 am
UUID: 92e5f37d-acf4-411c-ab3f-8f85b766ca3d
Ancestors: VMMaker.oscog-eem.3139
Interpreter: restore the long riunning primiitve check, but this time compiled in conditinally via -DLRPCheck.
Slang: ITIMER_HEARTBEAT (as well as LRPCheck) needs to be included in names defined at compile time.
fix an extra cr in generating functions that have functional results (e.g. genInvokeInterpretTrampoline).
VMMaker: Add an openInterpreterMultiWindowBrowser convenience.
Comment typoes.
=============== Diff against VMMaker.oscog-eem.3139 ===============
Item was changed:
----- Method: CoInterpreter>>forceInterruptCheckFromHeartbeat (in category 'process primitive support') -----
forceInterruptCheckFromHeartbeat
"Force an interrupt check ASAP. This version is the
entry-point to forceInterruptCheck for the heartbeat
timer to allow for repeatable debugging."
suppressHeartbeatFlag ifFalse:
+ [self checkForLongRunningPrimitive.
+ self sqLowLevelMFence.
- [self sqLowLevelMFence.
deferSmash
ifTrue:
[deferredSmash := true.
self sqLowLevelMFence]
ifFalse:
[self forceInterruptCheck]]!
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlagsForSpur: (in category 'cog jit support') -----
primitivePropertyFlagsForSpur: primIndex
<inline: true>
"Answer any special requirements of the given primitive. Spur always needs to set
primitiveFunctionPointer and newMethod so primitives can retry on failure due to forwarders."
| baseFlags |
self cCode: [] inSmalltalk: [#( primitiveObjectAtPut primitiveCopyObject primitiveSpurStringReplace
primitiveSpurFloatArrayAt primitiveSpurFloatArrayAtPut
primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
baseFlags := profileSemaphore = objectMemory nilObject
ifTrue: [0]
ifFalse: [PrimCallCollectsProfileSamples].
(primIndex = PrimNumberObjectAtPut
or: [primIndex = PrimNumberCopyObject
or: [primIndex = PrimNumberStringReplace
or: [primIndex = PrimNumberShortArrayAt
or: [primIndex = PrimNumberShortArrayAtPut]]]]) ifTrue:
[^baseFlags + PrimCallOnSmalltalkStack].
(primIndex = PrimNumberFloatArrayAt
or: [primIndex = PrimNumberFloatArrayAtPut]) ifTrue:
[^baseFlags + PrimCallOnSmalltalkStack + PrimCallOnSmalltalkStackAlign2x].
+ "N.B. if and when this changes remember to add back support for the longRunningPrimitiveCheck"
baseFlags := baseFlags + PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod.
(self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks & module unloading"
[^baseFlags + PrimCallMayEndureCodeCompaction + PrimCallIsExternalCall].
(self isCodeCompactingPrimitiveIndex: primIndex) ifTrue: "For code reclamations"
[^baseFlags bitOr: PrimCallMayEndureCodeCompaction].
^baseFlags!
Item was changed:
----- Method: CoInterpreter>>primitivePropertyFlagsForV3: (in category 'cog jit support') -----
primitivePropertyFlagsForV3: primIndex
<inline: true>
"Answer any special requirements of the given primitive"
| baseFlags |
baseFlags := profileSemaphore ~= objectMemory nilObject
ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
ifFalse: [0].
+ self cppIf: #LRPCheck
+ ifTrue:
+ [longRunningPrimitiveCheckSemaphore ifNotNil:
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod]].
+
(self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks & module unloading"
[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayEndureCodeCompaction + PrimCallIsExternalCall].
(self isCodeCompactingPrimitiveIndex: primIndex) ifTrue:
[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction].
^baseFlags!
Item was changed:
----- Method: CoInterpreterMT>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
checkForEventsMayContextSwitch: mayContextSwitch
"Check for possible interrupts and handle one if necessary.
Answer if a context switch has occurred."
| switched sema now |
<inline: false>
<var: #now type: #usqLong>
self assertSaneThreadAndProcess.
cogit assertCStackWellAligned.
statCheckForEvents := statCheckForEvents + 1.
"restore the stackLimit if it has been smashed."
self restoreStackLimit.
self externalWriteBackHeadFramePointers.
self assert: stackPage = stackPages mostRecentlyUsedPage.
"Allow the platform to do anything it needs to do synchronously."
self ioSynchronousCheckForEvents.
self checkCogCompiledCodeCompactionCalledFor.
objectMemory needGCFlag ifTrue:
["sufficientSpaceAfterGC: runs the incremental GC and
then, if not enough space is available, the fullGC."
(objectMemory sufficientSpaceAfterGC: 0) ifFalse:
[self setSignalLowSpaceFlagAndSaveProcess]].
mayContextSwitch ifFalse: [^false].
switched := false.
self assert: deferThreadSwitch not.
deferThreadSwitch := true.
(profileProcess ~= objectMemory nilObject
or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
[self zeroNextProfileTick.
"Take a sample (if not already done so) for the profiler if it is active. This
must be done before any of the synchronousSignals below or else we will
attribute a pause in ioRelinquishProcessor to the newly activated process."
profileProcess = objectMemory nilObject ifTrue:
[profileProcess := self activeProcess.
profileMethod := objectMemory nilObject].
"and signal the profiler semaphore if it is present"
(profileSemaphore ~= objectMemory nilObject
and: [self synchronousSignal: profileSemaphore]) ifTrue:
[switched := true]].
+ self cppIf: #LRPCheck
+ ifTrue:
+ [self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
+ [switched := true]].
+
objectMemory signalLowSpace ifTrue:
[objectMemory signalLowSpace: false. "reset flag"
sema := objectMemory splObj: TheLowSpaceSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
"inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
ioProcessEvents e.g. for native GUIs. We would like to manage that here but can't
since the platform code may choose to call ioProcessEvents itself in various places."
false
ifTrue:
[((now := self ioUTCMicroseconds) >= nextPollUsecs
and: [inIOProcessEvents = 0]) ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
inIOProcessEvents := inIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
inIOProcessEvents > 0 ifTrue:
[inIOProcessEvents := inIOProcessEvents - 1].
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]]
ifFalse:
[(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]].
interruptPending ifTrue:
[interruptPending := false.
"reset interrupt flag"
sema := objectMemory splObj: TheInterruptSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
nextWakeupUsecs ~= 0 ifTrue:
[now >= nextWakeupUsecs ifTrue:
[nextWakeupUsecs := 0.
"set timer interrupt to 0 for 'no timer'"
sema := objectMemory splObj: TheTimerSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]]].
"signal any pending finalizations"
pendingFinalizationSignals > 0 ifTrue:
[pendingFinalizationSignals := 0.
sema := objectMemory splObj: TheFinalizationSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
"signal all semaphores in semaphoresToSignal"
self signalExternalSemaphores ifTrue:
[switched := true].
deferThreadSwitch := false.
checkThreadActivation ifTrue:
[checkThreadActivation := false.
self cedeToHigherPriorityThreads]. "N.B. This may not return if we do switch."
self threadSwitchIfNecessary: self activeProcess from: CSCheckEvents.
^switched!
Item was changed:
----- Method: CoInterpreterMT>>forceInterruptCheckFromHeartbeat (in category 'process primitive support') -----
forceInterruptCheckFromHeartbeat
"Force an interrupt check ASAP. This version is the
entry-point to forceInterruptCheck for the heartbeat
timer to allow for repeatable debugging.
N.B. SYNCHRONIZE WITH deferStackLimitSmashAround:"
suppressHeartbeatFlag ifFalse:
+ [self checkForLongRunningPrimitive.
+ self sqLowLevelMFence.
- [self sqLowLevelMFence.
deferSmash
ifTrue:
[deferredSmash := true.
self sqLowLevelMFence]
ifFalse:
[self forceInterruptCheck.
self checkVMOwnershipFromHeartbeat]]!
Item was added:
+ ----- Method: CoInterpreterPrimitives>>primitiveLongRunningPrimitiveSemaphore (in category 'process primitives') -----
+ primitiveLongRunningPrimitiveSemaphore
+ "Primitive. Install the semaphore to be used for collecting long-running primitives,
+ or nil if no semaphore should be used."
+ <export: true>
+ <option: #LRPCheck>
+ | sema flushState activeContext |
+ self methodArgumentCount ~= 1 ifTrue:
+ [^self primitiveFailFor: PrimErrBadNumArgs].
+ sema := self stackValue: 0.
+ sema = objectMemory nilObject
+ ifTrue:
+ [flushState := longRunningPrimitiveCheckSemaphore notNil.
+ longRunningPrimitiveCheckSemaphore := nil]
+ ifFalse:
+ [flushState := longRunningPrimitiveCheckSemaphore isNil.
+ (objectMemory isSemaphoreOop: sema) ifFalse:
+ [^self primitiveFailFor: PrimErrBadArgument].
+ longRunningPrimitiveCheckSemaphore := sema].
+ "If we've switched checking on or off we must void machine code
+ (and machine code pcs in contexts) since we will start or stop setting
+ newMethod in machine code primitive invocations, and so generate
+ slightly different code from here on in."
+ flushState ifTrue:
+ [self push: instructionPointer.
+ activeContext := self voidVMStateForSnapshotFlushingExternalPrimitivesIf: false.
+ self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
+ self assert: (((self stackValue: 0) = objectMemory nilObject and: [longRunningPrimitiveCheckSemaphore isNil])
+ or: [(self stackValue: 0) = longRunningPrimitiveCheckSemaphore
+ and: [objectMemory isSemaphoreOop: sema]])].
+ self voidLongRunningPrimitive: 'install'.
+ self pop: 1.
+ flushState ifTrue:
+ [cogit ceInvokeInterpret]!
Item was changed:
----- Method: CogX64Compiler>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
"Generate the code to pass up to four arguments in a C run-time call. Hack: each argument is either
a negative number, which encodes a positive constant, or a non-negative number, that of a register.
The encoding for constants is defined by trampolineArgConstant: & trampolineArgValue:.
Pass a constant as the result of trampolineArgConstant:.
Run-time calls have no more than four arguments, so chosen so that on ARM32, where in its C ABI
the first four integer arguments are passed in registers, all arguments can be passed in registers.
We defer to the back end to generate this code not so much that the back end knows whether it
uses the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil
reason. Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments
in an order that allows some of the argument registers to be used for specific abstract registers,
specifically ReceiverResultReg and ClassReg. This is evil, evil, evil, but also it's really nice to keep
using the old register assignments the original author has grown accustomed to.
How can this possibly work? Look at Cogit class>>runtime for a list of the run-time calls and their
arguments, including which arguments are passed in which registers. Look at CogX64Compiler's
subclass implementations of initializeAbstractRegisters. There are no calls in which ReceiverResultReg
(RDX) and/or ClassReg (RCX) are passed along with Arg0Reg and Arg1Reg, and none in which the use of
either ReceiverResultReg or ClassReg conflict for args 3 & 4. So if args are assigned in order, the
registers do not get overwritten. Yes, this is evil, but it's so nice to continue to use RCX & RDX.
Argument registers for args 0 to 3 in SysV are RDI RSI RDX RCX, and in Win64 are RCX RDX R8 R9"
<inline: true>
SysV ifFalse: "WIN64 ABI allways reserve shadow space on the stack for callee to save up to 4 register parameters"
[cogit SubCq: 32 R: RSP].
- numArgs = 0 ifTrue: [^self].
self assert: numArgs <= 4.
+ numArgs > 0 ifTrue:
+ [(cogit isTrampolineArgConstant: regOrConst0)
+ ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst0) R: CArg0Reg] "a.k.a. Arg0Reg"
- (cogit isTrampolineArgConstant: regOrConst0)
- ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst0) R: CArg0Reg] "a.k.a. Arg0Reg"
- ifFalse:
- [regOrConst0 ~= CArg0Reg ifTrue:
- [cogit MoveR: regOrConst0 R: CArg0Reg]].
- numArgs = 1 ifTrue: [^self].
- (cogit isTrampolineArgConstant: regOrConst1)
- ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst1) R: CArg1Reg] "a.k.a. Arg1Reg"
- ifFalse:
- [regOrConst1 ~= CArg1Reg ifTrue:
- [cogit MoveR: regOrConst1 R: CArg1Reg]].
- numArgs = 2 ifTrue: [^self].
- (cogit isTrampolineArgConstant: regOrConst2)
- ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst2) R: CArg2Reg] "a.k.a. ReceiverResultReg (SysV) ClassReg (Win64)"
- ifFalse:
- [regOrConst2 ~= CArg2Reg ifTrue:
- [cogit MoveR: regOrConst2 R: CArg2Reg]].
- numArgs = 3 ifTrue: [^self].
- (cogit isTrampolineArgConstant: regOrConst3)
- ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst3) R: CArg3Reg] "a.k.a. ClassReg (SysV) ReceiverResultReg (Win64)"
ifFalse:
+ [regOrConst0 ~= CArg0Reg ifTrue:
+ [cogit MoveR: regOrConst0 R: CArg0Reg]].
+ numArgs > 1 ifTrue:
+ [(cogit isTrampolineArgConstant: regOrConst1)
+ ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst1) R: CArg1Reg] "a.k.a. Arg1Reg"
+ ifFalse:
+ [regOrConst1 ~= CArg1Reg ifTrue:
+ [cogit MoveR: regOrConst1 R: CArg1Reg]].
+ numArgs > 2 ifTrue:
+ [(cogit isTrampolineArgConstant: regOrConst2)
+ ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst2) R: CArg2Reg] "a.k.a. ReceiverResultReg (SysV) ClassReg (Win64)"
+ ifFalse:
+ [regOrConst2 ~= CArg2Reg ifTrue:
+ [cogit MoveR: regOrConst2 R: CArg2Reg]].
+ numArgs > 3 ifTrue:
+ [(cogit isTrampolineArgConstant: regOrConst3)
+ ifTrue: [cogit MoveCq: (cogit trampolineArgValue: regOrConst3) R: CArg3Reg] "a.k.a. ClassReg (SysV) ReceiverResultReg (Win64)"
+ ifFalse:
+ [regOrConst3 ~= CArg3Reg ifTrue:
+ [cogit MoveR: regOrConst3 R: CArg3Reg]]]]]]!
- [regOrConst3 ~= CArg3Reg ifTrue:
- [cogit MoveR: regOrConst3 R: CArg3Reg]]!
Item was changed:
----- Method: Cogit class>>defineAtCompileTime: (in category 'C translation') -----
defineAtCompileTime: anObject
"Override to define at translation time those variables that need to
be defined at compile time only in plugins, but not in the main VM,
because the VM generated is specific to these varables."
anObject isSymbol ifFalse:
[^false].
(#(STACKVM COGVM COGMTVM SPURVM) includes: anObject) ifTrue:
[^false].
+ ^VMBasicConstants defineAtCompileTime: anObject!
- ^VMBasicConstants namesDefinedAtCompileTime includes: anObject!
Item was changed:
----- Method: InterpreterPrimitives class>>defineAtCompileTime: (in category 'C translation') -----
defineAtCompileTime: anObject
"Override to define at translation time those variables that need to
be defined at compile time only in plugins, but not in the main VM,
because the VM generated is specific to these varables."
anObject isSymbol ifFalse:
[^false].
(#(STACKVM COGVM COGMTVM SPURVM) includes: anObject) ifTrue:
[^false].
+ ^VMBasicConstants defineAtCompileTime: anObject!
- ^VMBasicConstants namesDefinedAtCompileTime includes: anObject!
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 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 primitiveFunctionPointer and newMethod"
(flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
[self MoveCw: primitiveRoutine asInteger R: TempReg.
self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
(flags anyMask: PrimCallNeedsNewMethod+PrimCallMayEndureCodeCompaction) ifTrue:
["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
(flags anyMask: PrimCallMayEndureCodeCompaction) ifTrue:
[needsFrame := true].
methodLabel addDependent:
(self annotateAbsolutePCRef:
(self MoveCw: methodLabel asInteger R: ClassReg)).
self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
self MoveR: TempReg Aw: coInterpreter newMethodAddress].
"Invoke the primitive. If the primitive (potentially) contains a call-back then its code
may disappear and consequently we cannot return here, sicne 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:
["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders
are found. So insist on PrimCallNeedsPrimitiveFunction being set too."
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction)].
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.
- "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 anyMask: PrimCallIsInternalPrim)
- and: [backEnd isWithinCallRange: primitiveRoutine asInteger])
- ifTrue: [self CallRT: primitiveRoutine asInteger]
- ifFalse: [self CallFullRT: primitiveRoutine asInteger].
backEnd genRemoveNArgsFromStack: 0.
objectRepresentation maybeCompileRetryOnPrimitiveFail: primitiveIndex.
"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:
InterpreterPrimitives subclass: #StackInterpreter
(excessive size, no diff calculated)
Item was changed:
----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
| vmClass |
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
aCCodeGenerator
addHeaderFile: '<stdio.h> /* for printf */';
addHeaderFile: '<stdlib.h> /* for e.g. alloca */';
addHeaderFile: '<setjmp.h>';
addHeaderFile: '<wchar.h> /* for wint_t */';
addHeaderFile: '"vmCallback.h"';
addHeaderFile: '"sqMemoryFence.h"';
addHeaderFile: '"sqImageFileAccess.h"';
addHeaderFile: '"sqSetjmpShim.h"';
addHeaderFile: '"dispdbg.h"'.
LowcodeVM ifTrue:
[aCCodeGenerator addHeaderFile: '"sqLowcodeFFI.h"'].
vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
aCCodeGenerator
var: #interpreterProxy type: #'struct VirtualMachine*'.
aCCodeGenerator
declareVar: #sendTrace type: 'volatile int';
declareVar: #byteCount type: #usqLong. "see dispdbg.h"
"These need to be pointers or unsigned."
self declareC: #(instructionPointer method newMethod)
as: #usqInt
in: aCCodeGenerator.
"These are all pointers; char * because Slang has no support for C pointer arithmetic."
self declareC: #(localIP localSP localFP stackPointer framePointer stackLimit breakSelector)
as: #'char *'
in: aCCodeGenerator.
aCCodeGenerator
var: #breakSelectorLength
declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
self declareC: #(stackPage overflowedPage)
as: #'StackPage *'
in: aCCodeGenerator.
aCCodeGenerator
var: #transcript type: #'FILE *'.
aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code."
"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
is not defined, for the benefit of the interpreter on slow machines."
aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
MULTIPLEBYTECODESETS == false ifTrue:
[aCCodeGenerator
removeVariable: 'bytecodeSetSelector'].
BytecodeSetHasExtensions == false ifTrue:
[aCCodeGenerator
removeVariable: 'extA';
removeVariable: 'extB'].
aCCodeGenerator
var: #methodCache
declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
NewspeakVM
ifTrue:
[aCCodeGenerator
var: #nsMethodCache
declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]']
ifFalse:
[aCCodeGenerator
removeVariable: #nsMethodCache;
removeVariable: 'localAbsentReceiver';
removeVariable: 'localAbsentReceiverOrZero'].
AtCacheTotalSize isInteger ifTrue:
[aCCodeGenerator
var: #atCache
declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
aCCodeGenerator
var: #primitiveTable
declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
vmClass primitiveTable do:
[:symbolOrNot|
(symbolOrNot isSymbol
and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
[:tMethod| tMethod returnType: #void]]].
vmClass objectMemoryClass hasSpurMemoryManagerAPI
ifTrue:
[aCCodeGenerator
var: #primitiveAccessorDepthTable
type: 'signed char'
sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
array: (vmClass primitiveAccessorDepthTableUsing: aCCodeGenerator)]
ifFalse:
[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
aCCodeGenerator
var: #displayBits type: #'void *';
var: #primitiveCalloutPointer declareC: 'void *primitiveCalloutPointer = (void *)-1'.
self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator.
aCCodeGenerator
var: #primitiveFunctionPointer
declareC: 'void (*primitiveFunctionPointer)()';
var: 'pcPreviousToFunction'
declareC: 'sqInt (* const pcPreviousToFunction)(sqInt,sqInt) = ', (aCCodeGenerator cFunctionNameFor: PCPreviousToFunction);
var: #externalPrimitiveTable
declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)';
var: #interruptCheckChain
declareC: 'void (*interruptCheckChain)(void) = 0';
var: #showSurfaceFn
declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)';
var: #jmpBuf
declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
var: #suspendedCallbacks
declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
var: #suspendedMethods
declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
+ self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs
- self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
- longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
statProcessSwitch statIOProcessEvents statForceInterruptCheck
statCheckForEvents statStackOverflow statStackPageDivorce
statIdleUsecs)
in: aCCodeGenerator.
aCCodeGenerator var: #nextProfileTick type: #sqLong.
aCCodeGenerator var: #reenterInterpreter type: 'jmp_buf'.
LowcodeVM
ifTrue:
[aCCodeGenerator
var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'.
self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer)
as: #'char *'
in: aCCodeGenerator]
ifFalse:
[#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do:
+ [:var| aCCodeGenerator removeVariable: var]].
+ (self instVarNames select: [:ivn| ivn beginsWith: 'longRunningPrimitive']) do:
+ [:lrpmVar|
+ aCCodeGenerator
+ var: lrpmVar
+ declareC: '#if LRPMonitor\', ((lrpmVar endsWith: 'Usecs') ifTrue: [#usqLong] ifFalse: [#sqInt]), ' ', lrpmVar, '\#endif']!
- [:var| aCCodeGenerator removeVariable: var]]!
Item was added:
+ ----- Method: StackInterpreter>>checkDeliveryOfLongRunningPrimitiveSignal (in category 'primitive support') -----
+ checkDeliveryOfLongRunningPrimitiveSignal
+ "Check for a hit of the longRunningPrimitive probe and if so attempt to signal the
+ longRunningPrimitiveCheckSemaphore. Answer if a process switch occurred as a result."
+ <option: #LRPCheck>
+ <inline: #never>
+ (longRunningPrimitiveStopUsecs > longRunningPrimitiveStartUsecs "a hit"
+ and: [longRunningPrimitiveCheckSemaphore notNil "deliverable"
+ and: [longRunningPrimitiveSignalUndelivered]]) ifTrue: "but not yet delivered"
+ [longRunningPrimitiveSignalUndelivered := false.
+ longRunningPrimitiveGCUsecs := (objectMemory gcStartUsecs < longRunningPrimitiveStopUsecs
+ and: [objectMemory statGCEndUsecs > longRunningPrimitiveStartUsecs])
+ ifTrue: [objectMemory statGCEndUsecs - objectMemory gcStartUsecs]
+ ifFalse: [0].
+ "Signal the LRP check semaphore if it is present"
+ ^self synchronousSignal: longRunningPrimitiveCheckSemaphore].
+ ^false!
Item was changed:
----- Method: StackInterpreter>>checkForEventsMayContextSwitch: (in category 'process primitive support') -----
checkForEventsMayContextSwitch: mayContextSwitch
"Check for possible interrupts and handle one if necessary.
Answer if a context switch has occurred."
| switched sema now |
<inline: false>
<var: #now type: #usqLong>
statCheckForEvents := statCheckForEvents + 1.
"restore the stackLimit if it has been smashed."
self restoreStackLimit.
self externalWriteBackHeadFramePointers.
self assert: stackPage = stackPages mostRecentlyUsedPage.
"Allow the platform to do anything it needs to do synchronously."
self ioSynchronousCheckForEvents.
self checkCogCompiledCodeCompactionCalledFor.
objectMemory needGCFlag ifTrue:
["sufficientSpaceAfterGC: runs the incremental GC and
then, if not enough space is available, the fullGC."
(objectMemory sufficientSpaceAfterGC: 0) ifFalse:
[self setSignalLowSpaceFlagAndSaveProcess]].
mayContextSwitch ifFalse: [^false].
switched := false.
(profileProcess ~= objectMemory nilObject
or: [nextProfileTick > 0 and:[self ioHighResClock >= nextProfileTick]]) ifTrue:
[self zeroNextProfileTick.
"Take a sample (if not already done so) for the profiler if it is active. This
must be done before any of the synchronousSignals below or else we will
attribute a pause in ioRelinquishProcessor to the newly activated process."
profileProcess = objectMemory nilObject ifTrue:
[profileProcess := self activeProcess.
profileMethod := objectMemory nilObject].
"and signal the profiler semaphore if it is present"
(profileSemaphore ~= objectMemory nilObject
and: [self synchronousSignal: profileSemaphore]) ifTrue:
[switched := true]].
+ self cppIf: #LRPCheck
+ ifTrue:
+ [self checkDeliveryOfLongRunningPrimitiveSignal ifTrue:
+ [switched := true]].
+
objectMemory signalLowSpace ifTrue:
[objectMemory signalLowSpace: false. "reset flag"
sema := objectMemory splObj: TheLowSpaceSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
"inIOProcessEvents prevents reentrancy into ioProcessEvents and allows disabling
ioProcessEvents e.g. for native GUIs. We would like to manage that here but can't
since the platform code may choose to call ioProcessEvents itself in various places."
false
ifTrue:
[((now := self ioUTCMicroseconds) >= nextPollUsecs
and: [inIOProcessEvents = 0]) ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
inIOProcessEvents := inIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
inIOProcessEvents > 0 ifTrue:
[inIOProcessEvents := inIOProcessEvents - 1].
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]]
ifFalse:
[(now := self ioUTCMicroseconds) >= nextPollUsecs ifTrue:
[statIOProcessEvents := statIOProcessEvents + 1.
self ioProcessEvents. "sets interruptPending if interrupt key pressed; may callback"
nextPollUsecs := now + 20000
"msecs to wait before next call to ioProcessEvents. Note that strictly
speaking we might need to update 'now' at this point since
ioProcessEvents could take a very long time on some platforms"]].
interruptPending ifTrue:
[interruptPending := false.
"reset interrupt flag"
sema := objectMemory splObj: TheInterruptSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
nextWakeupUsecs ~= 0 ifTrue:
[now >= nextWakeupUsecs ifTrue:
[nextWakeupUsecs := 0.
"set timer interrupt to 0 for 'no timer'"
sema := objectMemory splObj: TheTimerSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]]].
"signal any pending finalizations"
pendingFinalizationSignals > 0 ifTrue:
[pendingFinalizationSignals := 0.
sema := objectMemory splObj: TheFinalizationSemaphore.
(sema ~= objectMemory nilObject
and: [self synchronousSignal: sema]) ifTrue:
[switched := true]].
"signal all semaphores in semaphoresToSignal"
self signalExternalSemaphores ifTrue:
[switched := true].
^switched!
Item was added:
+ ----- Method: StackInterpreter>>checkForLongRunningPrimitive (in category 'primitive support') -----
+ checkForLongRunningPrimitive
+ "Called from forceInterruptCheckFromHeartbeat. If the system has been running
+ the same primitive on two successive heartbeats then signal profileMethod."
+ <inline: true>
+ self cppIf: #LRPCheck
+ ifTrue:
+ [longRunningPrimitiveCheckSemaphore ifNil:
+ [^nil].
+ (longRunningPrimitiveStartUsecs > 0
+ and: [longRunningPrimitiveCheckMethod = newMethod
+ and: [longRunningPrimitiveCheckSequenceNumber = statCheckForEvents]]) ifTrue:
+ [longRunningPrimitiveStopUsecs := self ioUTCMicroseconds.
+ self assert: longRunningPrimitiveStopUsecs > longRunningPrimitiveStartUsecs.
+ ^nil].
+ "See traceProfileState & mapProfileState."
+ longRunningPrimitiveStopUsecs = 0 ifTrue:
+ [longRunningPrimitiveCheckSequenceNumber := statCheckForEvents.
+ longRunningPrimitiveCheckMethod := newMethod.
+ longRunningPrimitiveStartUsecs := self ioUTCMicroseconds.
+ self sqLowLevelMFence]]!
Item was changed:
----- Method: StackInterpreter>>forceInterruptCheckFromHeartbeat (in category 'process primitive support') -----
forceInterruptCheckFromHeartbeat
"Force an interrupt check ASAP. This version is the
entry-point to forceInterruptCheck for the heartbeat
timer to allow for repeatable debugging."
suppressHeartbeatFlag ifFalse:
+ [self checkForLongRunningPrimitive.
+ self forceInterruptCheck]!
- [self forceInterruptCheck]!
Item was changed:
----- Method: StackInterpreter>>initialize (in category 'initialization') -----
initialize
"Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
super initialize.
primitiveDoMixedArithmetic := true. "whether we authorize primitives to perform mixed arithmetic or not".
newFinalization := false.
stackLimit := 0. "This is also the initialization flag for the stack system."
stackPage := overflowedPage := 0.
extraFramesToMoveOnOverflow := 0.
bytecodeSetSelector := 0.
highestRunnableProcessPriority := 0.
nextPollUsecs := 0.
nextWakeupUsecs := 0.
tempOop := tempOop2 := theUnknownShort := 0.
interruptPending := false.
inIOProcessEvents := 0.
fullScreenFlag := 0.
sendWheelEvents := deferDisplayUpdates := false.
displayBits := displayWidth := displayHeight := displayDepth := 0.
pendingFinalizationSignals := statPendingFinalizationSignals := 0.
globalSessionID := 0.
jmpDepth := 0.
+ longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
maxExtSemTabSizeSet := false.
debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0.
primitiveCalloutPointer := -1. "initialized in declaration in declareCVarsIn:"
transcript := Transcript. "initialized to stdout in readImageFromFile:HeapSize:StartingAt:"
pcPreviousToFunction := PCPreviousToFunction. "initialized via StackInterpreter class>>declareCVarsIn:"
statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
statProcessSwitch := statIOProcessEvents := statStackPageDivorce :=
statIdleUsecs := 0!
Item was changed:
----- Method: StackInterpreter>>mapProfileState (in category 'object memory support') -----
mapProfileState
(objectMemory shouldRemapObj: profileProcess) ifTrue:
[profileProcess := objectMemory remapObj: profileProcess].
(objectMemory shouldRemapObj: profileMethod) ifTrue:
[profileMethod := objectMemory remapObj: profileMethod].
(objectMemory shouldRemapObj: profileSemaphore) ifTrue:
+ [profileSemaphore := objectMemory remapObj: profileSemaphore].
+ self cppIf: #LRPCheck
+ ifTrue:
+ ["The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt. Be very careful with it.
+ If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
+ been recenty sampled and could be mapped or not, but it must be newMethod and we can simply
+ copy newMethod. If LRPCSN ~= statCheckForEvents then LRPCM must be some extant object and
+ needs to be remapped."
+ self sqLowLevelMFence.
+ longRunningPrimitiveCheckMethod ifNotNil:
+ [longRunningPrimitiveCheckSequenceNumber = statCheckForEvents
+ ifTrue: [longRunningPrimitiveCheckMethod := newMethod]
+ ifFalse:
+ [(objectMemory shouldRemapObj: longRunningPrimitiveCheckMethod) ifTrue:
+ [longRunningPrimitiveCheckMethod := self remapObj: longRunningPrimitiveCheckMethod]].
+ self sqLowLevelMFence].
+ longRunningPrimitiveCheckSemaphore ifNotNil:
+ [(objectMemory shouldRemapObj: longRunningPrimitiveCheckSemaphore) ifTrue:
+ [longRunningPrimitiveCheckSemaphore := objectMemory remapObj: longRunningPrimitiveCheckSemaphore]]]!
- [profileSemaphore := objectMemory remapObj: profileSemaphore]!
Item was changed:
----- Method: StackInterpreter>>traceProfileState (in category 'object memory support') -----
traceProfileState
objectMemory hasSpurMemoryManagerAPI ifTrue:
[self followForwardingPointersInProfileState].
objectMemory markAndTrace: profileProcess.
objectMemory markAndTrace: profileMethod.
+ objectMemory markAndTrace: profileSemaphore.
+
+ self cppIf: #LRPCheck
+ ifTrue:
+ ["The longRunningPrimitiveCheckMethod (LRPCM) is sampled in an interrupt. Be very careful with it.
+ If longRunningPrimitiveCheckSequenceNumber (LRPCSN) = statCheckForEvents then LRPCM has
+ been recenty sampled, but it must be newMethod and we don't need to trace it twice. If LRPCSN
+ ~= statCheckForEvents then LRPCM must be some extant object and needs to be traced."
+ self sqLowLevelMFence.
+ (longRunningPrimitiveCheckMethod ~= nil
+ and: [longRunningPrimitiveCheckSequenceNumber ~= statCheckForEvents]) ifTrue:
+ [(objectMemory isForwarded: longRunningPrimitiveCheckMethod) ifTrue:
+ [longRunningPrimitiveCheckMethod := objectMemory followForwarded: longRunningPrimitiveCheckMethod].
+ objectMemory markAndTrace: longRunningPrimitiveCheckMethod].
+ longRunningPrimitiveCheckSemaphore ~= nil ifTrue:
+ [(objectMemory isForwarded: longRunningPrimitiveCheckSemaphore) ifTrue:
+ [longRunningPrimitiveCheckSemaphore := objectMemory followForwarded: longRunningPrimitiveCheckSemaphore].
+ objectMemory markAndTrace: longRunningPrimitiveCheckSemaphore]]!
- objectMemory markAndTrace: profileSemaphore!
Item was added:
+ ----- Method: StackInterpreter>>voidLongRunningPrimitive: (in category 'primitive support') -----
+ voidLongRunningPrimitive: reason
+ "Void the state associated with the long-running primitive check.
+ This is done when a new semaphore is installed or when it appears
+ that is longRunningPrimitiveCheckMethod is invalid, e.g. because it
+ has eben sampled in the middle of a GC."
+ <var: #reason type: #'char *'>
+ <option: #LRPCheck>
+ <inline: #never>
+ longRunningPrimitiveCheckMethod := nil.
+ longRunningPrimitiveStartUsecs :=
+ longRunningPrimitiveStopUsecs := 0.
+ longRunningPrimitiveSignalUndelivered := true.
+ self sqLowLevelMFence!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveLongRunningPrimitive (in category 'process primitives') -----
+ primitiveLongRunningPrimitive
+ "Primitive. Answer an Array with the current long-running primitive method identified by
+ the heartbeat, the minimum number of milliseconds it was active for, and the milliseconds
+ of GC activity there-in, or nil if none."
+ <export: true>
+ <option: #LRPCheck>
+ | lrpcm result primms gcms |
+ self sqLowLevelMFence.
+ "Since the longRunningPrimitiveCheckMethod is sampled at
+ interrupt time be careful to validate it before returning it."
+ (longRunningPrimitiveStopUsecs > longRunningPrimitiveStartUsecs "a hit"
+ and: [(lrpcm := longRunningPrimitiveCheckMethod) notNil "there is a method"
+ and: [(objectMemory addressCouldBeObj: lrpcm) "method looks valid"
+ and: [(objectMemory isCompiledMethod: lrpcm)]]])
+ ifTrue: [result := objectMemory instantiateClass: (objectMemory splObj: ClassArray) indexableSize: 3.
+ primms := (longRunningPrimitiveStopUsecs - longRunningPrimitiveStartUsecs) + 500 // 1000.
+ gcms := longRunningPrimitiveGCUsecs + 500 // 1000.
+ objectMemory storePointer: 0 ofObject: result withValue: lrpcm.
+ objectMemory storePointerUnchecked: 1 ofObject: result withValue: (objectMemory integerObjectOf: primms).
+ objectMemory storePointerUnchecked: 2 ofObject: result withValue: (objectMemory integerObjectOf: gcms)]
+ ifFalse: [result := objectMemory nilObject].
+ self voidLongRunningPrimitive: 'get'.
+ self methodReturnValue: result!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveLongRunningPrimitiveSemaphore (in category 'process primitives') -----
+ primitiveLongRunningPrimitiveSemaphore
+ "Primitive. Install the semaphore to be used for collecting long-running primitives,
+ or nil if no semaphore should be used."
+ <export: true>
+ <option: #LRPCheck>
+ | sema |
+ sema := self stackValue: 0.
+ sema = objectMemory nilObject
+ ifTrue:
+ [longRunningPrimitiveCheckSemaphore := nil]
+ ifFalse:
+ [(objectMemory isSemaphoreOop: sema) ifFalse:
+ [^self primitiveFail].
+ longRunningPrimitiveCheckSemaphore := sema].
+ self voidLongRunningPrimitive: 'install'.
+ self methodReturnReceiver!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveObjectPointsTo (in category 'object access primitives') -----
primitiveObjectPointsTo
"This primitive is assumed to be fast (see e.g. MethodDictionary>>includesKey:) so make it so.
+ N.B. Works correctly for cogged methods too."
- N.B. Works forrectly for cogged methods too."
| rcvr thang header fmt numSlots methodHeader |
thang := self stackTop.
rcvr := self stackValue: 1.
(objectMemory isImmediate: rcvr) ifTrue:
[^self pop: 2 thenPushBool: false].
"Inlined version of lastPointerOf: for speed in determining if rcvr is a context."
header := objectMemory baseHeader: rcvr.
fmt := objectMemory formatOfHeader: header.
(objectMemory isPointersFormat: fmt)
ifTrue:
[(fmt = objectMemory indexablePointersFormat
and: [objectMemory isContextHeader: header])
ifTrue:
[(self isMarriedOrWidowedContext: rcvr) ifTrue:
[self externalWriteBackHeadFramePointers.
(self isStillMarriedContext: rcvr) ifTrue:
[^self pop: 2
thenPushBool: (self marriedContext: rcvr
pointsTo: thang
stackDeltaForCurrentFrame: 2)]].
"contexts end at the stack pointer"
numSlots := CtxtTempFrameStart + (self fetchStackPointerOf: rcvr)]
ifFalse:
[numSlots := objectMemory numSlotsOf: rcvr]]
ifFalse:
[fmt < objectMemory firstCompiledMethodFormat "no pointers" ifTrue:
[^self pop: 2 thenPushBool: false].
"CompiledMethod: contains both pointers and bytes:"
methodHeader := objectMemory methodHeaderOf: rcvr.
methodHeader = thang ifTrue: [^self pop: 2 thenPushBool: true].
numSlots := (objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart].
self assert: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize = (objectMemory lastPointerOf: rcvr).
objectMemory baseHeaderSize
to: numSlots - 1 * objectMemory bytesPerOop + objectMemory baseHeaderSize
by: objectMemory bytesPerOop
do: [:i|
(objectMemory longAt: rcvr + i) = thang ifTrue:
[^self pop: 2 thenPushBool: true]].
self pop: 2 thenPushBool: false!
Item was changed:
----- Method: TMethod>>emitCFunctionPrototype:generator:isPrototype: (in category 'C code generation') -----
emitCFunctionPrototype: aStream generator: aCodeGen isPrototype: isPrototype "<Boolean>"
"Emit a C function header for this method onto the given stream.
Answer if the method has any compileTimeOptionPragmas"
| compileTimeOptionPragmas returnTypeIsFunctionPointer |
(compileTimeOptionPragmas := self compileTimeOptionPragmas) notEmpty ifTrue:
[self outputConditionalDefineFor: compileTimeOptionPragmas on: aStream].
returnTypeIsFunctionPointer := returnType notNil
and: [returnType last = $)
and: [returnType includesSubstring: (aCodeGen cFunctionNameFor: selector)]].
export
ifTrue:
[aStream nextPutAll: 'EXPORT('; nextPutAll: returnType; nextPut: $)]
ifFalse:
[self isStatic
ifTrue: [aStream nextPutAll: 'static ']
ifFalse:
[isPrototype ifTrue:
[aStream nextPutAll: 'extern ']].
(isPrototype or: [inline ~~ #always]) ifFalse: [aStream nextPutAll: 'inline '].
aStream nextPutAll: (returnType ifNil: [#sqInt])].
(functionAttributes isNil or: [returnTypeIsFunctionPointer]) ifFalse:
[aStream space; nextPutAll: functionAttributes].
- isPrototype ifTrue: [aStream space] ifFalse: [aStream cr].
returnTypeIsFunctionPointer ifFalse:
+ [isPrototype ifTrue: [aStream space] ifFalse: [aStream cr].
+ aStream
- [aStream
nextPutAll: (aCodeGen cFunctionNameFor: selector);
nextPut: $(.
args isEmpty
ifTrue: [aStream nextPutAll: #void]
ifFalse:
[args
do: [:arg| aStream nextPutAll: (self declarationAt: arg)]
separatedBy: [aStream nextPutAll: ', ']].
aStream nextPut: $)].
isPrototype ifTrue:
[aStream nextPut: $;; cr.
compileTimeOptionPragmas isEmpty ifFalse:
[aCodeGen maybeEmitPrimitiveFailureDefineFor: selector on: aStream.
self terminateConditionalDefineFor: compileTimeOptionPragmas on: aStream]].
^compileTimeOptionPragmas notEmpty!
Item was changed:
----- Method: VMBasicConstants class>>defineAtCompileTime: (in category 'C translation') -----
defineAtCompileTime: anObject
^anObject isSymbol
+ and: ["("self namesDefinedAtCompileTime includes: anObject")
+ ifTrue: [compileTimeQueries add: anObject. true]
+ ifFalse: [translationTimeQueries add: anObject. false]"]
+
+ "compileTimeQueries := Set new.
+ translationTimeQueries := Set new"
+ "self class
+ removeInstVarName: 'compileTimeQueries';
+ removeInstVarName: 'translationTimeQueries'"!
- and: [self namesDefinedAtCompileTime includes: anObject]!
Item was changed:
----- Method: VMBasicConstants class>>namesDefinedAtCompileTime (in category 'C translation') -----
namesDefinedAtCompileTime
"Answer the set of names for variables that should be defined at compile time.
Some of these get default values during simulation, and hence get defaulted in
the various initializeMiscConstants methods. But that they have values should
/not/ cause the code generator to do dead code elimination based on their
default values. In particular, methods marked with <option: ANameDefinedAtCompileTime>
will be emitted within #if defined(ANameDefinedAtCompileTime)...#endif.
+ And of course this is backwards. We'd like to define names that are defined at translation time.
+ But doing so would entail defining (or referencing) hundreds of class and pool variables. This way
+ is more manageable"
- And of course this is backwards. We'd like to define names that are defined at translation time."
^#(VMBIGENDIAN
IMMUTABILITY
STACKVM COGVM COGMTVM SPURVM
PharoVM "Pharo vs Squeak"
TerfVM VM_TICKER "Terf vs Squeak & Qwaq/Teleplace/Terf high-priority thread support"
EnforceAccessControl "Newspeak"
CheckRememberedInTrampoline "IMMUTABILITY"
BIT_IDENTICAL_FLOATING_POINT PLATFORM_SPECIFIC_FLOATING_POINT "Alternatives for using fdlibm for floating-point"
+ ITIMER_HEARTBEAT "older linux's woultn't allow a higher priority thread, hence no threaded heartbeat."
TestingPrimitives
OBSOLETE_ALIEN_PRIMITIVES "Ancient crap in the IA32ABI plugin"
LLDB "As of lldb-370.0.42 Swift-3.1, passing function parameters to printOopsSuchThat fails with Internal error [IRForTarget]: Couldn't rewrite one of the arguments of a function call. Turning off link time optimization with -fno-lto has no effect. hence we define some debugging functions as being <option: LLDB>"
+ LRPCheck "Optional checking for long running primitives"
"processor related"
__ARM_ARCH__ __arm__ __arm32__ ARM32 __arm64__ ARM64
_M_I386 _X86_ i386 i486 i586 i686 __i386__ __386__ X86 I386
x86_64 __amd64 __x86_64 __amd64__ __x86_64__ _M_AMD64 _M_X64
+
__mips__ __mips
__powerpc __powerpc__ __powerpc64__ __POWERPC__
__ppc__ __ppc64__ __PPC__ __PPC64__
__sparc__ __sparc __sparc_v8__ __sparc_v9__ __sparcv8 __sparcv9
"Compiler brand related"
+
__ACK__
__CC_ARM
__clang__
__GNUC__
_MSC_VER
__ICC
+
__SUNPRO_C
"os related"
ACORN
+
_AIX
__ANDROID__
__APPLE__
__BEOS__
__linux__
__MACH__
__MINGW32__
__FreeBSD__ __NetBSD__ __OpenBSD__
__osf__
+
EPLAN9
__unix__ __unix UNIX
WIN32 _WIN32 _WIN32_WCE
WIN64 _WIN64 _WIN64_WCE)!
Item was changed:
----- Method: VMClass class>>initialize (in category 'initialization') -----
initialize
InitializationOptions ifNil: [InitializationOptions := Dictionary new].
ExpensiveAsserts := false.
(Smalltalk classNamed: #Utilities) ifNotNil:
[:utilitiesClass|
(utilitiesClass classPool at: #CommonRequestStrings ifAbsent: []) ifNotNil:
[:commonRequestStringHolder|
(commonRequestStringHolder contents asString includesSubstring: 'VMClass open') ifFalse:
+ [Utilities appendToCommonRequests: '-\VMMaker generateConfiguration\VMMaker generateAllConfigurationsUnderVersionControl\VMMaker generateAllSpurConfigurations\VMClass openCogSpurMultiWindowBrowser\VMClass openCogV3MultiWindowBrowser\VMClass openObjectMemoriesInterpretersBrowser\VMClass openSpurMultiWindowBrowser\VMClass openCogitMultiWindowBrowser\openInterpreterMultiWindowBrowser' withCRs]]]!
- [Utilities appendToCommonRequests: '-\VMMaker generateConfiguration\VMMaker generateAllConfigurationsUnderVersionControl\VMMaker generateAllSpurConfigurations\VMClass openCogSpurMultiWindowBrowser\VMClass openCogV3MultiWindowBrowser\VMClass openObjectMemoriesInterpretersBrowser\VMClass openSpurMultiWindowBrowser\VMClass openCogitMultiWindowBrowser' withCRs]]]!
Item was added:
+ ----- Method: VMClass class>>openInterpreterMultiWindowBrowser (in category 'utilities') -----
+ openInterpreterMultiWindowBrowser
+ "Answer a new multi-window browser on the Spur classes, the Cog StackInterpreter classes, and the support classes"
+ | b |
+ b := Browser open.
+ #( InterpreterPrimitives StackInterpreter StackInterpreterPrimitives
+ CoInterpreter CoInterpreterPrimitives CoInterpreterMT
+ StackInterpreterSimulator CogVMSimulator)
+ do: [:className|
+ (Smalltalk classNamed: className) ifNotNil:
+ [:class| b selectCategoryForClass: class; selectClass: class]]
+ separatedBy:
+ [b multiWindowState addNewWindow].
+ b multiWindowState selectWindowIndex: 1!
More information about the Vm-dev
mailing list