[Vm-dev] VM Maker: VMMaker.oscog-eem.3127.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun Jan 2 01:58:21 UTC 2022
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3127.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3127
Author: eem
Time: 1 January 2022, 5:58:06.869475 pm
UUID: 4d6dd04c-143e-41c0-90bb-ed55b27ff3f1
Ancestors: VMMaker.oscog-eem.3126
Revise primitiveSuspend to no longer just remove a process from its condition variable list if waiting on a condition variable. Instead also back up the process one bytecode so that the blocking send will retried if and when the process is resumed.
Distinguish between a process being runnable but not active from a blocked process by the class of myList. If myList is LinkedList the process is runnable. Hence keep track of the class of LinkedList.
Refactor convertToInterpreterFrame: to convertFrame:toInterpreterFrame: to facilitate implementation in the Cogit (a send byetcode is not a suspension point in machien code, hence a machien code caller of a blocking primtiive must be converted to an interpreter frame).
=============== Diff against VMMaker.oscog-eem.3126 ===============
Item was added:
+ ----- Method: CoInterpreter>>backupProcess:toBlockingSendTo: (in category 'process primitive support') -----
+ backupProcess: aProcess toBlockingSendTo: conditionVariable
+ "Assume aProcess is waiting on a condition variable.
+ Backup the PC of aProcess to the send that entered the wait state.
+ Since the PC at a send is not a susension point in machine code, this
+ entails converting a machine code frame into an interpreter frame.
+ primitiveEnterCriticalSection pushes false for blocked waiters. false
+ must be replaced by the condition variable."
+
+ | context theMethod pc sp theIP theNewIP theFP thePage |
+ context := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess.
+ self assert: (objectMemory isContext: context).
+ theMethod := objectMemory fetchPointer: MethodIndex ofObject: context.
+ (self isSingleContext: context) ifTrue:
+ [pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: context.
+ sp := objectMemory fetchPointer: StackPointerIndex ofObject: context.
+ self assert: ((objectMemory isIntegerObject: pc) and: [(objectMemory integerValueOf: pc) > 0]).
+ self assert: ((objectMemory isIntegerObject: sp) and: [(objectMemory integerValueOf: sp) > 0]).
+ theIP := theMethod + objectMemory baseHeaderSize + (objectMemory integerValueOf: 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: context
+ withValue: (objectMemory integerObjectOf: pc).
+ sp := (objectMemory integerValueOf: sp) + ReceiverIndex. "implicitly converts to 0 relative"
+ self assert: ((objectMemory fetchPointer: sp ofObject: context) = objectMemory falseObject
+ or: [(objectMemory fetchPointer: sp ofObject: context) = conditionVariable]).
+ objectMemory storePointer: sp ofObject: context withValue: conditionVariable.
+ ^self].
+ self assert: (self isMarriedOrWidowedContext: context).
+ self deny: (self isWidowedContextNoConvert: context).
+ theFP := self frameOfMarriedContext: context.
+ thePage := stackPages stackPageFor: theFP.
+ self deny: thePage = stackPage.
+ self assert: theFP = thePage headFP.
+ (self isMachineCodeFrame: theFP)
+ ifTrue:
+ [| mcpc maybeClosure startBcpc cogMethodForIP |
+ mcpc := stackPages longAt: thePage headSP. "a machine code pc... it must be converted..."
+ maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: context.
+ (maybeClosure ~= objectMemory nilObject
+ and: [self isVanillaBlockClosure: maybeClosure])
+ ifTrue: [cogMethodForIP := self mframeHomeMethod: theFP.
+ startBcpc := self startPCOfClosure: maybeClosure]
+ ifFalse: [cogMethodForIP := self cCoerceSimple: (self mframeMethod: theFP) to: #'CogMethod *'.
+ startBcpc := self startPCOfMethod: theMethod].
+ theIP := cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethodForIP.
+ 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:
+ [self assert: (stackPages longAt: thePage headSP) = cogit ceReturnToInterpreterPC.
+ 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..."
+ 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>>ceSendMustBeBooleanTo:interpretingAtDelta: (in category 'trampolines') -----
ceSendMustBeBooleanTo: aNonBooleanObject interpretingAtDelta: jumpSize
"For RegisterAllocatingCogit we want the pc following a conditional branch not to be reachable, so
we don't have to generate code to reload registers. But notionally the pc following a conditional
branch is reached when continuing from a mustBeBoolean error. Instead of supporting this in the
JIT, simply convert to an interpreter frame, backup the pc to the branch, reenter the interpreter
and hence retry the mustBeBoolean send therein. N.B. We could do this for immutability violations
too, but immutability is used in actual applications and so should be performant, whereas
mustBeBoolean errors are extremely rare and so we choose brevity over performance in this case."
<api>
self assert: (objectMemory addressCouldBeOop: aNonBooleanObject).
instructionPointer := self popStack.
+ self convertFrame: framePointer toInterpreterFrame: jumpSize.
- self convertToInterpreterFrame: jumpSize.
self push: aNonBooleanObject.
"and now reenter the interpreter..."
cogit ceInvokeInterpret.
"NOTREACHED"
^nil!
Item was added:
+ ----- Method: CoInterpreter>>convertFrame:toInterpreterFrame: (in category 'frame access') -----
+ convertFrame: theFP toInterpreterFrame: pcDelta
+ "Convert the given machine code frame to an interpreter frame. Back up the pc by
+ pcDelta. Support for backing up the pc in primitiveSuspend for processes waiting
+ on condition variables. Support for mustBeBoolean in the RegisterAllocatingCogit and
+ for cloneContext: in shallowCopy when a code compaction is caused by machine code
+ to bytecode pc mapping."
+
+ <var: 'theFP' type: #'char *'>
+ | cogMethod methodHeader methodObj startBcpc theIP thePage theSP theNewSP |
+ <var: 'cogMethod' type: #'CogBlockMethod *'>
+ <var: 'p' type: #'char *'>
+
+ self assert: (self isMachineCodeFrame: theFP).
+
+ theFP = framePointer
+ ifTrue:
+ [theIP := instructionPointer.
+ theSP := stackPointer]
+ ifFalse:
+ [thePage := stackPages stackPageFor: theFP.
+ self assert: theFP = thePage headFP.
+ theSP := thePage headSP.
+ theIP := stackPages longAt: theSP].
+
+ cogMethod := self mframeCogMethod: theFP.
+ ((self mframeIsBlockActivation: theFP)
+ and: [cogMethod cmIsFullBlock not])
+ ifTrue:
+ [| homeMethod |
+ homeMethod := cogMethod cmHomeMethod.
+ methodHeader := homeMethod methodHeader.
+ methodObj := homeMethod methodObject.
+ startBcpc := cogMethod startpc]
+ ifFalse:
+ [methodHeader := (self cCoerceSimple: cogMethod to: #'CogMethod *') methodHeader.
+ methodObj := (self cCoerceSimple: cogMethod to: #'CogMethod *') methodObject.
+ startBcpc := self startPCOfMethodHeader: methodHeader].
+
+ "Map the machine code instructionPointer to the interpreter instructionPointer of the branch."
+ theIP := cogit bytecodePCFor: theIP startBcpc: startBcpc in: cogMethod.
+ theIP := methodObj + objectMemory baseHeaderSize + theIP - pcDelta - 1. "fetchByte uses pre-increment, so pre decrement".
+ self assert: (self validInstructionPointer: theIP inMethod: methodObj framePointer: theFP).
+
+ "Make space for the two extra fields in an interpreter frame"
+ theSP to: theFP + FoxMFReceiver by: objectMemory wordSize do:
+ [:p| | oop |
+ oop := objectMemory longAt: p.
+ objectMemory
+ longAt: p - objectMemory wordSize - objectMemory wordSize
+ put: (objectMemory longAt: p)].
+ "Fill in the fields"
+ objectMemory
+ longAt: theFP + FoxIFrameFlags
+ put: (self
+ encodeFrameFieldHasContext: (self mframeHasContext: theFP)
+ isBlock: (self mframeIsBlockActivation: theFP)
+ numArgs: cogMethod cmNumArgs);
+ longAt: theFP + FoxIFSavedIP
+ put: theIP;
+ longAt: theFP + FoxMethod
+ put: methodObj.
+
+ theFP = framePointer
+ ifTrue: "If the frame is the top frame, update the top frame..."
+ [stackPointer := stackPointer - objectMemory wordSize - objectMemory wordSize.
+ instructionPointer := theIP.
+ self setMethod: methodObj methodHeader: methodHeader]
+ ifFalse: "otherwise update the stack pointer and instruction pointer of the top frame..."
+ [theNewSP := theSP - objectMemory wordSize - objectMemory wordSize.
+ thePage headSP: theNewSP.
+ stackPages longAt: theNewSP put: cogit ceReturnToInterpreterPC]!
Item was removed:
- ----- Method: CoInterpreter>>convertToInterpreterFrame: (in category 'frame access') -----
- convertToInterpreterFrame: pcDelta
- "Convert the top machine code frame to an interpreter frame. Support for
- mustBeBoolean in the RegisterAllocatingCogit and for cloneContext: in shallowCopy
- when a code compaction is caused by machine code to bytecode pc mapping."
-
- | cogMethod methodHeader methodObj startBcpc |
- <var: 'cogMethod' type: #'CogBlockMethod *'>
- <var: 'p' type: #'char *'>
-
- self assert: (self isMachineCodeFrame: framePointer).
-
- cogMethod := self mframeCogMethod: framePointer.
- ((self mframeIsBlockActivation: framePointer)
- and: [cogMethod cmIsFullBlock not])
- ifTrue:
- [methodHeader := (self cCoerceSimple: cogMethod cmHomeMethod to: #'CogMethod *') methodHeader.
- methodObj := (self cCoerceSimple: cogMethod cmHomeMethod to: #'CogMethod *') methodObject.
- startBcpc := cogMethod startpc]
- ifFalse:
- [methodHeader := (self cCoerceSimple: cogMethod to: #'CogMethod *') methodHeader.
- methodObj := (self cCoerceSimple: cogMethod to: #'CogMethod *') methodObject.
- startBcpc := self startPCOfMethodHeader: methodHeader].
-
- "Map the machine code instructionPointer to the interpreter instructionPointer of the branch."
- instructionPointer := cogit bytecodePCFor: instructionPointer startBcpc: startBcpc in: cogMethod.
- instructionPointer := methodObj + objectMemory baseHeaderSize + instructionPointer - pcDelta - 1. "pre-decrement"
- self assert: (self validInstructionPointer: instructionPointer inMethod: methodObj framePointer: framePointer).
-
- "Make space for the two extra fields in an interpreter frame"
- stackPointer to: framePointer + FoxMFReceiver by: objectMemory wordSize do:
- [:p| | oop |
- oop := objectMemory longAt: p.
- objectMemory
- longAt: p - objectMemory wordSize - objectMemory wordSize
- put: (objectMemory longAt: p)].
- stackPointer := stackPointer - objectMemory wordSize - objectMemory wordSize.
- "Fill in the fields"
- objectMemory
- longAt: framePointer + FoxIFrameFlags
- put: (self
- encodeFrameFieldHasContext: (self mframeHasContext: framePointer)
- isBlock: (self mframeIsBlockActivation: framePointer)
- numArgs: cogMethod cmNumArgs);
- longAt: framePointer + FoxIFSavedIP
- put: instructionPointer;
- longAt: framePointer + FoxMethod
- put: methodObj.
-
- self setMethod: methodObj methodHeader: methodHeader!
Item was changed:
----- Method: CogStackPages>>stackPageFor: (in category 'page access') -----
stackPageFor: pointer "<Integer>"
<inline: true>
<var: #pointer type: #'void *'>
<returnTypeC: #'StackPage *'>
+ ^self stackPageAt: (self pageIndexFor: pointer) pages: pages!
- ^self stackPageAt: (self pageIndexFor: pointer)!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveEnterCriticalSection (in category 'process primitives') -----
primitiveEnterCriticalSection
"Attempt to enter a CriticalSection/Mutex. If not owned, set the owner to the current
process and answer false. If owned by the current process answer true. Otherwise
suspend the process. Answer if the receiver is owned by the current process.
For simulation if there is an argument it is taken to be the effective activeProcess
(see Process>>effectiveProcess)."
| criticalSection owningProcessIndex owningProcess activeProc |
argumentCount > 0
ifTrue:
[criticalSection := self stackValue: 1. "rcvr"
+ activeProc := self stackTop.
+ (objectMemory isOopForwarded: activeProc) ifTrue:
+ [self primitiveFailFor: PrimErrBadArgument]]
- activeProc := self stackTop]
ifFalse:
[criticalSection := self stackTop. "rcvr"
activeProc := self activeProcess].
owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores"
owningProcess := objectMemory fetchPointer: owningProcessIndex ofObject: criticalSection.
owningProcess = objectMemory nilObject ifTrue:
[objectMemory storePointer: owningProcessIndex
ofObject: criticalSection
withValue: activeProc.
+ ^self methodReturnValue: objectMemory falseObject].
- ^self pop: argumentCount + 1 thenPush: objectMemory falseObject].
owningProcess = activeProc ifTrue:
+ [^self methodReturnValue: objectMemory trueObject].
- [^self pop: argumentCount + 1 thenPush: objectMemory trueObject].
"Arrange to answer false (unowned) when the process is resumed."
self pop: argumentCount + 1 thenPush: objectMemory falseObject.
self addLastLink: activeProc toList: criticalSection.
self transferTo: self wakeHighestPriority!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveResume (in category 'process primitives') -----
primitiveResume
"Put this process on the scheduler's lists thus allowing it to proceed next time there is
a chance for processes of it's priority level. It must go to the back of its run queue so
as not to preempt any already running processes at this level. If the process's priority
is higher than the current process, preempt the current process."
| proc ctxt |
proc := self stackTop. "rcvr"
+ "Alas in Spur we need a read barrier"
ctxt := objectMemory followField: SuspendedContextIndex ofObject: proc. "written this way to get better Slang inlining"
(objectMemory isContext: ctxt) ifFalse:
[^self primitiveFailFor: PrimErrBadReceiver].
+ self resume: proc preemptedYieldingIf: preemptionYields!
- self resume: proc preemptedYieldingIf: preemptionYields
-
- "Personally I would like to check MyList, which should not be one of the elements of the scheduler lists.
- But there are awful race conditions in things like should:notTakeMoreThan: that mean we can't.
- eem 9/27/2010 23:08, updated eem 5/20/2021 15:36. e.g.
-
- | proc field |
- proc := self stackTop. ''rcvr''
- ''We only have to check for myList being nil. If it is nil then this is either the active process or
- a process suspended with primitiveSuspend (and if it is the activeProcess suspendedContext will
- be nil and the isContext: test will fail). If it is not nil then either the process is waiting on some
- semaphore-like list or on one of the scheduler's lists. If it is on some semaphore-like list it should
- not resume. If it is on one of the scheduler's lists it is runnable (already resumed).''
- field := objectMemory followField: MyListIndex ofObject: proc.
- objectMemory nilObject = field ifFalse:
- [^self primitiveFailFor: PrimErrInappropriate].
- field := objectMemory followField: SuspendedContextIndex ofObject: proc.
- (objectMemory isContext: field) ifFalse:
- [^self primitiveFailFor: PrimErrBadReceiver].
- self resume: proc preemptedYieldingIf: preemptionYields"!
Item was removed:
- ----- Method: InterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
- primitiveSuspend
- "Primitive. Suspend the receiver, aProcess such that it can be executed again
- by sending #resume. If the given process is not currently running, take it off
- its corresponding list. The primitive returns the list the receiver was previously on."
- | process myList |
- process := self stackTop.
- process = self activeProcess ifTrue:
- [self pop: 1 thenPush: objectMemory nilObject.
- ^self transferTo: self wakeHighestPriority].
- myList := objectMemory fetchPointer: MyListIndex ofObject: process.
- "XXXX Fixme. We should really check whether myList is a kind of LinkedList or not
- but we can't easily so just do a quick check for nil which is the most common case."
- myList = objectMemory nilObject ifTrue:
- [^self primitiveFailFor: PrimErrBadReceiver].
- "Alas in Spur we need a read barrier"
- (objectMemory isForwarded: myList) ifTrue:
- [myList := objectMemory followForwarded: myList.
- objectMemory storePointer: MyListIndex ofObject: process withValue: myList].
- self removeProcess: process fromList: myList.
- self successful ifTrue:
- [objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject.
- self pop: 1 thenPush: myList]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveTestAndSetOwnershipOfCriticalSection (in category 'process primitives') -----
primitiveTestAndSetOwnershipOfCriticalSection
"Attempt to test-and-set the ownership of the critical section. If not owned,
set the owner to the current process and answer false. If owned by the
current process answer true. If owned by some other process answer nil.
For simulation if there is an argument it is taken to be the effective activeProcess
(see Process>>effectiveProcess)."
| criticalSection owningProcessIndex owningProcess activeProc |
argumentCount > 0
ifTrue:
[criticalSection := self stackValue: 1. "rcvr"
+ activeProc := self stackTop.
+ (objectMemory isOopForwarded: activeProc) ifTrue:
+ [self primitiveFailFor: PrimErrBadArgument]]
- activeProc := self stackTop]
ifFalse:
[criticalSection := self stackTop. "rcvr"
activeProc := self activeProcess].
owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores"
owningProcess := objectMemory fetchPointer: owningProcessIndex ofObject: criticalSection.
owningProcess = objectMemory nilObject ifTrue:
[objectMemory storePointer: owningProcessIndex
ofObject: criticalSection
withValue: activeProc.
+ ^self methodReturnValue: objectMemory falseObject].
- ^self pop: argumentCount + 1 thenPush: objectMemory falseObject].
owningProcess = activeProc ifTrue:
+ [^self methodReturnValue: objectMemory trueObject].
+ self methodReturnValue: objectMemory nilObject!
- [^self pop: argumentCount + 1 thenPush: objectMemory trueObject].
- self pop: argumentCount + 1 thenPush: objectMemory nilObject!
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 longRunningPrimitiveGCUsecs
longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
statProcessSwitch statIOProcessEvents statForceInterruptCheck
statCheckForEvents statStackOverflow statStackPageDivorce
statIdleUsecs)
in: aCCodeGenerator.
aCCodeGenerator var: #nextProfileTick type: #sqLong.
aCCodeGenerator var: #reenterInterpreter type: 'jmp_buf'.
LowcodeVM
ifTrue:
[aCCodeGenerator
var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*'.
self declareC: #(nativeSP nativeStackPointer shadowCallStackPointer)
as: #'char *'
in: aCCodeGenerator]
ifFalse:
[#(lowcodeCalloutState nativeSP nativeStackPointer shadowCallStackPointer) do:
[:var| aCCodeGenerator removeVariable: var]]!
Item was changed:
----- Method: StackInterpreter class>>initializeBytecodeTableForNewspeakV4 (in category 'initialization') -----
initializeBytecodeTableForNewspeakV4
"StackInterpreter initializeBytecodeTableForNewspeakV4"
"Note: This table will be used to generate a C switch statement."
InitializationOptions at: #NewsqueakV4BytecodeSet put: (NewsqueakV4BytecodeSet := true).
BytecodeTable := Array new: 256.
BytecodeEncoderClassName := #EncoderForNewsqueakV4.
BytecodeSetHasDirectedSuperSend := true.
BytecodeSetHasExtensions := true.
LongStoreBytecode := 234.
+ PCPreviousToFunction := #pcPreviousTo:inNewsqueakV4Method:.
self table: BytecodeTable from:
#( "1 byte bytecodes"
( 0 15 pushReceiverVariableBytecode)
( 16 31 pushLiteralVariable16CasesBytecode)
( 32 63 pushLiteralConstantBytecode)
( 64 75 pushTemporaryVariableBytecode)
( 76 pushReceiverBytecode)
( 77 extPushPseudoVariableOrOuterBytecode)
( 78 pushConstantZeroBytecode)
( 79 pushConstantOneBytecode)
( 80 bytecodePrimAdd)
( 81 bytecodePrimSubtract)
( 82 bytecodePrimLessThanV4) "for booleanCheatV4:"
( 83 bytecodePrimGreaterThanV4) "for booleanCheatV4:"
( 84 bytecodePrimLessOrEqualV4) "for booleanCheatV4:"
( 85 bytecodePrimGreaterOrEqualV4) "for booleanCheatV4:"
( 86 bytecodePrimEqualV4) "for booleanCheatV4:"
( 87 bytecodePrimNotEqualV4) "for booleanCheatV4:"
( 88 bytecodePrimMultiply)
( 89 bytecodePrimDivide)
( 90 bytecodePrimMod)
( 91 bytecodePrimMakePoint)
( 92 bytecodePrimBitShift)
( 93 bytecodePrimDiv)
( 94 bytecodePrimBitAnd)
( 95 bytecodePrimBitOr)
( 96 bytecodePrimAt)
( 97 bytecodePrimAtPut)
( 98 bytecodePrimSize)
( 99 bytecodePrimNext)
(100 bytecodePrimNextPut)
(101 bytecodePrimAtEnd)
(102 bytecodePrimIdenticalV4) "for booleanCheatV4:"
(103 bytecodePrimClass)
(104 bytecodePrimNotIdenticalV4) "was blockCopy:"
(105 bytecodePrimValue)
(106 bytecodePrimValueWithArg)
(107 bytecodePrimDo)
(108 bytecodePrimNew)
(109 bytecodePrimNewWithArg)
(110 bytecodePrimPointX)
(111 bytecodePrimPointY)
(112 127 sendLiteralSelector0ArgsBytecode)
(128 143 sendLiteralSelector1ArgBytecode)
(144 159 sendLiteralSelector2ArgsBytecode)
(160 175 sendAbsentImplicit0ArgsBytecode)
(176 183 storeAndPopReceiverVariableBytecode)
(184 191 storeAndPopTemporaryVariableBytecode)
(192 199 shortUnconditionalJump)
(200 207 shortConditionalJumpTrue)
(208 215 shortConditionalJumpFalse)
(216 returnReceiver)
(217 returnTopFromMethod)
(218 extReturnTopFromBlock)
(219 duplicateTopBytecode)
(220 popStackBytecode)
(221 extNopBytecode)
(222 223 unknownBytecode)
"2 byte bytecodes"
(224 extABytecode)
(225 extBBytecode)
(226 extPushReceiverVariableBytecode)
(227 extPushLiteralVariableBytecode)
(228 extPushLiteralBytecode)
(229 extPushIntegerBytecode)
(230 longPushTemporaryVariableBytecode)
(231 pushNewArrayBytecode)
(232 extStoreReceiverVariableBytecode)
(233 extStoreLiteralVariableBytecode)
(234 longStoreTemporaryVariableBytecode)
(235 extStoreAndPopReceiverVariableBytecode)
(236 extStoreAndPopLiteralVariableBytecode)
(237 longStoreAndPopTemporaryVariableBytecode)
(238 extSendBytecode)
(239 extSendSuperBytecode)
(240 extSendAbsentImplicitBytecode)
(241 extSendAbsentDynamicSuperBytecode)
(242 extUnconditionalJump)
(243 extJumpIfTrue)
(244 extJumpIfFalse)
(245 extSendAbsentSelfBytecode)
(246 248 unknownBytecode)
"3 byte bytecodes"
(249 callPrimitiveBytecode)
(250 pushRemoteTempLongBytecode)
(251 storeRemoteTempLongBytecode)
(252 storeAndPopRemoteTempLongBytecode)
(253 extPushClosureBytecode)
(254 extSendAbsentOuterBytecode)
(255 unknownBytecode)
)!
Item was changed:
----- Method: StackInterpreter class>>initializeBytecodeTableForSistaV1 (in category 'initialization') -----
initializeBytecodeTableForSistaV1
"See e.g. the cass comment for EncoderForSistaV1"
"StackInterpreter initializeBytecodeTableForSistaV1"
"Note: This table will be used to generate a C switch statement."
InitializationOptions at: #SistaV1BytecodeSet put: (SistaV1BytecodeSet := true).
BytecodeTable := Array new: 256.
BytecodeEncoderClassName := #EncoderForSistaV1.
BytecodeSetHasDirectedSuperSend := true.
BytecodeSetHasExtensions := true.
LongStoreBytecode := 245.
+ PCPreviousToFunction := #pcPreviousTo:inSistaV1Method:.
self table: BytecodeTable from:
#( "1 byte bytecodes"
( 0 15 pushReceiverVariableBytecode)
( 16 31 pushLiteralVariable16CasesBytecode)
( 32 63 pushLiteralConstantBytecode)
( 64 75 pushTemporaryVariableBytecode)
( 76 pushReceiverBytecode)
( 77 pushConstantTrueBytecode)
( 78 pushConstantFalseBytecode)
( 79 pushConstantNilBytecode)
( 80 pushConstantZeroBytecode)
( 81 pushConstantOneBytecode)
( 82 extPushPseudoVariable)
( 83 duplicateTopBytecode)
( 84 87 unknownBytecode)
( 88 returnReceiver)
( 89 returnTrue)
( 90 returnFalse)
( 91 returnNil)
( 92 returnTopFromMethod)
( 93 returnNilFromBlock)
( 94 returnTopFromBlock)
( 95 extNopBytecode)
( 96 bytecodePrimAdd)
( 97 bytecodePrimSubtract)
( 98 bytecodePrimLessThanSistaV1) "for booleanCheatSistaV1:"
( 99 bytecodePrimGreaterThanSistaV1) "for booleanCheatSistaV1:"
(100 bytecodePrimLessOrEqualSistaV1) "for booleanCheatSistaV1:"
(101 bytecodePrimGreaterOrEqualSistaV1) "for booleanCheatSistaV1:"
(102 bytecodePrimEqualSistaV1) "for booleanCheatSistaV1:"
(103 bytecodePrimNotEqualSistaV1) "for booleanCheatSistaV1:"
(104 bytecodePrimMultiply)
(105 bytecodePrimDivide)
(106 bytecodePrimMod)
(107 bytecodePrimMakePoint)
(108 bytecodePrimBitShift)
(109 bytecodePrimDiv)
(110 bytecodePrimBitAnd)
(111 bytecodePrimBitOr)
(112 bytecodePrimAt)
(113 bytecodePrimAtPut)
(114 bytecodePrimSize)
(115 bytecodePrimNext) "i.e. a 0 arg special selector"
(116 bytecodePrimNextPut) "i.e. a 1 arg special selector"
(117 bytecodePrimAtEnd)
(118 bytecodePrimIdenticalSistaV1) "for booleanCheatSistaV1:"
(119 bytecodePrimClass)
(120 bytecodePrimNotIdenticalSistaV1) "was blockCopy:"
(121 bytecodePrimValue)
(122 bytecodePrimValueWithArg)
(123 bytecodePrimDo) "i.e. a 1 arg special selector"
(124 bytecodePrimNew) "i.e. a 0 arg special selector"
(125 bytecodePrimNewWithArg) "i.e. a 1 arg special selector"
(126 bytecodePrimPointX) "i.e. a 0 arg special selector"
(127 bytecodePrimPointY) "i.e. a 0 arg special selector"
(128 143 sendLiteralSelector0ArgsBytecode)
(144 159 sendLiteralSelector1ArgBytecode)
(160 175 sendLiteralSelector2ArgsBytecode)
(176 183 shortUnconditionalJump)
(184 191 shortConditionalJumpTrue)
(192 199 shortConditionalJumpFalse)
(200 207 storeAndPopReceiverVariableBytecode)
(208 215 storeAndPopTemporaryVariableBytecode)
(216 popStackBytecode)
(217 unconditionalTrapBytecode)
(218 223 unknownBytecode)
"2 byte bytecodes"
(224 extABytecode)
(225 extBBytecode)
(226 extPushReceiverVariableBytecode)
(227 extPushLiteralVariableBytecode)
(228 extPushLiteralBytecode)
(229 longPushTemporaryVariableBytecode)
(230 unknownBytecode)
(231 pushNewArrayBytecode)
(232 extPushIntegerBytecode)
(233 extPushCharacterBytecode)
(234 extSendBytecode)
(235 extSendSuperBytecode)
(236 callMappedInlinedPrimitive)
(237 extUnconditionalJump)
(238 extJumpIfTrue)
(239 extJumpIfFalse)
(240 extStoreAndPopReceiverVariableBytecode)
(241 extStoreAndPopLiteralVariableBytecode)
(242 longStoreAndPopTemporaryVariableBytecode)
(243 extStoreReceiverVariableBytecode)
(244 extStoreLiteralVariableBytecode)
(245 longStoreTemporaryVariableBytecode)
(246 247 unknownBytecode)
"3 byte bytecodes"
(248 callPrimitiveBytecode)
(249 extPushFullClosureBytecode)
(250 extPushClosureBytecode)
(251 pushRemoteTempLongBytecode)
(252 storeRemoteTempLongBytecode)
(253 storeAndPopRemoteTempLongBytecode)
(254 255 unknownBytecode)
)!
Item was changed:
----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosures (in category 'initialization') -----
initializeBytecodeTableForSqueakV3PlusClosures
"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosures"
"Note: This table will be used to generate a C switch statement."
InitializationOptions at: #SqueakV3PlusClosuresBytecodeSet put: (SqueakV3PlusClosuresBytecodeSet := true).
BytecodeTable := Array new: 256.
BytecodeEncoderClassName := #EncoderForV3PlusClosures.
- LongStoreBytecode := 129.
BytecodeSetHasExtensions := false.
+ LongStoreBytecode := 129.
+ PCPreviousToFunction := #pcPreviousTo:inSqueakV3PlusClosuresMethod:.
self table: BytecodeTable from:
#(
( 0 15 pushReceiverVariableBytecode)
( 16 31 pushTemporaryVariableBytecode)
( 32 63 pushLiteralConstantBytecode)
( 64 95 pushLiteralVariableBytecode)
( 96 103 storeAndPopReceiverVariableBytecode)
(104 111 storeAndPopTemporaryVariableBytecode)
(112 pushReceiverBytecode)
(113 pushConstantTrueBytecode)
(114 pushConstantFalseBytecode)
(115 pushConstantNilBytecode)
(116 pushConstantMinusOneBytecode)
(117 pushConstantZeroBytecode)
(118 pushConstantOneBytecode)
(119 pushConstantTwoBytecode)
(120 returnReceiver)
(121 returnTrue)
(122 returnFalse)
(123 returnNil)
(124 returnTopFromMethod)
(125 returnTopFromBlock)
(126 127 unknownBytecode)
(128 extendedPushBytecode)
(129 extendedStoreBytecode)
(130 extendedStoreAndPopBytecode)
(131 singleExtendedSendBytecode)
(132 doubleExtendedDoAnythingBytecode)
(133 singleExtendedSuperBytecode)
(134 secondExtendedSendBytecode)
(135 popStackBytecode)
(136 duplicateTopBytecode)
(137 pushActiveContextBytecode)
(138 pushNewArrayBytecode)),
((InitializationOptions at: #SpurObjectMemory ifAbsent: [false])
ifTrue: [#((139 callPrimitiveBytecode))] "V3PlusClosures on Spur"
ifFalse: [#((139 unknownBytecode))]), "V3PlusClosures on V3"
#(
(140 pushRemoteTempLongBytecode)
(141 storeRemoteTempLongBytecode)
(142 storeAndPopRemoteTempLongBytecode)
(143 pushClosureCopyCopiedValuesBytecode)
(144 151 shortUnconditionalJump)
(152 159 shortConditionalJumpFalse)
(160 167 longUnconditionalJump)
(168 171 longJumpIfTrue)
(172 175 longJumpIfFalse)
"176-191 were sendArithmeticSelectorBytecode"
(176 bytecodePrimAdd)
(177 bytecodePrimSubtract)
(178 bytecodePrimLessThan)
(179 bytecodePrimGreaterThan)
(180 bytecodePrimLessOrEqual)
(181 bytecodePrimGreaterOrEqual)
(182 bytecodePrimEqual)
(183 bytecodePrimNotEqual)
(184 bytecodePrimMultiply)
(185 bytecodePrimDivide)
(186 bytecodePrimMod)
(187 bytecodePrimMakePoint)
(188 bytecodePrimBitShift)
(189 bytecodePrimDiv)
(190 bytecodePrimBitAnd)
(191 bytecodePrimBitOr)
"192-207 were sendCommonSelectorBytecode"
(192 bytecodePrimAt)
(193 bytecodePrimAtPut)
(194 bytecodePrimSize)
(195 bytecodePrimNext)
(196 bytecodePrimNextPut)
(197 bytecodePrimAtEnd)
(198 bytecodePrimIdentical)
(199 bytecodePrimClass)
(200 bytecodePrimNotIdentical) "was bytecodePrimSpecialSelector24 / blockCopy"
(201 bytecodePrimValue)
(202 bytecodePrimValueWithArg)
(203 bytecodePrimDo)
(204 bytecodePrimNew)
(205 bytecodePrimNewWithArg)
(206 bytecodePrimPointX)
(207 bytecodePrimPointY)
(208 223 sendLiteralSelector0ArgsBytecode)
(224 239 sendLiteralSelector1ArgBytecode)
(240 255 sendLiteralSelector2ArgsBytecode)
)!
Item was changed:
----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid (in category 'initialization') -----
initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid
"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosuresNewspeakV4Hybrid"
| v3Table v4Table |
self initializeBytecodeTableForNewspeakV4.
v4Table := BytecodeTable.
AltBytecodeEncoderClassName := BytecodeEncoderClassName.
AltLongStoreBytecode := LongStoreBytecode.
self initializeBytecodeTableForSqueakV3PlusClosures.
BytecodeSetHasExtensions := true.
+ PCPreviousToFunction := #pcPreviousTo:inSqueakV3PlusClosuresOrNewsqueakV4Method:.
v3Table := BytecodeTable.
BytecodeTable := v3Table, v4Table!
Item was changed:
----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid (in category 'initialization') -----
initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid
"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid"
| v3Table v1Table |
self initializeBytecodeTableForSistaV1.
v1Table := BytecodeTable.
AltBytecodeEncoderClassName := BytecodeEncoderClassName.
AltLongStoreBytecode := LongStoreBytecode.
self initializeBytecodeTableForSqueakV3PlusClosures.
BytecodeSetHasExtensions := true.
+ PCPreviousToFunction := #pcPreviousTo:inSqueakV3PlusClosuresOrSistaV1Method:.
v3Table := BytecodeTable.
BytecodeTable := v3Table, v1Table!
Item was changed:
----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
initializeMiscConstants
super initializeMiscConstants.
STACKVM := true.
+ RevisedSuspend := true. "primitiveSuspend no longer allows a process waiting on a condition variable to go past the condition variable"
+
"These flags identify a GC operation (& hence a reason to leak check),
or just operations the leak checker can be run for."
GCModeFull := 1. "stop-the-world global GC"
GCModeNewSpace := 2. "Spur's scavenge, or V3's incremental"
GCModeIncremental := 4. "incremental global gc (Dijkstra tri-colour marking); as yet unimplemented"
GCModeBecome := 8. "v3 post-become sweeping/Spur forwarding"
GCCheckImageSegment := 16. "just a flag for leak checking image segments"
GCCheckFreeSpace := 32. "just a flag for leak checking free space; Spur only"
GCCheckShorten := 64. "just a flag for leak checking object shortening operations; Spur only"
GCCheckPrimCall := 128. "just a flag for leak checking external primitive calls"
StackPageTraceInvalid := -1.
StackPageUnreached := 0.
StackPageReachedButUntraced := 1.
StackPageTraced := 2.
DumpStackOnLowSpace := 0.
MillisecondClockMask := 16r1FFFFFFF.
"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
MaxExternalPrimitiveTableSize := 4096. "entries"
MaxJumpBuf := 32. "max. callback depth"
FailImbalancedPrimitives := InitializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true].
EnforceAccessControl := InitializationOptions at: #EnforceAccessControl ifAbsent: [true].
ReturnToInterpreter := 1. "setjmp/longjmp code."
"Because of a hack with callbacks in the non-threaded VM they must not conflct with the VM's tag bits."
DisownVMForFFICall := 16.
DisownVMForThreading := 32
!
Item was changed:
----- Method: StackInterpreter class>>requiredMethodNames: (in category 'translation') -----
requiredMethodNames: options
"Answer the list of method names that should be retained for export or other support reasons"
| requiredList |
"A number of methods required by VM support code, specific platforms, etc"
requiredList := #(
assertValidExecutionPointe:r:s:
characterForAscii:
findClassOfMethod:forReceiver: findSelectorOfMethod:
forceInterruptCheck forceInterruptCheckFromHeartbeat fullDisplayUpdate
getCurrentBytecode getFullScreenFlag getInterruptKeycode getInterruptPending
getSavedWindowSize getThisSessionID
interpret
loadInitialContext
primitiveFail primitiveFailFor: primitiveFlushExternalPrimitives printAllStacks printCallStack printContext:
printExternalHeadFrame printFramesInPage: printFrame: printMemory printOop:
printStackPages printStackPageList printStackPagesInUse printStackPageListInUse
readImageFromFile:HeapSize:StartingAt:
setFullScreenFlag: setInterruptKeycode: setInterruptPending: setInterruptCheckChain:
setSavedWindowSize: success:
validInstructionPointer:inMethod:framePointer:) asSet.
"Nice to actually have all the primitives available"
requiredList addAll: (self primitiveTable select: [:each| each isSymbol]).
"InterpreterProxy is the internal analogue of sqVirtualMachine.c, so make sure to keep all those"
InterpreterProxy organization categories do:
[:cat |
((cat ~= 'initialize') and: [cat ~= 'private']) ifTrue:
[requiredList addAll: (InterpreterProxy organization listAtCategoryNamed: cat)]].
+ requiredList add: PCPreviousToFunction.
+
^requiredList!
Item was added:
+ ----- Method: StackInterpreter>>backupProcess:toBlockingSendTo: (in category 'process primitive support') -----
+ backupProcess: aProcess toBlockingSendTo: conditionVariable
+ "Assume aProcess is waiting on a condition variable.
+ Backup the PC of aProcess to the send that entered the wait state.
+ primitiveEnterCriticalSection pushes false for blocked waiters. false
+ must be replaced by the condition variable."
+
+ | context theMethod pc sp theIP theNewIP theFP thePage |
+ context := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess.
+ self assert: (objectMemory isContext: context).
+ theMethod := objectMemory fetchPointer: MethodIndex ofObject: context.
+ (self isSingleContext: context) ifTrue:
+ [pc := objectMemory fetchPointer: InstructionPointerIndex ofObject: context.
+ sp := objectMemory fetchPointer: StackPointerIndex ofObject: context.
+ self assert: ((objectMemory isIntegerObject: pc) and: [(objectMemory integerValueOf: pc) > 0]).
+ self assert: ((objectMemory isIntegerObject: sp) and: [(objectMemory integerValueOf: sp) > 0]).
+ theIP := theMethod + objectMemory baseHeaderSize + (objectMemory integerValueOf: 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: context
+ withValue: (objectMemory integerObjectOf: pc).
+ sp := (objectMemory integerValueOf: sp) + ReceiverIndex. "implicitly converts to 0 relative"
+ self assert: ((objectMemory fetchPointer: sp ofObject: context) = objectMemory falseObject
+ or: [(objectMemory fetchPointer: sp ofObject: context) = conditionVariable]).
+ objectMemory storePointer: sp ofObject: context withValue: conditionVariable.
+ ^self].
+ self assert: (self isMarriedOrWidowedContext: context).
+ self deny: (self isWidowedContextNoConvert: context).
+ theFP := self frameOfMarriedContext: context.
+ thePage := stackPages stackPageFor: theFP.
+ self deny: thePage = stackPage.
+ self assert: theFP = thePage headFP.
+ theIP := (stackPages longAt: thePage headSP) + 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]).
+ 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 added:
+ ----- Method: StackInterpreter>>getClassTagOfLinkedList (in category 'process primitive support') -----
+ getClassTagOfLinkedList
+ "primitiveSuspend needs to know the class of LinkedList.
+ In Spur we use the class index, which will not chasnge over time.
+ In V3 we need the class object itself."
+
+ classLinkedListClassTag := objectMemory fetchClassTagOfNonImm:
+ (objectMemory
+ fetchPointer: 0
+ ofObject: (objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer))!
Item was changed:
----- Method: StackInterpreter>>getCogVMFeatureFlags (in category 'internal interpreter access') -----
getCogVMFeatureFlags
"Answer an array of flags indicating various optional features of the Cog VM.
+ If the bit is set then...
Bit 0: supports two bytecode sets (MULTIPLEBYTECODESETS)
Bit 1: supports immutablity (IMMUTABILITY)
Bit 2: suffers from a UNIX setitimer signal-based heartbeat
+ Bit 3: the VM provides cross-platform bit-identical floating point
+ Bit 4: the VM can catch exceptions in FFI calls and answer them as primitive failures
+ Bit 5: the suspend primitive backs up a process to before the wait if it was waiting on a condition variable"
- Bit 3: the VM provides cross-platform bit-identical floating point"
^objectMemory integerObjectOf: (MULTIPLEBYTECODESETS ifTrue: [1] ifFalse: [0])
+ (IMMUTABILITY ifTrue: [2] ifFalse: [0])
+ (self cppIf: #'ITIMER_HEARTBEAT' ifTrue: [4] ifFalse: [0])
+ (self cppIf: #'BIT_IDENTICAL_FLOATING_POINT' ifTrue: [8] ifFalse: [0])
+ + (self ioCanCatchFFIExceptions ifTrue: [16] ifFalse: [0])
+ + (RevisedSuspend ifTrue: [32] ifFalse: [0])!
- + (self ioCanCatchFFIExceptions ifTrue: [16] ifFalse: [0])!
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.
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 added:
+ ----- Method: StackInterpreter>>isNewsqueakV4Extension: (in category 'process primitive support') -----
+ isNewsqueakV4Extension: bytecode
+ <inline: #always>
+ ^bytecode between: 16rE0 and: 16rE1!
Item was added:
+ ----- Method: StackInterpreter>>isResumableContext: (in category 'process primitive support') -----
+ isResumableContext: aContext
+ self assert: (objectMemory isContext: aContext).
+ ^objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext)!
Item was added:
+ ----- Method: StackInterpreter>>isSistaV1Extension: (in category 'process primitive support') -----
+ isSistaV1Extension: bytecode
+ <inline: #always>
+ ^bytecode between: 16rE0 and: 16rE1!
Item was changed:
----- Method: StackInterpreter>>isWidowedContext: (in category 'frame access') -----
isWidowedContext: aOnceMarriedContext
+ "Answer if the argument is married to a live frame or not.
- "See if the argument is married to a live frame or not.
If it is not, turn it into a bereaved single context. This version is safe for use
only when no frameContext fields may be forwarded (as maybe the case
when scavenging). Post become: all frameContext fields are followed, and
+ hence normally no following of frameContext fields is necessary. But during
- hence nrmally no following of frameCOtext fields is necessary. But during
a scavenge one must use isWidowedContextDuringGC:."
+ | widowed |
+ widowed := self isWidowedContextNoConvert: aOnceMarriedContext.
+ widowed ifFalse:
+ [^false].
- | theFrame thePage shouldBeFrameCallerField |
- <var: #theFrame type: #'char *'>
- <var: #thePage type: #'StackPage *'>
- <var: #shouldBeFrameCallerField type: #'char *'>
- self assert: ((objectMemory isContext: aOnceMarriedContext)
- and: [self isMarriedOrWidowedContext: aOnceMarriedContext]).
- theFrame := self frameOfMarriedContext: aOnceMarriedContext.
- thePage := stackPages stackPageFor: theFrame.
- ((stackPages isFree: thePage)
- or: [theFrame < thePage headFP]) ifFalse:
- ["The frame pointer is within the bounds of a live page.
- Now check if it matches a frame."
- shouldBeFrameCallerField := self withoutSmallIntegerTags:
- (objectMemory
- fetchPointer: InstructionPointerIndex
- ofObject: aOnceMarriedContext).
- ((self frameCallerFP: theFrame) = shouldBeFrameCallerField
- and: [self frameHasContext: theFrame]) ifTrue:
- [self deny: (((self isFrame: theFrame onPage: thePage))
- and: [objectMemory isForwarded: (self frameContext: theFrame)]).
- (self frameContext: theFrame) = aOnceMarriedContext ifTrue: "It is still married!!"
- [^false]]].
- "It is out of range or doesn't match the frame's context.
- It is widowed. Time to wear black."
self markContextAsDead: aOnceMarriedContext.
^true!
Item was added:
+ ----- Method: StackInterpreter>>isWidowedContextNoConvert: (in category 'frame access') -----
+ isWidowedContextNoConvert: aOnceMarriedContext
+ "Answer if the argument is married to a live frame or not.
+ This method is safe for use only when no frameContext fields may be
+ forwarded (as maybe the case when scavenging). Post become: all
+ frameContext fields are followed, and hence normally no following of
+ frameContext fields is necessary."
+ <inline: true> "i.e. inline into isWidowedContext:"
+ | theFrame thePage shouldBeFrameCallerField |
+ self assert: ((objectMemory isContext: aOnceMarriedContext)
+ and: [self isMarriedOrWidowedContext: aOnceMarriedContext]).
+ theFrame := self frameOfMarriedContext: aOnceMarriedContext.
+ thePage := stackPages stackPageFor: theFrame.
+ ((stackPages isFree: thePage)
+ or: [theFrame < thePage headFP]) ifFalse:
+ ["The frame pointer is within the bounds of a live page.
+ Now check if it matches a frame."
+ shouldBeFrameCallerField := self withoutSmallIntegerTags:
+ (objectMemory
+ fetchPointer: InstructionPointerIndex
+ ofObject: aOnceMarriedContext).
+ ((self frameCallerFP: theFrame) = shouldBeFrameCallerField
+ and: [self frameHasContext: theFrame]) ifTrue:
+ [self deny: (((self isFrame: theFrame onPage: thePage))
+ and: [objectMemory isForwarded: (self frameContext: theFrame)]).
+ (self frameContext: theFrame) = aOnceMarriedContext ifTrue: "It is still married!!"
+ [^false]]].
+ ^true!
Item was changed:
----- Method: StackInterpreter>>loadInitialContext (in category 'initialization') -----
loadInitialContext
<inline: false>
| activeProc activeContext |
self cCode: [] inSmalltalk: [self initExtensions].
objectMemory runLeakCheckerFor: GCModeFull.
+ "primitiveSuspend needs to know the class of LinkedList"
+ self getClassTagOfLinkedList.
activeProc := self activeProcess.
activeContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext!
Item was changed:
----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
mapInterpreterOops
"Map all oops in the interpreter's state to their new values
during garbage collection or a become: operation."
"Assume: All traced variables contain valid oops."
<inline: false>
self mapStackPages.
self mapMachineCode: self getGCMode.
self mapTraceLogs.
self mapVMRegisters.
self mapProfileState.
self remapCallbackState.
(tempOop ~= 0
and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
[tempOop := objectMemory remapObj: tempOop].
(tempOop2 ~= 0
and: [objectMemory shouldRemapOop: tempOop2]) ifTrue:
+ [tempOop2 := objectMemory remapObj: tempOop2].
+ objectMemory hasSpurMemoryManagerAPI ifFalse:
+ [self getClassTagOfLinkedList]!
- [tempOop2 := objectMemory remapObj: tempOop2]!
Item was added:
+ ----- Method: StackInterpreter>>pcPreviousTo:inNewsqueakV4Method: (in category 'process primitive support') -----
+ pcPreviousTo: theIP inNewsqueakV4Method: aMethod
+ | byte previousPC thisIP |
+ thisIP := (self startPCOfMethod: aMethod) + aMethod + objectMemory baseHeaderSize.
+ self assert: (self oop: thisIP isLessThan: theIP).
+ [self oop: thisIP isLessThan: theIP] whileTrue:
+ [previousPC := thisIP.
+ [byte := objectMemory byteAt: thisIP.
+ thisIP := thisIP + (self sizeOfNewsqueakV4Bytecode: byte).
+ self isNewsqueakV4Extension: byte] whileTrue].
+ ^previousPC!
Item was added:
+ ----- Method: StackInterpreter>>pcPreviousTo:inSistaV1Method: (in category 'process primitive support') -----
+ pcPreviousTo: theIP inSistaV1Method: aMethod
+ | byte previousPC thisIP |
+ thisIP := (self startPCOfMethod: aMethod) + aMethod + objectMemory baseHeaderSize.
+ self assert: (self oop: thisIP isLessThan: theIP).
+ [self oop: thisIP isLessThan: theIP] whileTrue:
+ [previousPC := thisIP.
+ [byte := objectMemory byteAt: thisIP.
+ thisIP := thisIP + (self sizeOfSistaV1Bytecode: byte).
+ self isSistaV1Extension: byte] whileTrue].
+ ^previousPC!
Item was added:
+ ----- Method: StackInterpreter>>pcPreviousTo:inSqueakV3PlusClosuresMethod: (in category 'process primitive support') -----
+ pcPreviousTo: theIP inSqueakV3PlusClosuresMethod: aMethod
+ | byte previousPC thisIP |
+ thisIP := (self startPCOfMethod: aMethod) + aMethod + objectMemory baseHeaderSize.
+ self assert: (self oop: thisIP isLessThan: theIP).
+ [self oop: thisIP isLessThan: theIP] whileTrue:
+ [previousPC := thisIP.
+ byte := objectMemory byteAt: thisIP.
+ thisIP := thisIP + (self sizeOfSqueakV3Bytecode: byte)].
+ ^previousPC!
Item was added:
+ ----- Method: StackInterpreter>>pcPreviousTo:inSqueakV3PlusClosuresOrNewsqueakV4Method: (in category 'process primitive support') -----
+ pcPreviousTo: theIP inSqueakV3PlusClosuresOrNewsqueakV4Method: aMethod
+ (self methodUsesAlternateBytecodeSet: aMethod) ifTrue:
+ [^self pcPreviousTo: theIP inNewsqueakV4Method: aMethod].
+ ^self pcPreviousTo: theIP inSqueakV3PlusClosuresMethod: aMethod!
Item was added:
+ ----- Method: StackInterpreter>>pcPreviousTo:inSqueakV3PlusClosuresOrSistaV1Method: (in category 'process primitive support') -----
+ pcPreviousTo: theIP inSqueakV3PlusClosuresOrSistaV1Method: aMethod
+ (self methodUsesAlternateBytecodeSet: aMethod) ifTrue:
+ [^self pcPreviousTo: theIP inSistaV1Method: aMethod].
+ ^self pcPreviousTo: theIP inSqueakV3PlusClosuresMethod: aMethod!
Item was changed:
----- Method: StackInterpreter>>removeProcess:fromList: (in category 'process primitive support') -----
removeProcess: aProcess fromList: aList
"Remove a given process from a linked list. May fail if aProcess is not on the list."
| firstLink lastLink nextLink tempLink |
self deny: (objectMemory isForwarded: aProcess).
self deny: (objectMemory isForwarded: aList).
firstLink := objectMemory fetchPointer: FirstLinkIndex ofObject: aList.
lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList.
self deny: (objectMemory isForwarded: firstLink).
self deny: (objectMemory isForwarded: lastLink).
aProcess = firstLink
ifTrue:
[nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess.
self deny: (objectMemory isForwarded: nextLink).
objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: nextLink.
aProcess = lastLink ifTrue:
[objectMemory storePointerUnchecked: LastLinkIndex ofObject: aList withValue: objectMemory nilObject]]
ifFalse:
[tempLink := firstLink.
[self deny: (objectMemory isForwarded: tempLink).
tempLink = objectMemory nilObject ifTrue:
+ [^false].
- [self primitiveFail. ^self].
nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink.
nextLink = aProcess] whileFalse:
[tempLink := objectMemory fetchPointer: NextLinkIndex ofObject: tempLink].
nextLink := objectMemory fetchPointer: NextLinkIndex ofObject: aProcess.
objectMemory storePointer: NextLinkIndex ofObject: tempLink withValue: nextLink.
aProcess = lastLink ifTrue:
[objectMemory storePointer: LastLinkIndex ofObject: aList withValue: tempLink]].
+ objectMemory storePointerUnchecked: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject.
+ ^true!
- objectMemory storePointerUnchecked: NextLinkIndex ofObject: aProcess withValue: objectMemory nilObject!
Item was added:
+ ----- Method: StackInterpreter>>sizeOfNewsqueakV4Bytecode: (in category 'process primitive support') -----
+ sizeOfNewsqueakV4Bytecode: bytecode
+ <inline: #always>
+ "Answer the number of bytes in the bytecode."
+ ^bytecode < 16rE0
+ ifTrue: [1]
+ ifFalse:
+ [bytecode < 16rF9
+ ifTrue: [2]
+ ifFalse: [3]]!
Item was added:
+ ----- Method: StackInterpreter>>sizeOfSistaV1Bytecode: (in category 'process primitive support') -----
+ sizeOfSistaV1Bytecode: bytecode
+ <inline: #always>
+ "Answer the number of bytes in the bytecode."
+ ^bytecode < 16rE0
+ ifTrue: [1]
+ ifFalse:
+ [bytecode < 16rF8
+ ifTrue: [2]
+ ifFalse: [3]]!
Item was added:
+ ----- Method: StackInterpreter>>sizeOfSqueakV3Bytecode: (in category 'process primitive support') -----
+ sizeOfSqueakV3Bytecode: bytecode
+ <inline: #always>
+ | extensionSizes |
+ extensionSizes := self
+ cCoerce: #[2 2 2 2 3 2 2 1 1 1 2 3 3 3 3 4]
+ to: #'unsigned char *'.
+ "Answer the number of bytes in the bytecode."
+ ^bytecode <= 125
+ ifTrue: [1]
+ ifFalse:
+ [bytecode >= 176
+ ifTrue: [1]
+ ifFalse:
+ [bytecode >= 160 "long jumps"
+ ifTrue: [2]
+ ifFalse:
+ [bytecode >= 144 "short jumps"
+ ifTrue: [1]
+ ifFalse:
+ [bytecode >= 128 "extensions"
+ ifTrue: [extensionSizes at: bytecode - 128]
+ ifFalse:
+ [self assertf: 'illegal bytecode in sizeOfSqueakV3Bytecode:'. "126 & 127 are unused"
+ 1]]]]]!
Item was added:
+ ----- Method: StackInterpreterPrimitives>>primitiveSuspend (in category 'process primitives') -----
+ primitiveSuspend
+ "Primitive. Suspend the receiver, aProcess, such that it can be executed again
+ by sending #resume. If the given process is not the active process, take it off
+ its corresponding list. If the list was not its run queue assume it was on some
+ condition variable (Semaphore, Mutex) and back up its pc to the send that
+ invoked the wait state the process entered. Hence when the process resumes
+ it will reenter the wait state. Answer the list the receiver was previously on iff
+ it was not active and not blocked, otherwise answer nil."
+ | process myList ok |
+ process := self stackTop.
+ process = self activeProcess ifTrue:
+ [self pop: 1 thenPush: objectMemory nilObject.
+ ^self transferTo: self wakeHighestPriority].
+ "Alas in Spur we need a read barrier"
+ myList := objectMemory followField: MyListIndex ofObject: process.
+ myList = objectMemory nilObject ifTrue:
+ [^self primitiveFailFor: PrimErrBadReceiver].
+ ok := self removeProcess: process fromList: myList.
+ ok ifFalse:
+ [^self primitiveFailFor: PrimErrOperationFailed].
+ objectMemory storePointerUnchecked: MyListIndex ofObject: process withValue: objectMemory nilObject.
+ self assert: RevisedSuspend.
+ (RevisedSuspend
+ and: [(objectMemory fetchClassTagOfNonImm: myList) ~= classLinkedListClassTag])
+ ifTrue:
+ [self backupProcess: process toBlockingSendTo: myList.
+ self pop: 1 thenPush: objectMemory nilObject]
+ ifFalse:
+ [self pop: 1 thenPush: myList]!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveSuspend (in category 'debugging traps') -----
primitiveSuspend
"Catch errors before we start the whole morphic error process"
"byteCount > 1000000 ifTrue: [self halt]." "Ignore early process activity"
+ "self stackTop = (objectMemory fetchPointer: FirstLinkIndex ofObject: (objectMemory splObj: TheFinalizationSemaphore)) ifTrue:
+ [self halt]."
^ super primitiveSuspend!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveWait (in category 'debugging traps') -----
primitiveWait
"Catch errors before we start the whole morphic error process"
"byteCount > 1000000 ifTrue: [self halt]." "Ignore early process activity"
+ "self stackTop = (objectMemory splObj: TheFinalizationSemaphore) ifTrue:
+ [self halt]."
^ super primitiveWait!
More information about the Vm-dev
mailing list