diff --git a/extracted/vm/include/common/sqVirtualMachine.h b/extracted/vm/include/common/sqVirtualMachine.h index c3a45e96bf..c18bb63a19 100644 --- a/extracted/vm/include/common/sqVirtualMachine.h +++ b/extracted/vm/include/common/sqVirtualMachine.h @@ -247,19 +247,6 @@ typedef struct VirtualMachine { #if VM_PROXY_MINOR > 7 /* New methods for proxy version 1.8 */ - /* callbackEnter: Re-enter the interpreter loop for a callback. - Arguments: - callbackID: Pointer to a location receiving the callback ID - used in callbackLeave - Returns: True if successful, false otherwise */ - sqInt (*callbackEnter)(sqInt *callbackID); - - /* callbackLeave: Leave the interpreter from a previous callback - Arguments: - callbackID: The ID of the callback received from callbackEnter() - Returns: True if succcessful, false otherwise. */ - sqInt (*callbackLeave)(sqInt callbackID); - /* addGCRoot: Add a variable location to the garbage collector. The contents of the variable location will be updated accordingly. Arguments: diff --git a/extracted/vm/src/common/sqVirtualMachine.c b/extracted/vm/src/common/sqVirtualMachine.c index b40d1e1fd6..850fcb9d9f 100644 --- a/extracted/vm/src/common/sqVirtualMachine.c +++ b/extracted/vm/src/common/sqVirtualMachine.c @@ -191,15 +191,6 @@ void waitOnExternalSemaphoreIndex(sqInt semaphoreIndex); /* Proxy declarations for v1.8 */ -#if NewspeakVM -static sqInt -callbackEnter(sqInt *callbackID) { return 0; } -static sqInt -callbackLeave(sqInt callbackID) { return 0; } -#else -sqInt callbackEnter(sqInt *callbackID); -sqInt callbackLeave(sqInt callbackID); -#endif sqInt addGCRoot(sqInt *varLoc); sqInt removeGCRoot(sqInt *varLoc); @@ -431,8 +422,6 @@ struct VirtualMachine* sqGetInterpreterProxy(void) #endif #if VM_PROXY_MINOR > 7 - VM->callbackEnter = callbackEnter; - VM->callbackLeave = callbackLeave; VM->addGCRoot = addGCRoot; VM->removeGCRoot = removeGCRoot; #endif diff --git a/smalltalksrc/Slang/SlangMemoryManager.class.st b/smalltalksrc/Slang/SlangMemoryManager.class.st index 449646d4d6..633beb2b18 100644 --- a/smalltalksrc/Slang/SlangMemoryManager.class.st +++ b/smalltalksrc/Slang/SlangMemoryManager.class.st @@ -158,6 +158,12 @@ SlangMemoryManager >> initialize [ memoryMap := Dictionary new ] +{ #category : #'memory-access' } +SlangMemoryManager >> int32AtPointer: address put: aValue [ + + ^ self writeSignedInteger: aValue at: address size: 4 +] + { #category : #'memory-access' } SlangMemoryManager >> isValidAddress: address [ diff --git a/smalltalksrc/Slang/TMethod.class.st b/smalltalksrc/Slang/TMethod.class.st index b13b633b89..05afb44b7c 100644 --- a/smalltalksrc/Slang/TMethod.class.st +++ b/smalltalksrc/Slang/TMethod.class.st @@ -3158,8 +3158,6 @@ TMethod >> tryToInlineMethodStatementsIn: aCodeGen statementListsInto: aBlock [ stmtLists do: [ :stmtList | newStatements := OrderedCollection new: stmtList statements size. stmtList statements do: [ :stmt | - 1 haltIf: [ - stmt isSend and: [ stmt selector = #initStackPagesAndInterpret ] ]. (self inlineCodeOrNilForStatement: stmt returningNodes: returningNodes diff --git a/smalltalksrc/VMMaker-Tools/VMTStackFrame.class.st b/smalltalksrc/VMMaker-Tools/VMTStackFrame.class.st index f54ca8db40..6708d14a30 100644 --- a/smalltalksrc/VMMaker-Tools/VMTStackFrame.class.st +++ b/smalltalksrc/VMMaker-Tools/VMTStackFrame.class.st @@ -64,5 +64,5 @@ VMTStackFrame >> memory: anObject [ { #category : #accessing } VMTStackFrame >> method [ - ^ self interpreter frameMethod: framePointer + ^ self interpreter iframeMethod: framePointer ] diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index 259c7d3709..09211f02f0 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -94,16 +94,6 @@ Class { 'initialMemoryAddress' ], #classVars : [ - 'CSCallbackEnter', - 'CSCallbackLeave', - 'CSCheckEvents', - 'CSEnterCriticalSection', - 'CSExitCriticalSection', - 'CSResume', - 'CSSignal', - 'CSSuspend', - 'CSWait', - 'CSYield', 'HasBeenReturnedFromMCPC', 'HasBeenReturnedFromMCPCOop', 'MFMethodFlagFrameIsMarkedFlag', @@ -136,11 +126,12 @@ Class { { #category : #translation } CoInterpreter class >> ancilliaryClasses [ "Answer any extra classes to be included in the translation." - ^ super ancilliaryClasses, - { - CogBlockMethod. - CogPrimitiveDescriptor. }, - ((Cogit ancilliaryClasses) select: [:class| class inheritsFrom: CogBlockMethod]) + + ^ super ancilliaryClasses , { + CogMethod. + CogPrimitiveDescriptor } + , (Cogit ancilliaryClasses select: [ :class | + class inheritsFrom: CogMethod ]) ] { #category : #translation } @@ -310,17 +301,7 @@ CoInterpreter class >> initializeMiscConstants [ TraceIsFromMachineCode := 1. TraceIsFromInterpreter := 2. - CSCallbackEnter := 3. - CSCallbackLeave := 4. - CSEnterCriticalSection := 5. - CSExitCriticalSection := 6. - CSResume := 7. - CSSignal := 8. - CSSuspend := 9. - CSWait := 10. - CSYield := 11. - CSCheckEvents := 12. - + TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal' 'suspend' 'wait' 'yield' 'eventcheck' ). "this is simulation only" @@ -519,7 +500,7 @@ CoInterpreter >> activateCoggedNewMethod: inInterpreter [ { #category : #'control primitives' } CoInterpreter >> activateNewFullClosure: blockClosure method: theMethod numArgs: numArgs mayContextSwitch: mayContextSwitch [ "Similar to activateNewMethod but for Closure and newMethod." - | numCopied methodHeader numTemps inInterpreter switched | + | numCopied methodHeader inInterpreter | self assert: theMethod = (objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure). methodHeader := self rawHeaderOf: theMethod. @@ -528,7 +509,7 @@ CoInterpreter >> activateNewFullClosure: blockClosure method: theMethod numArgs: executeFullCogBlock: (self cogMethodOf: theMethod) closure: blockClosure mayContextSwitch: mayContextSwitch]. - numCopied := self copiedValueCountOfFullClosure: blockClosure. + "How do we know when to compile a block method? One simple criterion is to check if the block is running within its inner context, i.e. if the outerContext is married. @@ -541,8 +522,9 @@ CoInterpreter >> activateNewFullClosure: blockClosure method: theMethod numArgs: [((self isInstructionPointerInInterpreter: instructionPointer) not "If from machine code (via value primitive) attempt jitting" or: [theMethod = lastCoggableInterpretedBlockMethod]) "If from interpreter and repeat block, attempt jitting" ifTrue: - [theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue: - [cogit cogFullBlockMethod: theMethod numCopied: numCopied. + [theMethod ~= lastUncoggableInterpretedBlockMethod ifTrue: [ + numCopied := self copiedValueCountOfFullClosure: blockClosure. + cogit cogFullBlockMethod: theMethod numCopied: numCopied. (self methodHasCogMethod: theMethod) ifTrue: [^self executeFullCogBlock: (self cogMethodOf: theMethod) closure: blockClosure @@ -567,96 +549,35 @@ CoInterpreter >> activateNewFullClosure: blockClosure method: theMethod numArgs: (inInterpreter := self isInstructionPointerInInterpreter: instructionPointer) ifFalse: [instructionPointer = cogit ceReturnToInterpreterPC ifTrue: [instructionPointer := self iframeSavedIP: framePointer]]. - - self push: instructionPointer. - self push: framePointer. - framePointer := stackPointer. - self push: theMethod. - self push: objectMemory nilObject. "FxThisContext field" - self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs). - self push: 0. "FoxIFSavedIP" - "Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid." - self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure). - - "Copy the copied values..." - 0 to: numCopied - 1 do: - [:i| - self push: (objectMemory - fetchPointer: i + FullClosureFirstCopiedValueIndex - ofObject: blockClosure)]. - - self assert: (self frameIsBlockActivation: framePointer). - self assert: (self frameHasContext: framePointer) not. - - methodHeader := objectMemory methodHeaderOf: theMethod. - numTemps := self temporaryCountOfMethodHeader: methodHeader. - - numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject]. - - instructionPointer := (self initialIPForHeader: methodHeader method: theMethod) - 1. - self setMethod: theMethod. - - "Now check for stack overflow or an event (interrupt, must scavenge, etc)" - switched := false. - stackPointer < stackLimit ifTrue: - [switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]. - self returnToExecutive: inInterpreter postContextSwitch: switched + ^ super activateNewFullClosure: blockClosure method: theMethod numArgs: numArgs mayContextSwitch: mayContextSwitch ] { #category : #'message sending' } CoInterpreter >> activateNewMethod [ - | methodHeader numArgs numTemps rcvr inInterpreter switched | - - methodHeader := objectMemory methodHeaderOf: newMethod. - numTemps := self temporaryCountOfMethodHeader: methodHeader. - numArgs := self argumentCountOfMethodHeader: methodHeader. - - rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?" - self assert: (objectMemory isOopForwarded: rcvr) not. - - "Because this is an uncogged method we need to continue via the interpreter. - We could have been reached either from the interpreter, in which case we - should simply return, or from a machine code frame or from a compiled - primitive. In these latter two cases we must longjmp back to the interpreter. - The instructionPointer tells us which path we took. - If the sender was an interpreter frame but called through a (failing) primitive - then make sure we restore the saved instruction pointer and avoid pushing - ceReturnToInterpreterPC which is only valid between an interpreter caller - frame and a machine code callee frame." - (inInterpreter := self isInstructionPointerInInterpreter: instructionPointer) ifFalse: - [instructionPointer = cogit ceReturnToInterpreterPC ifTrue: - [instructionPointer := self iframeSavedIP: framePointer]]. - self push: instructionPointer. - self push: framePointer. - framePointer := stackPointer. - self push: newMethod. - self setMethod: newMethod methodHeader: methodHeader. - self push: objectMemory nilObject. "FxThisContext field" - self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs). - self push: 0. "FoxIFSavedIP" - self push: rcvr. - - "clear remaining temps to nil" - numArgs+1 to: numTemps do: - [:i | self push: objectMemory nilObject]. - instructionPointer := (self initialIPForHeader: methodHeader method: newMethod) - 1. + | methodHeader inInterpreter switched | + + "Eagerly compile it if appropriate so that doits are fast." + methodHeader := self rawHeaderOf: newMethod. + (self isCogMethodReference: methodHeader) ifFalse: [ + (self methodWithHeaderShouldBeCogged: methodHeader) + ifTrue: [ + cogit cog: newMethod selector: objectMemory nilObject. + methodHeader := self rawHeaderOf: newMethod ] + ifFalse: [ self maybeFlagMethodAsInterpreted: newMethod ] ]. - (self methodHeaderHasPrimitive: methodHeader) ifTrue: - ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts - with a long store temp. Strictly no need to skip the store because it's effectively a noop." - instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader). - primFailCode ~= 0 ifTrue: [ | shouldSkipStoreBytecode | - shouldSkipStoreBytecode := self reapAndResetErrorCodeTo: framePointer header: methodHeader. - shouldSkipStoreBytecode ifTrue: [ - instructionPointer := instructionPointer + (self sizeOfLongStoreTempBytecode: methodHeader) ] ] ]. + inInterpreter := self isInstructionPointerInInterpreter: + instructionPointer. + methodHeader := self justActivateNewMethod: true. "Now check for stack overflow or an event (interrupt, must scavenge, etc)." switched := true. - stackPointer < stackLimit ifTrue: - [switched := self handleStackOverflowOrEventAllowContextSwitch: - (self canContextSwitchIfActivating: newMethod header: methodHeader)]. + stackPointer < stackLimit ifTrue: [ + switched := self handleStackOverflowOrEventAllowContextSwitch: + (self + canContextSwitchIfActivating: newMethod + header: methodHeader) ]. self returnToExecutive: inInterpreter postContextSwitch: switched ] @@ -686,11 +607,7 @@ CoInterpreter >> allocateMemoryForImage: f withHeader: header [ cogCodeSize := cogCodeSize min: cogit maxCogCodeSize. objectMemory getMemoryMap initialCodeZoneSize: cogCodeSize. - - self allocateMemoryForImageHeader: header. - - imageReader loadImageFromFile: f withHeader: header. - + super allocateMemoryForImage: f withHeader: header. self beforeCodeZoneInitialization. cogit @@ -698,18 +615,6 @@ CoInterpreter >> allocateMemoryForImage: f withHeader: header [ upTo: objectMemory getMemoryMap codeZoneEnd ] -{ #category : #'cog jit support' } -CoInterpreter >> argumentCount [ - - ^argumentCount -] - -{ #category : #'cog jit support' } -CoInterpreter >> argumentCount: numArgs [ - - argumentCount := numArgs -] - { #category : #'trampoline support' } CoInterpreter >> argumentCountAddress [ @@ -718,16 +623,6 @@ CoInterpreter >> argumentCountAddress [ inSmalltalk: [cogit simulatedReadWriteVariableAddress: #argumentCount in: self] ] -{ #category : #'frame access' } -CoInterpreter >> asCogHomeMethod: aCogMethod [ - "Coerce either a CMMethod or a CMBlock to the home CMMethod" - - - ^aCogMethod cmType = CMMethod - ifTrue: [self cCoerceSimple: aCogMethod to: #'CogMethod *'] - ifFalse: [aCogMethod cmHomeMethod] -] - { #category : #'debug support' } CoInterpreter >> assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter line: ln [ @@ -762,9 +657,7 @@ CoInterpreter >> assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterp ((self asserta: methodField asUnsignedInteger >= cogit minCogMethodAddress l: ln) and: [self asserta: methodField asUnsignedInteger < cogit maxCogMethodAddress l: ln]) ifTrue: [cogMethod := self mframeHomeMethod: lifp. - self assert: (lip > (methodField + ((self mframeIsBlockActivation: lifp) - ifTrue: [self sizeof: CogBlockMethod] - ifFalse: [self sizeof: CogMethod])) + self assert: (lip > (methodField + (self sizeof: CogMethod)) and: [lip < (methodField + cogMethod blockSize)]) l: ln]. self assert: ((self mframeIsBlockActivation: lifp) @@ -785,16 +678,15 @@ CoInterpreter >> assertValidExternalStackPointers [ { #category : #'cog jit support' } CoInterpreter >> assertValidMachineCodeFrame: instrPtr [ + - | cogMethod homeMethod | - - + + | cogMethod | self assert: (self isMachineCodeFrame: framePointer). cogMethod := self mframeCogMethod: framePointer. - homeMethod := self asCogHomeMethod: cogMethod. - self assert: (cogMethodZone methodFor: cogMethod) = homeMethod. - self assert: (instrPtr > cogMethod asInteger - and: [instrPtr < (homeMethod asInteger + homeMethod blockSize)]) + self assert: (cogMethodZone methodFor: cogMethod) = cogMethod. + self assert: (instrPtr > cogMethod asInteger and: [ + instrPtr < (cogMethod asInteger + cogMethod blockSize) ]) ] { #category : #'debug support' } @@ -897,89 +789,19 @@ CoInterpreter >> attemptToSwitchToMachineCode: bcpc [ ] { #category : #'return bytecodes' } -CoInterpreter >> baseFrameReturn [ - - "Return from a baseFrame (the bottom frame in a stackPage). The context to - return to (which may be married) is stored in the first word of the stack." - - - - - - - - - - | contextToReturnTo retToContext theFP theSP thePage newPage frameAbove | - contextToReturnTo := self frameCallerContext: framePointer. - - "The stack page is effectively free now, so free it. We must free it to be - correct in determining if contextToReturnTo is still married, and in case - makeBaseFrameFor: cogs a method, which may cause a code compaction, - in which case the frame must be free to avoid the relocation machinery - tracing the dead frame. Since freeing now temporarily violates the page-list - ordering invariant, use the assert-free version." - stackPages freeStackPageNoAssert: stackPage. - retToContext := objectMemory isContext: contextToReturnTo. - (retToContext and: [ self isStillMarriedContext: contextToReturnTo ]) - ifTrue: [ - theFP := self frameOfMarriedContext: contextToReturnTo. - thePage := stackPages stackPageFor: theFP. - theFP = thePage headFP - ifTrue: [ theSP := thePage headSP ] - ifFalse: [ "Returning to some interior frame, presumably because of a sender assignment. - Move the frames above to another page (they may be in use, e.g. via coroutining). - Make the interior frame the top frame." - frameAbove := self findFrameAbove: theFP inPage: thePage. - "Since we've just deallocated a page we know that newStackPage won't deallocate an existing one." - newPage := stackPages newStackPage. - self assert: newPage = stackPage. - self moveFramesIn: thePage through: frameAbove toPage: newPage. - stackPages markStackPageMostRecentlyUsed: newPage. - theFP := thePage headFP. - theSP := thePage headSP ] ] - ifFalse: [ - (retToContext and: [ - objectMemory isIntegerObject: (objectMemory - fetchPointer: InstructionPointerIndex - ofObject: contextToReturnTo) ]) ifFalse: [ - | contextToReturnFrom | - contextToReturnFrom := stackPages longAt: - stackPage baseAddress - - objectMemory wordSize. - self - tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: - contextToReturnFrom - to: contextToReturnTo - returnValue: localReturnValue. - ^ self - externalCannotReturn: localReturnValue - from: contextToReturnFrom ]. - "We must void the instructionPointer to stop it being updated if makeBaseFrameFor: - cogs a method, which may cause a code compaction." - instructionPointer := 0. - thePage := self makeBaseFrameFor: contextToReturnTo. - theFP := thePage headFP. - theSP := thePage headSP ]. - self setStackPageAndLimit: thePage. - self assert: (stackPages stackPageFor: theFP) = stackPage. - stackPointer := theSP. - framePointer := theFP. - instructionPointer := self pointerForOop: self stackTop. +CoInterpreter >> baseFrameCannotReturnTo: contextToReturnTo [ - (self isInstructionPointerInInterpreter: instructionPointer) - ifFalse: [ - instructionPointer asUnsignedInteger - ~= cogit ceReturnToInterpreterPC ifTrue: [ "localIP in the cog method zone indicates a return to machine code." - ^ self returnToMachineCodeFrame ]. - instructionPointer := self pointerForOop: - (self iframeSavedIP: framePointer) ]. - self assert: (self - checkIsStillMarriedContext: contextToReturnTo - currentFP: framePointer). - self setMethod: (self iframeMethod: framePointer). - self stackTopPut: localReturnValue. - ^ self fetchNextBytecode + | contextToReturnFrom | + contextToReturnFrom := stackPages longAt: + stackPage baseAddress - objectMemory wordSize. + self + tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: + contextToReturnFrom + to: contextToReturnTo + returnValue: localReturnValue. + ^ self + externalCannotReturn: localReturnValue + from: contextToReturnFrom ] { #category : #hooks } @@ -991,27 +813,20 @@ CoInterpreter >> beforeCodeZoneInitialization [ CoInterpreter >> bytecodePCFor: theIP cogMethod: cogMethod startBcpc: startBcpc [ "Answer the mapping of the native pc theIP to a zero-relative bytecode pc. See contextInstructionPointer:frame: for the explanation." + - | cogMethodForIP mcpc | - + | mcpc | self assert: theIP < 0. - (theIP signedBitShift: -16) < -1 "See contextInstructionPointer:frame:" - ifTrue: - [cogMethodForIP := self cCoerceSimple: cogMethod asInteger - ((theIP signedBitShift: -16) * cogit blockAlignment) - to: #'CogBlockMethod *'. - self assert: cogMethodForIP cmType = CMBlock. - self assert: cogMethodForIP cmHomeMethod = cogMethod. - mcpc := cogMethodForIP asInteger - theIP signedIntFromShort] - ifFalse: - [cogMethodForIP := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'. - self assert: cogMethodForIP cmType = CMMethod. - mcpc := cogMethod asInteger - theIP. - "map any pcs in primitive code (i.e. return addresses for interpreter primitive calls) to the initial pc" - mcpc asUnsignedInteger < cogMethod stackCheckOffset ifTrue: - [^startBcpc]]. - self assert: (mcpc between: cogMethod asInteger and: cogMethod asInteger + cogMethod blockSize). - ^cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethodForIP + self assert: cogMethod cmType = CMMethod. + mcpc := cogMethod asInteger - theIP. + "map any pcs in primitive code (i.e. return addresses for interpreter primitive calls) to the initial pc" + mcpc asUnsignedInteger < cogMethod stackCheckOffset ifTrue: [ + ^ startBcpc ]. + self assert: (mcpc + between: cogMethod asInteger + and: cogMethod asInteger + cogMethod blockSize). + ^ cogit bytecodePCFor: mcpc startBcpc: startBcpc in: cogMethod ] { #category : #'common selector sends' } @@ -1087,98 +902,6 @@ CoInterpreter >> callRegisterArgCogMethod: cogMethod at: entryOffset receiver: r "NOTREACHED" ] -{ #category : #'callback support' } -CoInterpreter >> callbackEnter: callbackID [ - "Re-enter the interpreter for executing a callback" - | currentCStackPointer currentCFramePointer savedReenterInterpreter - wasInMachineCode calledFromMachineCode | - - - - - - - - "For now, do not allow a callback unless we're in a primitiveResponse" - (self asserta: primitiveFunctionPointer ~= 0) ifFalse: - [^false]. - - self assert: primFailCode = 0. - - "Check if we've exceeded the callback depth" - (self asserta: jmpDepth < MaxJumpBuf) ifFalse: - [^false]. - jmpDepth := jmpDepth + 1. - - wasInMachineCode := self isMachineCodeFrame: framePointer. - calledFromMachineCode := (self isInstructionPointerInInterpreter: instructionPointer) not. - - "Suspend the currently active process" - suspendedCallbacks at: jmpDepth put: self activeProcess. - "We need to preserve newMethod explicitly since it is not activated yet - and therefore no context has been created for it. If the caller primitive - for any reason decides to fail we need to make sure we execute the correct - method and not the one 'last used' in the call back" - suspendedMethods at: jmpDepth put: newMethod. - self flag: 'need to debug this properly. Conceptually it is the right thing to do but it crashes in practice'. - false - ifTrue: - ["Signal external semaphores since a signalSemaphoreWithIndex: request may - have been issued immediately prior to this callback before the VM has any - chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:" - self signalExternalSemaphores. - "If no process is awakened by signalExternalSemaphores then transfer - to the highest priority runnable one." - (suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue: - [self transferTo: self wakeHighestPriority from: CSCallbackLeave]] - ifFalse: - [self transferTo: self wakeHighestPriority from: CSCallbackLeave]. - - "Typically, invoking the callback means that some semaphore has been - signaled to indicate the callback. Force an interrupt check as soon as possible." - self forceInterruptCheck. - - "Save the previous CStackPointers and interpreter entry jmp_buf." - currentCStackPointer := cogit getCStackPointer. - currentCFramePointer := cogit getCFramePointer. - self memcpy: savedReenterInterpreter asVoidPointer - _: reenterInterpreter - _: (self sizeof: #'jmp_buf'). - cogit assertCStackWellAligned. - (self setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID" - [callbackID at: 0 put: jmpDepth. - self enterSmalltalkExecutive. - self assert: false "NOTREACHED"]. - - "Restore the previous CStackPointers and interpreter entry jmp_buf." - cogit setCStackPointer: currentCStackPointer. - cogit setCFramePointer: currentCFramePointer. - self memcpy: reenterInterpreter - _: (self cCoerceSimple: savedReenterInterpreter to: #'void *') - _: (self sizeof: #'jmp_buf'). - - "Transfer back to the previous process so that caller can push result" - self putToSleep: self activeProcess yieldingIf: preemptionYields. - self transferTo: (suspendedCallbacks at: jmpDepth) from: CSCallbackLeave. - newMethod := suspendedMethods at: jmpDepth. "see comment above" - argumentCount := self argumentCountOf: newMethod. - self assert: wasInMachineCode = (self isMachineCodeFrame: framePointer). - calledFromMachineCode - ifTrue: - [(self isInstructionPointerInInterpreter: instructionPointer) ifTrue: - [self iframeSavedIP: framePointer put: instructionPointer. - instructionPointer := cogit ceReturnToInterpreterPC]] - ifFalse: - ["Even if the context was flushed to the heap and rebuilt in transferTo:from: - above it will remain an interpreted frame because the context's pc would - remain a bytecode pc. So the instructionPointer must also be a bytecode pc." - self assert: (self isMachineCodeFrame: framePointer) not. - self assert: (self isInstructionPointerInInterpreter: instructionPointer)]. - self assert: primFailCode = 0. - jmpDepth := jmpDepth-1. - ^true -] - { #category : #enilopmarts } CoInterpreter >> ceActivateFailingPrimitiveMethod: aPrimitiveMethod [ @@ -1370,7 +1093,7 @@ CoInterpreter >> ceContext: maybeContext instVar: slotIndex [ (objectMemory isContextNonImm: maybeContext) ifTrue: [instructionPointer := self popStack. - result := self externalInstVar: slotIndex ofContext: maybeContext. + result := self instVar: slotIndex ofContext: maybeContext. self push: instructionPointer] ifFalse: [result := objectMemory fetchPointer: slotIndex ofObject: maybeContext]. ^result @@ -1386,7 +1109,7 @@ CoInterpreter >> ceContext: maybeMarriedContext instVar: slotIndex value: anOop and: [self isMarriedOrWidowedContext: maybeMarriedContext]) ifTrue: [instructionPointer := self popStack. - self externalInstVar: slotIndex ofContext: maybeMarriedContext put: anOop. + self instVar: slotIndex ofContext: maybeMarriedContext put: anOop. self push: instructionPointer] ifFalse: [objectMemory storePointer: slotIndex ofObject: maybeMarriedContext withValue: anOop]. @@ -1544,7 +1267,7 @@ CoInterpreter >> ceNonLocalReturn: returnValue [ "Update the current page's headFrame pointers to enable the search for unwind protects below to identify widowed contexts correctly." - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. "Since this is a block activation the closure is on the stack above any args and the frame." closure := self pushedReceiverOrClosureOfFrame: framePointer. @@ -1986,52 +1709,51 @@ CoInterpreter >> ceSendMustBeBooleanTo: aNonBooleanObject interpretingAtDelta: j 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." + - | cogMethod methodObj methodHeader startBcpc | - + + | cogMethod methodObj methodHeader startBcpc | self assert: (objectMemory addressCouldBeOop: aNonBooleanObject). 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 startPCOfMethod: methodObj]. + methodHeader := (self cCoerceSimple: cogMethod to: #'CogMethod *') + methodHeader. + methodObj := (self cCoerceSimple: cogMethod to: #'CogMethod *') + methodObject. + startBcpc := self startPCOfMethod: methodObj. "Map the machine code instructionPointer to the interpreter instructionPointer of the branch." instructionPointer := self popStack. - instructionPointer := cogit bytecodePCFor: instructionPointer startBcpc: startBcpc in: cogMethod. - instructionPointer := methodObj + objectMemory baseHeaderSize + instructionPointer - jumpSize - 1. "pre-decrement" + instructionPointer := cogit + bytecodePCFor: instructionPointer + startBcpc: startBcpc + in: cogMethod. + instructionPointer := methodObj + objectMemory baseHeaderSize + + instructionPointer - jumpSize - 1. "pre-decrement" "Make space for the two extra fields in an interpreter frame" - stackPointer to: framePointer + FoxMFReceiver by: objectMemory wordSize do: - [:p| | oop | - oop := objectMemory unsignedLongAt: p. - objectMemory + stackPointer to: framePointer + FoxMFReceiver by: + objectMemory wordSize do: [ :p | + | oop | + oop := objectMemory unsignedLongAt: p. + objectMemory unsignedLongAt: p - objectMemory wordSize - objectMemory wordSize - put: (objectMemory unsignedLongAt: p)]. - stackPointer := stackPointer - objectMemory wordSize - objectMemory wordSize. + put: (objectMemory unsignedLongAt: p) ]. + stackPointer := stackPointer - objectMemory wordSize + - objectMemory wordSize. self push: aNonBooleanObject. "Fill in the fields" objectMemory - unsignedLongAt: framePointer + FoxIFrameFlags - put: (self - encodeFrameFieldHasContext: (self mframeHasContext: framePointer) - isBlock: (self mframeIsBlockActivation: framePointer) - numArgs: cogMethod cmNumArgs); - unsignedLongAt: framePointer + FoxIFSavedIP - put: 0; - unsignedLongAt: framePointer + FoxMethod - put: methodObj. + unsignedLongAt: framePointer + FoxIFrameFlags put: (self + encodeFrameFieldHasContext: (self mframeHasContext: framePointer) + isBlock: (self mframeIsBlockActivation: framePointer) + numArgs: cogMethod cmNumArgs); + unsignedLongAt: framePointer + FoxIFSavedIP put: 0; + unsignedLongAt: framePointer + FoxMethod put: methodObj. "and now reenter the interpreter..." self setMethod: methodObj methodHeader: methodHeader. - self siglong: reenterInterpreter jmp: ReturnToInterpreter. + self siglong: reenterInterpreter jmp: ReturnToInterpreter ] { #category : #trampolines } @@ -2061,10 +1783,10 @@ CoInterpreter >> ceStackOverflow: contextSwitchIfNotNil [ closure (see e.g. SimpleStackBasedCogit>>compileMethodBody)." | cogMethod switched cesoRetAddr | - + cesoRetAddr := self popStack. "discard the ceStackOverflow call return address." cogMethod := self mframeCogMethod: framePointer. - self assert: cesoRetAddr - cogit abortOffset = (self asCogHomeMethod: cogMethod) asInteger. + self assert: cesoRetAddr - cogit abortOffset = cogMethod asInteger. instructionPointer := cogMethod asInteger + cogMethod stackCheckOffset. self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false line: #'__LINE__'. method := newMethod := messageSelector := objectMemory nilObject. @@ -2382,13 +2104,13 @@ CoInterpreter >> commenceCogCompiledCodeCompaction [ ["better not have already been pushed" self assert: self stackTop asUnsignedInteger ~= instructionPointer. self push: instructionPointer. - self externalWriteBackHeadStackPointer]. + self writeBackHeadStackPointer]. cogit compactCogCompiledCode. self nilUncoggableMethods. instructionPointer ~= 0 ifTrue: [instructionPointer := self popStack. - self externalWriteBackHeadStackPointer]. + self writeBackHeadStackPointer]. statCodeCompactionCount := statCodeCompactionCount + 1. statCodeCompactionUsecs := statCodeCompactionUsecs + (self ioUTCMicrosecondsNow - startTime). @@ -2398,67 +2120,6 @@ CoInterpreter >> commenceCogCompiledCodeCompaction [ self asserta: (self checkCodeIntegrity: false)] ] -{ #category : #'return bytecodes' } -CoInterpreter >> commonCallerReturn [ - - "Return to the previous context/frame (sender for method activations, caller for block activations)." - - - - | callersFPOrNull | - callersFPOrNull := self frameCallerFP: framePointer. - callersFPOrNull = 0 ifTrue: [ - self assert: framePointer = stackPage baseFP. - ^ self baseFrameReturn ]. "baseFrame" - - instructionPointer := self frameCallerSavedIP: framePointer. - stackPointer := framePointer - + (self frameStackedReceiverOffset: framePointer). - framePointer := callersFPOrNull. - (self isInstructionPointerInInterpreter: instructionPointer) - ifFalse: [ - instructionPointer asUnsignedInteger - ~= cogit ceReturnToInterpreterPC ifTrue: [ "localIP in the cog method zone indicates a return to machine code." - ^ self returnToMachineCodeFrame ]. - instructionPointer := self pointerForOop: - (self iframeSavedIP: framePointer) ]. - self setMethod: (self iframeMethod: framePointer). - self fetchNextBytecode. - self stackTopPut: localReturnValue -] - -{ #category : #'send bytecodes' } -CoInterpreter >> commonSendOrdinary [ - "Send a message, starting lookup with the receiver's class." - "Assume: messageSelector and argumentCount have been set, and that - the receiver and arguments have been pushed onto the stack," - "Note: This method is inlined into the interpreter dispatch loop." - - self sendBreakpoint: messageSelector receiver: (self stackValue: argumentCount). - cogit recordSendTrace ifTrue: - [self recordTrace: (objectMemory classForClassTag: lkupClassTag) - thing: messageSelector - source: TraceIsFromInterpreter. - cogit printOnTrace ifTrue: - [self printActivationNameForSelector: messageSelector - startClass: (objectMemory classForClassTag: lkupClassTag); cr]]. - self internalFindNewMethodOrdinary. - self internalExecuteNewMethod. - self fetchNextBytecode -] - -{ #category : #'indexing primitive support' } -CoInterpreter >> commonVariable: rcvr at: index cacheIndex: atIx [ - "There is no atCache in the CoInterpreter." - self shouldNotImplement -] - -{ #category : #'indexing primitive support' } -CoInterpreter >> commonVariable: rcvr at: index put: value cacheIndex: atIx [ - "There is no atCache in the CoInterpreter." - self shouldNotImplement -] - { #category : #'debug support' } CoInterpreter >> compilationBreak: selectorOop point: selectorLength isMNUCase: isMNUCase [ @@ -2524,7 +2185,7 @@ CoInterpreter >> convertToMachineCodeFrame: cogHomeMethod bcpc: bcpc [ "Convert the current interpreter frame into a machine code frame and answer the machine code pc matching bcpc." | startBcpc methodField closure cogMethod pc | - + self assert: (self isMachineCodeFrame: framePointer) not. "Update the return pc, perhaps saving it in the caller's iframeSavedIP." @@ -2545,11 +2206,11 @@ CoInterpreter >> convertToMachineCodeFrame: cogHomeMethod bcpc: bcpc [ ifTrue: [ closure := self pushedReceiverOrClosureOfFrame: framePointer. startBcpc := self startPCOfMethodHeader: cogHomeMethod methodHeader. - cogMethod := self cCoerceSimple: cogHomeMethod to: #'CogBlockMethod *'. + cogMethod := self cCoerceSimple: cogHomeMethod to: #'CogMethod *'. methodField := cogMethod asInteger + MFMethodFlagIsBlockFlag] ifFalse: [ startBcpc := self startPCOfMethodHeader: cogHomeMethod methodHeader. - cogMethod := self cCoerceSimple: cogHomeMethod to: #'CogBlockMethod *'. + cogMethod := self cCoerceSimple: cogHomeMethod to: #'CogMethod *'. methodField := cogHomeMethod asInteger ]. "compute the pc before converting the frame to help with debugging." pc := cogit mcPCForBackwardBranch: bcpc startBcpc: startBcpc in: cogMethod. @@ -2569,12 +2230,6 @@ CoInterpreter >> convertToMachineCodeFrame: cogHomeMethod bcpc: bcpc [ ^pc ] -{ #category : #'stack pages' } -CoInterpreter >> defaultNativeStackFrameSize [ - - ^ super defaultNativeStackFrameSize -] - { #category : #'process primitive support' } CoInterpreter >> deferStackLimitSmashAround: functionSymbol [ "Defer smashes of the stackLimit around the call of functionSymbol (for assert checks)" @@ -2623,7 +2278,7 @@ CoInterpreter >> divorceAMachineCodeFrameWithCogMethod: cogMethod in: aStackPage [((self isMachineCodeFrame: theFP) and: [cogMethod = (self mframeHomeMethod: theFP)]) ifTrue: [theContext := self ensureFrameIsMarried: theFP SP: theSP. - self externalDivorceFrame: theFP andContext: theContext. + self divorceFrame: theFP andContext: theContext. ^true]. calleeFP := theFP. theFP := self frameCallerFP: theFP. @@ -2667,6 +2322,18 @@ CoInterpreter >> divorceSomeMachineCodeFramesWithMethod: cogMethod [ ^divorcedSome ] +{ #category : #'send bytecodes' } +CoInterpreter >> doRecordSendTrace [ + + + cogit recordSendTrace ifTrue: [ + self + recordTrace: (objectMemory classForClassTag: lkupClassTag) + thing: messageSelector + source: TraceIsFromInterpreter. + super doRecordSendTrace ] +] + { #category : #'debug support' } CoInterpreter >> dumpPrimTraceLog [ "The prim trace log is a circular buffer of entries. If there is @@ -2709,22 +2376,11 @@ CoInterpreter >> encodedNativePCOf: mcpc cogMethod: cogMethod [ machine code from bytecode pcs, which we do by using negative values for machine code pcs. - As a whorish performance hack we also include the block method offset in - the pc of a block. The least significant 16 bits are the native pc and the most - significant 15 bits are the block start, in block alignment units. So when - mapping back we can find the start of the block. - See mustMapMachineCodePC:context: for the code that does the actual mapping." - - | homeMethod blockOffset | - + mcpc = cogit ceCannotResumePC ifTrue: [^HasBeenReturnedFromMCPCOop]. - cogMethod cmType = CMMethod ifTrue: - [^objectMemory integerObjectOf: cogMethod asInteger - mcpc]. - homeMethod := cogMethod cmHomeMethod. - blockOffset := homeMethod asInteger - cogMethod asInteger / cogit blockAlignment. - ^objectMemory integerObjectOf: ((blockOffset bitShift: 16) bitOr: (cogMethod asInteger - mcpc bitAnd: 16rFFFF)) + ^objectMemory integerObjectOf: cogMethod asInteger - mcpc ] { #category : #'frame access' } @@ -2844,13 +2500,6 @@ CoInterpreter >> enterSmalltalkExecutiveImplementation [ ^0 ] -{ #category : #'cog jit support' } -CoInterpreter >> error: aString [ - - - super error: aString -] - { #category : #enilopmarts } CoInterpreter >> executeCogMethod: cogMethod fromLinkedSendWithReceiver: rcvr [ @@ -2955,74 +2604,6 @@ CoInterpreter >> executeFullCogBlock: cogMethod closure: closure mayContextSwitc "NOTREACHED" ] -{ #category : #'message sending' } -CoInterpreter >> executeNewMethod [ - "Execute newMethod - either primitiveFunctionPointer must be set directly - (i.e. from primitiveExecuteMethod et al), or it would have been set probing - the method cache (i.e. primitivePerform et al). - Eagerly compile it if appropriate so that doits are fast." - | methodHeader inInterpreter | - inInterpreter := (self isInstructionPointerInInterpreter: instructionPointer). - primitiveFunctionPointer ~= 0 ifTrue: - [self isPrimitiveFunctionPointerAnIndex ifTrue: - [self externalQuickPrimitiveResponse. - self return: self popStack toExecutive: inInterpreter. - ^nil]. - "slowPrimitiveResponse may of course context-switch. If so we must reenter the - new process appopriately, returning only if we've reached here directly from the - interpreter and have found an interpreter frame. The instructionPointer tells us - from whence we came." - self slowPrimitiveResponse ifTrue: - [self return: self popStack toExecutive: inInterpreter. - ^nil]]. - "Eagerly compile it if appropriate so that doits are fast." - methodHeader := self rawHeaderOf: newMethod. - (self isCogMethodReference: methodHeader) ifFalse: - [(self methodWithHeaderShouldBeCogged: methodHeader) - ifTrue: - [cogit cog: newMethod selector: objectMemory nilObject. - methodHeader := self rawHeaderOf: newMethod] - ifFalse: [self maybeFlagMethodAsInterpreted: newMethod]]. - "if not primitive, or primitive failed, activate the method" - (self isCogMethodReference: methodHeader) - ifTrue: - [(self isInstructionPointerInInterpreter: instructionPointer) ifTrue: - [self iframeSavedIP: framePointer put: instructionPointer asInteger. - instructionPointer := cogit ceReturnToInterpreterPC]. - self activateCoggedNewMethod: inInterpreter] - ifFalse: - [self activateNewMethod] -] - -{ #category : #'stack bytecodes' } -CoInterpreter >> extendedStoreBytecodePop: popBoolean [ - - "Override to use itemporary:in:put:" - - - - | descriptor variableType variableIndex value | - - descriptor := self fetchByte. - variableType := descriptor >> 6 bitAnd: 3. - variableIndex := descriptor bitAnd: 63. - value := self stackTop. - popBoolean ifTrue: [ self pop: 1 ]. - variableType = 0 ifTrue: [ - objectMemory - storePointerImmutabilityCheck: variableIndex - ofObject: self receiver - withValue: value. - ^ self fetchNextBytecode ]. - variableType = 1 ifTrue: [ - self fetchNextBytecode. - ^ self itemporary: variableIndex in: framePointer put: value ]. - variableType = 3 ifTrue: [ - self storeLiteralVariable: variableIndex withValue: value. - ^ self fetchNextBytecode ]. - self error: 'illegal store' -] - { #category : #'return bytecodes' } CoInterpreter >> externalAboutToReturn: resultOop through: aContext [ | ourContext | @@ -3055,52 +2636,6 @@ CoInterpreter >> externalCannotReturn: resultOop from: aContext [ numArgs: 1 ] -{ #category : #'frame access' } -CoInterpreter >> externalInstVar: offset ofContext: aContext [ - "Fetch an instance variable from a maybe married context. - If the context is still married compute the value of the - relevant inst var from the spouse frame's state. - - If the context is single but has a negative instruction pointer - recognise that the instruction pointer is actually into machine - code and convert it to the corresponding bytecode pc." - - | value | - - self assert: (objectMemory isContext: aContext). - self assert: offset <= (ReceiverIndex + (self checkStackPointerForMaybeMarriedContext: aContext)). - "method, closureOrNil & receiver need no special handling; only - sender, pc & stackp have to be computed for married contexts." - (self isReadMediatedContextInstVarIndex: offset) ifFalse: - [^objectMemory fetchPointer: offset ofObject: aContext]. - - self externalWriteBackHeadFramePointers. - (self isStillMarriedContext: aContext) ifTrue: - [^self fetchPointer: offset ofMarriedContext: aContext]. - - value := objectMemory fetchPointer: offset ofObject: aContext. - (offset = InstructionPointerIndex - and: [(objectMemory isIntegerObject: value) - and: [value signedIntFromLong < 0]]) ifTrue: - [^self mustMapMachineCodePC: (objectMemory integerValueOf: value) context: aContext]. - ^value -] - -{ #category : #'cog jit support' } -CoInterpreter >> externalWriteBackHeadStackPointer [ - self assert: (stackPointer < stackPage baseAddress - and: [stackPointer > (stackPage realStackLimit - (LargeContextSlots * objectMemory bytesPerOop))]). - stackPage headSP: stackPointer -] - -{ #category : #utilities } -CoInterpreter >> externalizeIPandSP [ - "Copy the local instruction, stack and frame pointers to global variables for use in primitives and other functions outside the interpret loop." - - self assert: instructionPointer asUnsignedInteger ~= cogit ceReturnToInterpreterPC. - stackPointer := stackPointer. -] - { #category : #'debug support' } CoInterpreter >> fastLogPrim: aSelectorOrImmediate [ "Fast tracing of named primitives. primTraceLogIndex is a byte variable. @@ -3115,27 +2650,24 @@ CoInterpreter >> fastLogPrim: aSelectorOrImmediate [ CoInterpreter >> findNewMethodInClassTag: classTagArg [ "Find the compiled method to be run when the current messageSelector is sent to the given classTag, setting the values of newMethod and primitiveIndex." - | ok classTag | + - ok := self lookupInMethodCacheSel: messageSelector classTag: classTagArg. - ok ifTrue: - [self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector] - ifFalse: - ["entry was not found in the cache; perhaps soemthing was forwarded." - classTag := classTagArg. - ((objectMemory isOopForwarded: messageSelector) - or: [objectMemory isForwardedClassTag: classTag]) ifTrue: - [(objectMemory isOopForwarded: messageSelector) ifTrue: - [messageSelector := self handleForwardedSelectorFaultFor: messageSelector]. - (objectMemory isForwardedClassTag: classTag) ifTrue: - [classTag := self handleForwardedSendFaultForTag: classTag]. - ok := self lookupInMethodCacheSel: messageSelector classTag: classTag. - ok ifTrue: - [^self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]]. - "entry was not found in the cache; look it up the hard way " - lkupClass := objectMemory classForClassTag: classTag. - self lookupMethodInClass: lkupClass. - self addNewMethodToCache: lkupClass] + self findNewMethodInClassTag: classTagArg ifFound: [ + self + ifAppropriateCompileToNativeCode: newMethod + selector: messageSelector ] +] + +{ #category : #'message sending' } +CoInterpreter >> findNewMethodOrdinary [ + "Find the compiled method to be run when the current messageSelector is + sent to the given class, setting the values of newMethod and primitiveIndex." + + + ^ self findNewMethodOrdinaryIfFound: [ + self + ifAppropriateCompileToNativeCode: newMethod + selector: messageSelector ] ] { #category : #'method lookup cache' } @@ -3175,20 +2707,18 @@ CoInterpreter >> flushMethodCache [ { #category : #'message sending' } CoInterpreter >> followForwardedFieldsInCurrentMethod [ - | cogMethod | + + | cogMethod | (self isMachineCodeFrame: framePointer) - ifTrue: - [cogMethod := self mframeHomeMethod: framePointer. - objectMemory + ifTrue: [ + cogMethod := self mframeHomeMethod: framePointer. + objectMemory followForwardedObjectFields: cogMethod methodObject toDepth: 0. - cogit followForwardedLiteralsIn: cogMethod] - ifFalse: - [objectMemory - followForwardedObjectFields: method - toDepth: 0] + cogit followForwardedLiteralsIn: cogMethod ] + ifFalse: [ super followForwardedFieldsInCurrentMethod ] ] { #category : #'object memory support' } @@ -3218,7 +2748,7 @@ CoInterpreter >> followForwardingPointersInStackZone: theBecomeEffectsFlags [ - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue: [(objectMemory isForwarded: method) ifTrue: @@ -3292,17 +2822,6 @@ CoInterpreter >> followForwardingPointersInStackZone: theBecomeEffectsFlags [ theSP := theSP + objectMemory wordSize]]] ] -{ #category : #'process primitive support' } -CoInterpreter >> forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter [ - "Do a returnToExecutive: inInterpreter postContextSwitch: true for a process primtive - being sure to sample the profile clock before making the switch." - - "If we are profiling, take accurate primitive measures" - nextProfileTick > 0 ifTrue: - [self checkProfileTick: newMethod]. - ^self returnToExecutive: inInterpreter postContextSwitch: true -] - { #category : #'process primitive support' } CoInterpreter >> forceInterruptCheckFromHeartbeat [ "Force an interrupt check ASAP. This version is the @@ -3371,14 +2890,6 @@ CoInterpreter >> frameIsBlockActivation: theFP [ "" ifFalse: [self iframeIsBlockActivation: theFP] ] -{ #category : #'frame access' } -CoInterpreter >> frameMethodField: theFP [ - - - - ^stackPages unsignedLongAt: theFP + FoxMethod -] - { #category : #'frame access' } CoInterpreter >> frameMethodObject: theFP [ @@ -3391,11 +2902,12 @@ CoInterpreter >> frameMethodObject: theFP [ { #category : #'frame access' } CoInterpreter >> frameNumArgs: theFP [ "See encodeFrameFieldHasContext:numArgs:" + - ^(self isMachineCodeFrame: theFP) - ifTrue: [(self mframeCogMethod: theFP) cmNumArgs] - ifFalse: [stackPages byteAt: theFP + FoxIFrameFlags + 1] + ^ (self isMachineCodeFrame: theFP) + ifTrue: [ self mframeNumArgs: theFP ] + ifFalse: [ self iframeNumArgs: theFP ] ] { #category : #'frame access' } @@ -3583,10 +3095,10 @@ CoInterpreter >> getGCMode [ { #category : #'image save/restore' } CoInterpreter >> getImageHeaderFlags [ "Answer the flags that are contained in the 7th long of the image header." - ^(VMBIGENDIAN ifTrue: [0] ifFalse: [2]) "this is the imageFloatsLittleEndian flag" - + (flagInterpretedMethods ifTrue: [8] ifFalse: [0]) - + (preemptionYields ifTrue: [0] ifFalse: [16r10]) - + (imageHeaderFlags bitClear: 16rDB) "these are any flags we do not recognize" + + ^ super getImageHeaderFlags + (flagInterpretedMethods + ifTrue: [ 8 ] + ifFalse: [ 0 ]) ] { #category : #'internal interpreter access' } @@ -3677,7 +3189,6 @@ CoInterpreter >> ifAppropriateCompileToNativeCode: aMethodObj selector: selector { #category : #'jump bytecodes' } CoInterpreter >> ifBackwardsCheckForEvents: offsetToJumpBytecode [ - "Backward jump means we're in a loop. - check for possible interrupts. - check for long-running loops and JIT if appropriate." @@ -3686,12 +3197,10 @@ CoInterpreter >> ifBackwardsCheckForEvents: offsetToJumpBytecode [ | switched backwardJumpCountByte | offsetToJumpBytecode >= 0 ifTrue: [ ^ self ]. - stackPointer < stackLimit ifTrue: - [self externalizeIPandSP. - switched := self checkForEventsMayContextSwitch: true. - self returnToExecutive: true postContextSwitch: switched. - switched ifTrue: - [^self]]. + stackPointer < stackLimit ifTrue: [ + switched := self checkForEventsMayContextSwitch: true. + self returnToExecutive: true postContextSwitch: switched. + switched ifTrue: [ ^ self ] ]. "We use the least significant byte of the flags word (which is marked as an immediate) and subtract two each time to avoid disturbing the least significant tag bit. Since the byte is @@ -3700,20 +3209,21 @@ CoInterpreter >> ifBackwardsCheckForEvents: offsetToJumpBytecode [ (backwardJumpCountByte := backwardJumpCountByte - 2) = 1 ifTrue: [ (self methodWithHeaderShouldBeCogged: - (objectMemory methodHeaderOf: method)) ifTrue: [ - self externalizeIPandSP. - self attemptToSwitchToMachineCode: - (self oopForPointer: instructionPointer) - offsetToJumpBytecode - method - - objectMemory baseHeaderSize - 1 - "If attemptToSwitchToMachineCode: returns the method could not be cogged, hence..."]. - "can't cog method; avoid asking to cog it again for the longest possible time." - backwardJumpCountByte := 16r7F ] + (objectMemory methodHeaderOf: method)) ifTrue: [ + self attemptToSwitchToMachineCode: + (self oopForPointer: instructionPointer) - offsetToJumpBytecode + - method - objectMemory baseHeaderSize - 1 + "If attemptToSwitchToMachineCode: returns the method could not be cogged, hence..." ]. + "can't cog method; avoid asking to cog it again for the longest possible time." + backwardJumpCountByte := 16r7F ] ifFalse: [ backwardJumpCountByte = -1 ifTrue: [ "initialize the count" self assert: minBackwardJumpCountForCompile <= 128. - backwardJumpCountByte := minBackwardJumpCountForCompile - 1 << 1 + 1 ] ]. - self iframeBackwardBranchByte: framePointer put: backwardJumpCountByte - + backwardJumpCountByte := minBackwardJumpCountForCompile - 1 << 1 + + 1 ] ]. + self + iframeBackwardBranchByte: framePointer + put: backwardJumpCountByte ] { #category : #'debug support' } @@ -3786,6 +3296,14 @@ CoInterpreter >> iframeReceiver: theFP [ ^stackPages unsignedLongAt: theFP + FoxIFReceiver ] +{ #category : #'frame access' } +CoInterpreter >> iframeReceiverLocation: theFP [ + + + + ^ theFP + FoxIFReceiver +] + { #category : #'frame access' } CoInterpreter >> iframeSavedIP: theFP [ @@ -3805,65 +3323,38 @@ CoInterpreter >> initStackPagesAndInterpret [ self sqMakeMemoryNotExecutableFrom: objectMemory getMemoryMap startOfObjectMemory asUnsignedInteger To: objectMemory getMemoryMap oldSpaceEnd asUnsignedInteger. - self initStackPages. - - "Once the stack pages are initialized we can continue to bootstrap the system." - self loadInitialContext. - "We're ready for the heartbeat (poll interrupt)" - self ioInitHeartbeat. - self initialEnterSmalltalkExecutive. - ^nil + ^ super initStackPagesAndInterpret ] { #category : #'frame access' } CoInterpreter >> instVar: offset ofContext: aContext [ - "Fetch an instance avriable from a maybe married context. + "Fetch an instance variable from a maybe married context. If the context is still married compute the value of the relevant inst var from the spouse frame's state. If the context is single but has a negative instruction pointer recognise that the instruction pointer is actually into machine code and convert it to the corresponding bytecode pc." - | value spouseFP | - - - self assert: offset < MethodIndex. + + | value | + self assert: (objectMemory isContext: aContext). - self writeBackHeadFramePointers. - (self isMarriedOrWidowedContext: aContext) ifFalse: - [value := objectMemory fetchPointer: offset ofObject: aContext. - (offset = InstructionPointerIndex - and: [(objectMemory isIntegerObject: value) - and: [value signedIntFromLong < 0]]) ifTrue: - [value := self internalMustMapMachineCodePC: (objectMemory integerValueOf: value) - context: aContext]. - ^value]. - - (self isWidowedContext: aContext) ifTrue: + self assert: offset <= (ReceiverIndex + (self checkStackPointerForMaybeMarriedContext: aContext)). + "method, closureOrNil & receiver need no special handling; only + sender, pc & stackp have to be computed for married contexts." + (self isReadMediatedContextInstVarIndex: offset) ifFalse: [^objectMemory fetchPointer: offset ofObject: aContext]. - spouseFP := self frameOfMarriedContext: aContext. - offset = SenderIndex ifTrue: - [^self ensureCallerContext: spouseFP]. - offset = StackPointerIndex ifTrue: - [self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext). - ^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)]. - offset = InstructionPointerIndex ifTrue: - [^self instructionPointerForFrame: spouseFP currentFP: framePointer currentIP: (self oopForPointer: instructionPointer)]. - self error: 'bad index'. - ^0 -] - -{ #category : #'cog jit support' } -CoInterpreter >> instructionPointer [ - - ^instructionPointer -] - -{ #category : #'cog jit support' } -CoInterpreter >> instructionPointer: aValue [ - - instructionPointer := aValue + self writeBackHeadFramePointers. + (self isStillMarriedContext: aContext) ifTrue: + [^self fetchPointer: offset ofMarriedContext: aContext]. + + value := objectMemory fetchPointer: offset ofObject: aContext. + (offset = InstructionPointerIndex + and: [(objectMemory isIntegerObject: value) + and: [value signedIntFromLong < 0]]) ifTrue: + [^self mustMapMachineCodePC: (objectMemory integerValueOf: value) context: aContext]. + ^value ] { #category : #'trampoline support' } @@ -3902,143 +3393,12 @@ CoInterpreter >> instructionPointerForFrame: spouseFP currentFP: currentFP curre ifFalse: [value] ] -{ #category : #'message sending' } -CoInterpreter >> internalActivateNewMethod [ - - - | methodHeader numTemps rcvr switched | - methodHeader := self rawHeaderOf: newMethod. - self assert: (self isCogMethodReference: methodHeader) not. - numTemps := self temporaryCountOfMethodHeader: methodHeader. - self assert: - argumentCount = (self argumentCountOfMethodHeader: methodHeader). - rcvr := self stackValue: argumentCount. "could new rcvr be set at point of send?" - self assert: (objectMemory isOopForwarded: rcvr) not. - - self push: instructionPointer. - self push: framePointer. - framePointer := stackPointer. - self push: newMethod. - self setMethod: newMethod methodHeader: methodHeader. - self push: objectMemory nilObject. "FxThisContext field" - self push: (self - encodeFrameFieldHasContext: false - isBlock: false - numArgs: (self argumentCountOfMethodHeader: methodHeader)). - self push: 0. "FoxIFSavedIP" - self push: rcvr. - - "Initialize temps..." - argumentCount + 1 to: numTemps do: [ :i | - self push: objectMemory nilObject ]. - - "-1 to account for pre-increment in fetchNextBytecode" - instructionPointer := self pointerForOop: - (self - initialIPForHeader: methodHeader - method: newMethod) - 1. - - (self methodHeaderHasPrimitive: methodHeader) ifTrue: [ - "Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts - with a long store temp. Strictly no need to skip the store because it's effectively a noop." - instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader). - primFailCode ~= 0 ifTrue: [ | shouldSkipStoreBytecode | - shouldSkipStoreBytecode := self reapAndResetErrorCodeTo: framePointer header: methodHeader. - shouldSkipStoreBytecode ifTrue: [ - instructionPointer := instructionPointer + (self sizeOfLongStoreTempBytecode: methodHeader) ] ] ]. - - self assert: (self frameNumArgs: framePointer) = argumentCount. - self assert: (self frameIsBlockActivation: framePointer) not. - self assert: (self frameHasContext: framePointer) not. - - - "Now check for stack overflow or an event (interrupt, must scavenge, etc)." - stackPointer < stackLimit ifTrue: [ - self externalizeIPandSP. - switched := self handleStackOverflowOrEventAllowContextSwitch: - (self - canContextSwitchIfActivating: newMethod - header: methodHeader). - self returnToExecutive: true postContextSwitch: switched. - self internalizeIPandSP ] -] - -{ #category : #'message sending' } -CoInterpreter >> internalExecuteNewMethod [ - - "For interpreter performance and to ease the objectAsMethod implementation eagerly - evaluate the primtiive, i.e. if the method is cogged and has a primitive /do not/ evaluate - the machine code primitive, just evaluate primitiveFunctionPointer directly." - - - primitiveFunctionPointer ~= 0 ifTrue: [ - | succeeded | - self isPrimitiveFunctionPointerAnIndex ifTrue: [ - ^ self internalQuickPrimitiveResponse ]. - "slowPrimitiveResponse may of course context-switch. If so we must reenter the - new process appropriately, returning only if we've found an interpreter frame." - self externalizeIPandSP. - succeeded := self slowPrimitiveResponse. - instructionPointer = cogit ceReturnToInterpreterPC ifTrue: [ - instructionPointer := self iframeSavedIP: framePointer ]. - self internalizeIPandSP. - succeeded ifTrue: [ - self return: self popStack toExecutive: true. - ^ nil ] ]. - "if not primitive, or primitive failed, activate the method" - (self methodHasCogMethod: newMethod) - ifTrue: [ - self iframeSavedIP: framePointer put: instructionPointer asInteger. - instructionPointer := cogit ceReturnToInterpreterPC. - self externalizeFPandSP. - self activateCoggedNewMethod: true. - self internalizeIPandSP ] - ifFalse: [self internalActivateNewMethod] -] - -{ #category : #'message sending' } -CoInterpreter >> internalFindNewMethodOrdinary [ - "Find the compiled method to be run when the current messageSelector is - sent to the given class, setting the values of newMethod and primitiveIndex." - | ok | - - ok := self inlineLookupInMethodCacheSel: messageSelector classTag: lkupClassTag. - ok ifTrue: - [self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector] - ifFalse: - [self externalizeIPandSP. - ((objectMemory isOopForwarded: messageSelector) - or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue: - [(objectMemory isOopForwarded: messageSelector) ifTrue: - [messageSelector := self handleForwardedSelectorFaultFor: messageSelector]. - (objectMemory isForwardedClassTag: lkupClassTag) ifTrue: - [lkupClassTag := self handleForwardedSendFaultForTag: lkupClassTag]. - (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifTrue: - [^self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector]]. - lkupClass := objectMemory classForClassTag: lkupClassTag. - self assert: (lkupClass notNil and: [self addressCouldBeClassObj: lkupClass]). - self lookupMethodInClass: lkupClass. - self internalizeIPandSP. - self addNewMethodToCache: lkupClass] -] - { #category : #'frame access' } CoInterpreter >> internalMustMapMachineCodePC: theIP context: aOnceMarriedContext [ "Must externalize before calling mustMapMachineCodePC:context: because it may cause a code compaction." - | result | - self externalizeIPandSP. - result := self mustMapMachineCodePC: theIP context: aOnceMarriedContext. - self internalizeIPandSP. - ^result -] -{ #category : #utilities } -CoInterpreter >> internalizeIPandSP [ - "Copy the instruction, stack and frame pointers to local variables for rapid access within the interpret loop." - - self assert: instructionPointer ~= cogit ceReturnToInterpreterPC. - stackPointer := self pointerForOop: stackPointer + ^ self mustMapMachineCodePC: theIP context: aOnceMarriedContext ] { #category : #'trampoline support' } @@ -4059,48 +3419,35 @@ CoInterpreter >> interpretMethodFromMachineCode [ messageSelector, primitiveFunctionPointer and argumentCount have been set in the caller. Once evaluated either continue in the interpreter via a jongjmp or in machine code via an enilopmart (a form of longjmp - a stinking rose by any other name)." + cogit assertCStackWellAligned. - self assert: (self validInstructionPointer: instructionPointer inFrame: framePointer). - primitiveFunctionPointer ~= 0 - ifTrue: - [primitiveFunctionPointer = #primitiveInvokeObjectAsMethod - ifTrue: [self assert: (objectMemory isOopCompiledMethod: newMethod) not] - ifFalse: [self assert: ((objectMemory isOopCompiledMethod: newMethod) - and: [(self primitiveIndexOf: newMethod) ~= 0])]. - "Invoke an interpreter primitive (because the method is to be interpreted or has not yet been + self assert: (self + validInstructionPointer: instructionPointer + inFrame: framePointer). + + "Invoke an interpreter primitive (because the method is to be interpreted or has not yet been compiled). This is very similar to invoking an interpreter primitive from a compiled primitive (see e.g. SimpleStackBasedCogit>>compileInterpreterPrimitive:). Cut back the stack pointer (done above) to skip the return address and invoke the function. On return if it has succeeded simply continue otherwise restore the stackPointer, collect the pc and interpret. Note that frame building primitives such as primitiveClosureValue, primitiveEvaluateMethod et al will not - return but will instead jump into either machine code or longjmp back to the interpreter." - "Assign stackPage headFP so we can tell if the primitive built a frame. We can't simply save + return but will instead jump into either machine code or longjmp back to the interpreter.""Assign stackPage headFP so we can tell if the primitive built a frame. We can't simply save the framePointer since e.g. assignment to contexts (via primitiveInstVarAt:put:) can change the framePointer. But context assignments will change both the framePointer and stackPage headFP." - - self assert: (framePointer < stackPage baseAddress - and: [framePointer > (stackPage realStackLimit - (LargeContextSlots * objectMemory bytesPerOop / 2))]). - stackPage headFP: framePointer. - self isPrimitiveFunctionPointerAnIndex - ifTrue: - [self externalQuickPrimitiveResponse. - primFailCode := 0] - ifFalse: - [self slowPrimitiveResponse]. - self successful ifTrue: - [self return: self popStack toExecutive: false - "NOTREACHED"]] - ifFalse: - [self assert: ((objectMemory isOopCompiledMethod: newMethod) - and: [(self primitiveIndexOf: newMethod) = 0 - or: [(self functionPointerFor: (self primitiveIndexOf: newMethod) inClass: objectMemory nilObject) = 0 - or: [self isNullExternalPrimitiveCall: newMethod]]])]. - "if not primitive, or primitive failed, activate the method and reenter the interpreter" - self activateNewMethod. - self siglong: reenterInterpreter jmp: ReturnToInterpreter. - "NOTREACHED" - ^nil + + self assert: (framePointer < stackPage baseAddress and: [ + framePointer > (stackPage realStackLimit + - (LargeContextSlots * objectMemory bytesPerOop / 2)) ]). + stackPage headFP: framePointer. + + self + executePrimitiveFromInterpreter: false + ifFail: [ "if not primitive, or primitive failed, activate the method and reenter the interpreter" + self activateNewMethod. + self siglong: reenterInterpreter jmp: ReturnToInterpreter. + "NOTREACHED" + ^ nil ] ] { #category : #'stack pages' } @@ -4152,14 +3499,15 @@ CoInterpreter >> isCogMethodReference: methodHeader [ CoInterpreter >> isInstructionPointerInInterpreter: anIP [ - - ^ anIP asUnsignedInteger >= objectMemory getMemoryMap startOfObjectMemory + ^ (self isMachineCodeIP: anIP asUnsignedInteger) not ] { #category : #'frame access' } -CoInterpreter >> isMachineCodeFrame: theFP [ +CoInterpreter >> isMachineCodeFrame: theFP [ + - ^(stackPages unsignedLongAt: theFP + FoxMethod) asUnsignedInteger < objectMemory getMemoryMap startOfObjectMemory + ^ self isMachineCodeIP: + (stackPages unsignedLongAt: theFP + FoxMethod) asUnsignedInteger ] { #category : #'debug support' } @@ -4167,104 +3515,79 @@ CoInterpreter >> isMachineCodeIP: anInstrPointer [ ^anInstrPointer asUnsignedInteger < objectMemory getMemoryMap startOfObjectMemory ] -{ #category : #'internal interpreter access' } -CoInterpreter >> itemporary: offset in: theFP [ - "Temporary access for an interpreter frame only." - "See StackInterpreter class>>initializeFrameIndices" - | frameNumArgs | - - - ^offset < (frameNumArgs := self iframeNumArgs: theFP) - ifTrue: [stackPages unsignedLongAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory wordSize)] - ifFalse: [stackPages unsignedLongAt: theFP + FoxIFReceiver - objectMemory wordSize + ((frameNumArgs - offset) * objectMemory wordSize)] -] - -{ #category : #'internal interpreter access' } -CoInterpreter >> itemporary: offset in: theFP put: valueOop [ - "Temporary access for an interpreter frame only." - "See StackInterpreter class>>initializeFrameIndices" - | frameNumArgs | - - - ^offset < (frameNumArgs := self iframeNumArgs: theFP) - ifTrue: [stackPages unsignedLongAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory wordSize) put: valueOop] - ifFalse: [stackPages unsignedLongAt: theFP + FoxIFReceiver - objectMemory wordSize + ((frameNumArgs - offset) * objectMemory wordSize) put: valueOop] -] - { #category : #'message sending' } CoInterpreter >> justActivateNewMethod: mustBeInterpreterFrame [ - | methodHeader cogMethod numArgs numTemps rcvr initialIP | + + | methodHeader cogMethod numArgs numTemps rcvr | methodHeader := self rawHeaderOf: newMethod. - (mustBeInterpreterFrame not - and: [self isCogMethodReference: methodHeader]) ifTrue: - [cogMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'. - methodHeader := cogMethod methodHeader]. + ((self isCogMethodReference: methodHeader)) ifTrue: [ | theCogMethod | + theCogMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'. + methodHeader := theCogMethod methodHeader. + mustBeInterpreterFrame not ifTrue: [ + "Will be used to mark if we need to execute in interpreted mode or not" + cogMethod := theCogMethod ]]. numTemps := self temporaryCountOfMethodHeader: methodHeader. numArgs := self argumentCountOfMethodHeader: methodHeader. rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?" self assert: (objectMemory isOopForwarded: rcvr) not. - (cogMethod notNil - and: [self isInstructionPointerInInterpreter: instructionPointer]) ifTrue: - [self iframeSavedIP: framePointer put: instructionPointer. - instructionPointer := cogit ceReturnToInterpreterPC]. + (cogMethod notNil and: [ + self isInstructionPointerInInterpreter: instructionPointer ]) + ifTrue: [ + self iframeSavedIP: framePointer put: instructionPointer. + instructionPointer := cogit ceReturnToInterpreterPC ]. self push: instructionPointer. self push: framePointer. framePointer := stackPointer. - initialIP := self initialIPForHeader: methodHeader method: newMethod. cogMethod - ifNotNil: - [self push: cogMethod asUnsignedInteger. - self push: objectMemory nilObject. "FoxThisContext field" - instructionPointer := cogMethod asUnsignedInteger + cogMethod stackCheckOffset] - ifNil: - [self push: newMethod. - self setMethod: newMethod methodHeader: methodHeader. - self push: objectMemory nilObject. "FoxThisContext field" - self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs). - self push: 0. "FoxIFSavedIP" - instructionPointer := initialIP - 1]. + ifNotNil: [ + self push: cogMethod asUnsignedInteger. + self push: objectMemory nilObject. "FoxThisContext field" + instructionPointer := cogMethod asUnsignedInteger + + cogMethod stackCheckOffset ] + ifNil: [ + | initialIP | + initialIP := self + initialIPForHeader: methodHeader + method: newMethod. + self push: newMethod. + self setMethod: newMethod methodHeader: methodHeader. + self push: objectMemory nilObject. "FoxThisContext field" + self push: (self + encodeFrameFieldHasContext: false + isBlock: false + numArgs: numArgs). + self push: 0. "FoxIFSavedIP" + instructionPointer := initialIP - 1 ]. self push: rcvr. "clear remaining temps to nil" - numArgs+1 to: numTemps do: - [:i | self push: objectMemory nilObject]. + numArgs + 1 to: numTemps do: [ :i | + self push: objectMemory nilObject ]. - (self methodHeaderHasPrimitive: methodHeader) ifTrue: - ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts + (self methodHeaderHasPrimitive: methodHeader) ifTrue: [ "Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts with a long store temp. Strictly no need to skip the store because it's effectively a noop." - cogMethod ifNil: - [instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader)]. - primFailCode ~= 0 ifTrue: [ | shouldSkipStoreBytecode | - shouldSkipStoreBytecode := self reapAndResetErrorCodeTo: framePointer header: methodHeader. - (cogMethod isNil and: [shouldSkipStoreBytecode]) ifTrue: [ - instructionPointer := instructionPointer + (self sizeOfLongStoreTempBytecode: methodHeader) ] ] ].. - - ^methodHeader -] - -{ #category : #'stack bytecodes' } -CoInterpreter >> longPushTemporaryVariableBytecode [ - "230 11100110 i i i i i i i i Push Temporary Variable #iiiiiiii" - | index | - index := self fetchByte. - self fetchNextBytecode. - self push: (self itemporary: index in: framePointer) -] - -{ #category : #'stack bytecodes' } -CoInterpreter >> longStoreTemporaryVariableBytecode [ - - "234 11101010 i i i i i i i i Store Temporary Variable #iiiiiiii" - - | index | - index := self fetchByte. - self fetchNextBytecode. - self itemporary: index in: framePointer put: self stackTop + cogMethod ifNil: [ + instructionPointer := instructionPointer + + + (self sizeOfCallPrimitiveBytecode: + methodHeader) ]. + primFailCode ~= 0 ifTrue: [ + | shouldSkipStoreBytecode | + shouldSkipStoreBytecode := self + reapAndResetErrorCodeTo: framePointer + header: methodHeader. + (cogMethod isNil and: [ shouldSkipStoreBytecode ]) ifTrue: [ + instructionPointer := instructionPointer + + + (self sizeOfLongStoreTempBytecode: + methodHeader) ] ] ]. + + ^ methodHeader ] { #category : #simulation } @@ -4524,53 +3847,55 @@ CoInterpreter >> mapStackPages [ | numLivePages | numLivePages := 0. - 0 to: numStackPages - 1 do: [ :i | + 0 to: numStackPages - 1 do: [ :i | | thePage theSP theFP frameRcvrOffset callerFP theIPPtr theIP oop | thePage := stackPages stackPageAt: i. - thePage isFree ifFalse: [ + thePage isFree ifFalse: [ self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage). numLivePages := numLivePages + 1. theSP := thePage headSP. theFP := thePage headFP. "Skip the instruction pointer on top of stack of inactive pages." thePage = stackPage - ifTrue: [ - theIPPtr := ((self isMachineCodeFrame: theFP) or: [ + ifTrue: [ + theIPPtr := ((self isMachineCodeFrame: theFP) or: [ (self iframeSavedIP: theFP) = 0 ]) ifTrue: [ 0 ] ifFalse: [ theFP + FoxIFSavedIP ] ] - ifFalse: [ + ifFalse: [ theIPPtr := theSP. theSP := theSP + objectMemory wordSize ]. - [ + [ self assert: (thePage addressIsInPage: theFP). self assert: (thePage addressIsInPage: theSP). self assert: (theIPPtr = 0 or: [ thePage addressIsInPage: theIPPtr ]). frameRcvrOffset := self frameReceiverLocation: theFP. - [ theSP <= frameRcvrOffset ] whileTrue: [ + [ theSP <= frameRcvrOffset ] whileTrue: [ oop := stackPages unsignedLongAt: theSP. - (objectMemory shouldRemapOop: oop) ifTrue: [ - stackPages unsignedLongAt: theSP put: (objectMemory remapObj: oop) ]. + (objectMemory shouldRemapOop: oop) ifTrue: [ + stackPages + unsignedLongAt: theSP + put: (objectMemory remapObj: oop) ]. theSP := theSP + objectMemory wordSize ]. - (self frameHasContext: theFP) ifTrue: [ - (objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue: [ + (self frameHasContext: theFP) ifTrue: [ + (objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue: [ stackPages unsignedLongAt: theFP + FoxThisContext put: (objectMemory remapObj: (self frameContext: theFP)) ]. "With SpurPlanningCompactor can't assert since object body is yet to move." - objectMemory slidingCompactionInProgress not ifTrue: [ + objectMemory slidingCompactionInProgress not ifTrue: [ self assert: - ((self isMarriedOrWidowedContext: (self frameContext: theFP)) - and: [ + ((self isMarriedOrWidowedContext: (self frameContext: theFP)) + and: [ (self frameOfMarriedContext: (self frameContext: theFP)) = theFP ]) ] ]. - (self isMachineCodeFrame: theFP) ifFalse: [ - (objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue: [ - theIPPtr ~= 0 ifTrue: [ + (self isMachineCodeFrame: theFP) ifFalse: [ + (objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue: [ + theIPPtr ~= 0 ifTrue: [ theIP := stackPages unsignedLongAt: theIPPtr. theIP = cogit ceReturnToInterpreterPC - ifTrue: [ + ifTrue: [ self assert: (self iframeSavedIP: theFP) > (self iframeMethod: theFP). theIPPtr := theFP + FoxIFSavedIP. @@ -4580,19 +3905,21 @@ CoInterpreter >> mapStackPages [ stackPages unsignedLongAt: theFP + FoxMethod put: (objectMemory remapObj: (self iframeMethod: theFP)). - theIPPtr ~= 0 ifTrue: [ + theIPPtr ~= 0 ifTrue: [ stackPages unsignedLongAt: theIPPtr put: theIP + (self iframeMethod: theFP) ] ] ]. - (callerFP := self frameCallerFP: theFP) ~= 0 ] whileTrue: [ + (callerFP := self frameCallerFP: theFP) ~= 0 ] whileTrue: [ theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize. theFP := callerFP ]. theSP := theFP + FoxCallerSavedIP + objectMemory wordSize. - [ theSP <= thePage baseAddress ] whileTrue: [ + [ theSP <= thePage baseAddress ] whileTrue: [ oop := stackPages unsignedLongAt: theSP. - (objectMemory shouldRemapOop: oop) ifTrue: [ - stackPages unsignedLongAt: theSP put: (objectMemory remapObj: oop) ]. + (objectMemory shouldRemapOop: oop) ifTrue: [ + stackPages + unsignedLongAt: theSP + put: (objectMemory remapObj: oop) ]. theSP := theSP + objectMemory wordSize ] ] ]. stackPages recordLivePagesOnMapping: numLivePages ] @@ -4658,11 +3985,9 @@ CoInterpreter >> markActiveMethodsAndReferents [ { #category : #'gc -- mark and sweep' } CoInterpreter >> markAndTraceMachineCodeMethod: aCogMethod [ - - | homeMethod | - - homeMethod := self asCogHomeMethod: aCogMethod. - objectMemory markAndTrace: homeMethod methodObject + + + objectMemory markAndTrace: aCogMethod methodObject ] { #category : #'object memory support' } @@ -4785,116 +4110,6 @@ CoInterpreter >> markCogMethodsAndReferentsOnPage: thePage [ [theFP := callerFP] ] -{ #category : #'frame access' } -CoInterpreter >> marryFrame: theFP SP: theSP copyTemps: copyTemps [ - "Marry an unmarried frame. This means creating a spouse context - initialized with a subset of the frame's state that references the frame. - For the default closure implementation we do not need to copy temps. - Different closure implementations may require temps to be copied. - - This method is important enough for performance to be worth streamlining. - - Override to set the ``has context'' flag appropriately for both machine code and interpreter frames - and to streamline the machine code/interpreter differences.." - | theContext methodFieldOrObj closureOrNil rcvr numSlots numArgs numStack numTemps | - - - - - self assert: (self frameHasContext: theFP) not. - self assert: (self isBaseFrame: theFP) not. "base frames must aready be married for cannotReturn: processing" - - "The SP is expected to be pointing at the last oop on the stack, not at the pc" - self assert: (objectMemory addressCouldBeOop: (objectMemory longAt: theSP)). - - "Decide how much of the stack to preserve in widowed contexts. Preserving too much - state will potentially hold onto garbage. Holding onto too little may mean that a dead - context isn't informative enough in a debugging situation. If copyTemps is false (as it - is in the default closure implementation) compromise, retaining only the arguments with - no temporaries. Note that we still set the stack pointer to its current value, but stack - contents other than the arguments are nil." - methodFieldOrObj := self frameMethodField: theFP. - methodFieldOrObj asUnsignedInteger < objectMemory getMemoryMap startOfObjectMemory "inline (self isMachineCodeFrame: theFP)" - ifTrue: - [| cogMethod | - stackPages - longAt: theFP + FoxMethod - put: methodFieldOrObj + MFMethodFlagHasContextFlag. - cogMethod := self cCoerceSimple: (methodFieldOrObj bitAnd: MFMethodMask) to: #'CogMethod *'. - numArgs := cogMethod cmNumArgs. - cogMethod cmType = CMMethod - ifTrue: - [closureOrNil := cogMethod cmIsFullBlock - ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs] - ifFalse: [objectMemory nilObject]] - ifFalse: - [cogMethod := (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod. - closureOrNil := self frameStackedReceiver: theFP numArgs: numArgs]. - numSlots := (self methodHeaderIndicatesLargeFrame: cogMethod methodHeader) - ifTrue: [LargeContextSlots] - ifFalse: [SmallContextSlots]. - methodFieldOrObj := cogMethod methodObject. - rcvr := self mframeReceiver: theFP. - numStack := self stackPointerIndexForMFrame: theFP WithSP: theSP numArgs: numArgs] - ifFalse: - [self setIFrameHasContext: theFP. - numArgs := self iframeNumArgs: theFP. - numSlots := (self methodHeaderIndicatesLargeFrame: (objectMemory methodHeaderOf: methodFieldOrObj)) - ifTrue: [LargeContextSlots] - ifFalse: [SmallContextSlots]. - closureOrNil := (self iframeIsBlockActivation: theFP) - ifTrue: [self frameStackedReceiver: theFP numArgs: numArgs] - ifFalse: [objectMemory nilObject]. - rcvr := self iframeReceiver: theFP. - numStack := self stackPointerIndexForIFrame: theFP WithSP: theSP numArgs: numArgs]. - theContext := objectMemory eeInstantiateMethodContextSlots: numSlots. - self setFrameContext: theFP to: theContext. - "Mark context as married by setting its sender to the frame pointer plus SmallInteger - tags and the InstructionPointer to the saved fp (which ensures correct alignment - w.r.t. the frame when we check for validity)" - objectMemory storePointerUnchecked: SenderIndex - ofObject: theContext - withValue: (self withSmallIntegerTags: theFP). - objectMemory storePointerUnchecked: InstructionPointerIndex - ofObject: theContext - withValue: (self withSmallIntegerTags: (self frameCallerFP: theFP)). - objectMemory storePointerUnchecked: StackPointerIndex - ofObject: theContext - withValue: (objectMemory integerObjectOf: numStack). - objectMemory storePointerUnchecked: MethodIndex - ofObject: theContext - withValue: methodFieldOrObj. - objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil. - objectMemory storePointerUnchecked: ReceiverIndex - ofObject: theContext - withValue: rcvr. - 1 to: numArgs do: - [:i| - objectMemory storePointerUnchecked: ReceiverIndex + i - ofObject: theContext - withValue: (self temporary: i - 1 in: theFP)]. - copyTemps ifTrue: - [numTemps := self frameNumTemps: theFP. - 1 to: numTemps do: - [:i| - objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs - ofObject: theContext - withValue: (self temporary: i - 1 in: theFP)]. - numArgs := numArgs + numTemps]. - - numArgs + 1 to: numStack do: - [:i| - objectMemory storePointerUnchecked: ReceiverIndex + i - ofObject: theContext - withValue: objectMemory nilObject]. - - self assert: (self frameHasContext: theFP). - self assert: (self frameOfMarriedContext: theContext) = theFP. - self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext). - - ^theContext -] - { #category : #'frame access' } CoInterpreter >> marryFrameCopiesTemps [ "Answer whether marryFrame:SP: copies non-argument temporaries." @@ -4948,11 +4163,21 @@ CoInterpreter >> maybeReturnToMachineCodeFrame [ "If the frame we're returning to is a machine code one, then return to it. Otherwise, if it's an interpreter frame, load the saved ip." - instructionPointer asUnsignedInteger < objectMemory getMemoryMap startOfObjectMemory ifTrue: - [instructionPointer asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue: - ["localIP in the cog method zone indicates a return to machine code." - ^self returnToMachineCodeFrame]. - instructionPointer := self pointerForOop: (self iframeSavedIP: framePointer)] + (self isInstructionPointerInInterpreter: instructionPointer) ifFalse: [ + instructionPointer asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue: [ + "localIP in the cog method zone indicates a return to machine code." + ^self returnToMachineCodeFrame]. + instructionPointer := self pointerForOop: (self iframeSavedIP: framePointer) ] +] + +{ #category : #'stack bytecodes' } +CoInterpreter >> maybeTraceBlockCreation: newClosure [ + + cogit recordSendTrace ifTrue: [ + self + recordTrace: TraceBlockCreation + thing: newClosure + source: TraceIsFromInterpreter ] ] { #category : #'debug support' } @@ -5032,10 +4257,9 @@ CoInterpreter >> methodWithHeaderShouldBeCogged: methodHeader [ { #category : #'frame access' } CoInterpreter >> mframeCogMethod: theFP [ - "Answer the Cog method for a machine code frame. This may be - either a full CogMethod or merely a CogBlockMethod rump header." + "Answer the Cog method for a machine code frame" - ^self cCoerceSimple: (self mframeMethod: theFP) to: #'CogBlockMethod *' + ^self cCoerceSimple: (self mframeMethod: theFP) to: #'CogMethod *' ] { #category : #'frame access' } @@ -5055,8 +4279,6 @@ CoInterpreter >> mframeHomeMethod: theFP [ | methodField | methodField := self frameMethodField: theFP. - (methodField bitAnd: MFMethodFlagIsBlockFlag) ~= 0 ifTrue: - [^(self cCoerceSimple: (methodField bitAnd: MFMethodMask) to: #'CogBlockMethod *') cmHomeMethod]. ^self cCoerceSimple: (methodField bitAnd: MFMethodMask) to: #'CogMethod *' ] @@ -5191,8 +4413,7 @@ CoInterpreter >> moveFramesIn: oldPage through: theFP toPage: newPage [ callerFP := self frameCallerFP: theFP. self assert: (self frameHasContext: callerFP). self assert: (objectMemory isContext: (self frameContext: callerFP)). - theContext := self ensureFrameIsMarried: theFP - SP: theFP + ((self isMachineCodeFrame: theFP) ifTrue: [FoxMFReceiver] ifFalse: [FoxIFReceiver]). + theContext := self ensureFrameIsMarried: theFP SP: (self frameReceiverLocation: theFP). stackPages unsignedLongAt: (newSP := newPage baseAddress) put: (self frameContext: callerFP); unsignedLongAt: (newSP := newSP - objectMemory wordSize) put: theContext. @@ -5243,6 +4464,22 @@ CoInterpreter >> moveFramesIn: oldPage through: theFP toPage: newPage [ ^newFP ] +{ #category : #'internal interpreter access' } +CoInterpreter >> mtemporary: offset in: theFP [ + + + + | frameNumArgs | + ^ offset < (frameNumArgs := self mframeNumArgs: theFP) + ifTrue: [ + stackPages unsignedLongAt: theFP + FoxCallerSavedIP + + (frameNumArgs - offset * objectMemory wordSize) ] + ifFalse: [ + stackPages unsignedLongAt: + (self frameReceiverLocation: theFP) - objectMemory wordSize + + (frameNumArgs - offset * objectMemory wordSize) ] +] + { #category : #'internal interpreter access' } CoInterpreter >> mtemporary: offset in: theFP put: valueOop [ "Temporary access for a machine code frame only." @@ -5285,12 +4522,6 @@ CoInterpreter >> mustMapMachineCodePC: theIP context: aOnceMarriedContext [ ^objectMemory integerObjectOf: bcpc + 1 ] -{ #category : #'cog jit support' } -CoInterpreter >> newMethod [ - - ^newMethod -] - { #category : #'trampoline support' } CoInterpreter >> newMethodAddress [ @@ -5368,30 +4599,6 @@ CoInterpreter >> noAssertHeaderOf: methodPointer [ ifFalse: [methodHeader] ] -{ #category : #trampolines } -CoInterpreter >> positive32BitIntegerFor: integerValue [ - - ^super positive32BitIntegerFor: integerValue -] - -{ #category : #trampolines } -CoInterpreter >> positive32BitValueOf: oop [ - - ^super positive32BitValueOf: oop -] - -{ #category : #trampolines } -CoInterpreter >> positive64BitIntegerFor: integerValue [ - - ^super positive64BitIntegerFor: integerValue -] - -{ #category : #trampolines } -CoInterpreter >> positive64BitValueOf: oop [ - - ^super positive64BitValueOf: oop -] - { #category : #'object memory support' } CoInterpreter >> postBecomeAction: theBecomeEffectsFlags [ @@ -5564,9 +4771,6 @@ CoInterpreter >> printCogMethod: cogMethod [ header: cogMethod methodHeader. primitive ~= 0 ifTrue: [self print: ' prim '; printNum: primitive]]. - cogMethod cmType = CMBlock ifTrue: - [self print: ': block home: '; - printHex: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod asUnsignedInteger]. cogMethod cmType = CMPolymorphicIC ifTrue: [self print: ': Closed PIC N: '; printHex: cogMethod cPICNumCases]. @@ -5592,7 +4796,7 @@ CoInterpreter >> printFrame: theFP WithSP: theSP [ - + self cCode: '' inSmalltalk: [self transcript newLine]. (stackPages couldBeFramePointer: theFP) ifNil: @@ -5876,13 +5080,17 @@ CoInterpreter >> printMethodFieldForPrintContext: aContext [ { #category : #'debug printing' } CoInterpreter >> printMethodHeaderOop: anOop [ "Print the CogMethod and its header if this is a CogMethod reference." - | cogMethod | + - (self isCogMethodReference: anOop) ifTrue: - [cogMethod := cogMethodZone methodFor: (self pointerForOop: anOop). - cogMethod ~= 0 ifTrue: - [^self printHex: anOop; space; printDecodeMethodHeaderOop: cogMethod methodHeader]]. - ^self printDecodeMethodHeaderOop: anOop + | cogMethod | + (self isCogMethodReference: anOop) ifTrue: [ + cogMethod := cogMethodZone methodFor: (self pointerForOop: anOop). + cogMethod ~= 0 ifTrue: [ + ^ self + printHex: anOop; + space; + printDecodeMethodHeaderOop: cogMethod methodHeader ] ]. + ^ super printMethodHeaderOop: anOop ] { #category : #'debug support' } @@ -5917,75 +5125,6 @@ CoInterpreter >> printSends [ ^cogit printOnTrace ] -{ #category : #'stack bytecodes' } -CoInterpreter >> pushFullClosureNumArgs: numArgs copiedValues: numCopiedArg compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack ignoreContext: ignoreContext [ - - "The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. - Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. - Sets outerContext, compiledBlock, numArgs and receiver as specified.." - - - | numCopied newClosure context startIndex | - "No need to record the pushed copied values in the outerContext." - context := ignoreContext - ifTrue: [ objectMemory nilObject ] - ifFalse: [ - self - ensureFrameIsMarried: framePointer - SP: - stackPointer - + (numCopiedArg * objectMemory bytesPerOop) ]. - newClosure := self - fullClosureIn: context - numArgs: numArgs - numCopiedValues: numCopiedArg - compiledBlock: compiledBlock. - cogit recordSendTrace ifTrue: [ - self - recordTrace: TraceBlockCreation - thing: newClosure - source: TraceIsFromInterpreter ]. - receiverIsOnStack - ifFalse: [ - startIndex := FullClosureFirstCopiedValueIndex. - objectMemory - storePointerUnchecked: FullClosureReceiverIndex - ofObject: newClosure - withValue: self receiver. - numCopied := numCopiedArg ] - ifTrue: [ - startIndex := FullClosureReceiverIndex. - numCopied := numCopiedArg + 1 ]. - numCopied > 0 ifTrue: [ - 0 to: numCopied - 1 do: [ :i | "Assume: have just allocated a new BlockClosure; it must be young. - Thus, can use unchecked stores." - objectMemory - storePointerUnchecked: i + startIndex - ofObject: newClosure - withValue: (self stackValue: numCopied - i - 1) ]. - self pop: numCopied ]. - self fetchNextBytecode. - self push: newClosure -] - -{ #category : #'stack bytecodes' } -CoInterpreter >> pushRemoteTemp: index inVectorAt: tempVectorIndex [ - "Override to use itemporary:in:put:" - | tempVector | - tempVector := self itemporary: tempVectorIndex in: framePointer. - TempVectReadBarrier - ifTrue: - [(objectMemory isForwarded: tempVector) ifTrue: - [tempVector := self unfollowTempVector: tempVector atIndex: tempVectorIndex in: framePointer]]. - self push: (objectMemory fetchPointer: index ofObject: tempVector) -] - -{ #category : #'stack bytecodes' } -CoInterpreter >> pushTemporaryVariable: temporaryIndex [ - "Override to use itemporary:in:put:" - self push: (self itemporary: temporaryIndex in: framePointer) -] - { #category : #'cog jit support' } CoInterpreter >> quickPrimitiveConstantFor: aQuickPrimitiveIndex [ @@ -6086,54 +5225,6 @@ CoInterpreter >> restoreCStackStateForCallbackContext: vmCallbackContext [ super restoreCStackStateForCallbackContext: vmCallbackContext ] -{ #category : #'process primitive support' } -CoInterpreter >> resume: aProcess [ - "Replaced by resume:preemptedYieldingIf:from:" - "Make aProcess runnable and if its priority is higher than - that of the current process, preempt the current process. - Answer if the current process was preempted. Override - to add tracing info (see resume:from:)." - - self shouldNotImplement -] - -{ #category : #'process primitive support' } -CoInterpreter >> resume: aProcess preemptedYieldingIf: yieldImplicitly [ - "Replaced by resume:preemptedYieldingIf:from:" - "Make aProcess runnable and if its priority is higher than that of the - current process, preempt the current process. Answer if the current - process was preempted. If the current process was preempted then if - yieldImplicitly add the current process to the back of its run queue, - causing an implicit yiled to other processes on the run queue, otherwise - add the current process to the front of its run queue, hence not yielding. - Blue book behaviour is to yield implicitly but is arguably incorrect." - - self shouldNotImplement -] - -{ #category : #'process primitive support' } -CoInterpreter >> resume: aProcess preemptedYieldingIf: yieldImplicitly from: sourceCode [ - "Make aProcess runnable and if its priority is higher than that of the - current process, preempt the current process. Answer if the current - process was preempted. If the current process was preempted then if - yieldImplicitly add the current process to the back of its run queue, - causing an implicit yeild to other processes on the run queue, otherwise - add the current process to the front of its run queue, hence not yielding. - Blue book behaviour is to yield implicitly but is arguably incorrect. - Override to add tracing info." - | activeProc activePriority newPriority | - - activeProc := self activeProcess. - activePriority := self quickFetchInteger: PriorityIndex ofObject: activeProc. - newPriority := self quickFetchInteger: PriorityIndex ofObject: aProcess. - newPriority <= activePriority ifTrue: - [self putToSleep: aProcess yieldingIf: true. - ^false]. - self putToSleep: activeProc yieldingIf: yieldImplicitly. - self transferTo: aProcess from: sourceCode. - ^true -] - { #category : #enilopmarts } CoInterpreter >> return: returnValue toExecutive: inInterpreter [ "We have made a context switch, either when interpreting or from machine code. @@ -6159,6 +5250,12 @@ CoInterpreter >> return: returnValue toExecutive: inInterpreter [ ^nil ] +{ #category : #trampolines } +CoInterpreter >> returnToExecutive: inInterpreter [ + + self return: self popStack toExecutive: inInterpreter +] + { #category : #enilopmarts } CoInterpreter >> returnToExecutive: inInterpreter postContextSwitch: switchedContext [ "Return to the current frame, either by entering machine code, or longjmp-ing back to the @@ -6170,7 +5267,7 @@ CoInterpreter >> returnToExecutive: inInterpreter postContextSwitch: switchedCon in which case we're in a machine-code primitive called from the interpreter." | cogMethod retValue fullyInInterpreter | - + cogit assertCStackWellAligned. (self isMachineCodeFrame: framePointer) ifTrue: @@ -6225,7 +5322,6 @@ CoInterpreter >> returnToMachineCodeFrame [ line: #__LINE__. self stackTopPut: instructionPointer. self push: localReturnValue. - self externalizeFPandSP. self cCode: '' inSmalltalk: [ self maybeCheckStackDepth: 1 sp: stackPointer pc: instructionPointer ]. self callEnilopmart: #ceEnterCogCodePopReceiverReg @@ -6241,39 +5337,19 @@ CoInterpreter >> rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPri rewrite the primitive call in it to call localPrimAddress. Used to update calls through primitiveExternalCall to directly call the target function or to revert to calling primitiveExternalCall after a flush." + - (self methodHasCogMethod: newMethod) ifTrue: - [cogit + (self methodHasCogMethod: newMethod) ifTrue: [ + cogit rewritePrimInvocationIn: (self cogMethodOf: newMethod) to: (localPrimAddress = 0 - ifTrue: [self cCoerceSimple: #primitiveFail to: #'void (*)(void)'] - ifFalse: [localPrimAddress])]. - (methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue: - [methodCache - at: lastMethodCacheProbeWrite + MethodCachePrimFunction - put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')] -] + ifTrue: [ + self cCoerceSimple: #primitiveFail to: #'void (*)(void)' ] + ifFalse: [ localPrimAddress ]) ]. -{ #category : #'primitive support' } -CoInterpreter >> roomToPushNArgs: n [ - "Answer if there is room to push n arguments onto the current stack. We assume - this is called by primitives that check there is enough room in any new context, and - won't actually push the arguments in the current context if the primitive fails. With - this assumption it is safe to answer based on the maximum argument count, /not/ - the ammount of space in the current frame were it converted to a context.." - false - ifTrue: "old code that checked size of context..." - [| methodHeader cntxSize | - (self isMachineCodeFrame: framePointer) - ifTrue: [methodHeader := (self mframeHomeMethod: framePointer) methodHeader] - ifFalse: [methodHeader := objectMemory methodHeaderOf: (self iframeMethod: framePointer)]. - cntxSize := (self methodHeaderIndicatesLargeFrame: methodHeader) - ifTrue: [LargeContextSlots - CtxtTempFrameStart] - ifFalse: [SmallContextSlots - CtxtTempFrameStart]. - ^self stackPointerIndex + n <= cntxSize] - ifFalse: "simpler code that simply insists args are <= max arg count" - [^n <= (LargeContextSlots - CtxtTempFrameStart)] + super rewriteMethodCacheEntryForExternalPrimitiveToFunction: + localPrimAddress ] { #category : #'callback support' } @@ -6403,30 +5479,6 @@ CoInterpreter >> siglong: aJumpBuf jmp: returnValue [ ] -{ #category : #trampolines } -CoInterpreter >> signed32BitIntegerFor: integerValue [ - - ^super signed32BitIntegerFor: integerValue -] - -{ #category : #trampolines } -CoInterpreter >> signed32BitValueOf: oop [ - - ^super signed32BitValueOf: oop -] - -{ #category : #trampolines } -CoInterpreter >> signed64BitIntegerFor: integerValue [ - - ^super signed64BitIntegerFor: integerValue -] - -{ #category : #trampolines } -CoInterpreter >> signed64BitValueOf: oop [ - - ^super signed64BitValueOf: oop -] - { #category : #'runtime support' } CoInterpreter >> sigset: aJumpBuf jmp: sigSaveMask [ "Hack simulation of sigsetjmp/siglongjmp. @@ -6449,13 +5501,6 @@ CoInterpreter >> slowPrimitiveResponse [ ^super slowPrimitiveResponse ] -{ #category : #'cog jit support' } -CoInterpreter >> specialSelectorNumArgs: index [ "" - - ^objectMemory integerValueOf: (objectMemory fetchPointer: (index * 2) + 1 - ofObject: (objectMemory splObj: SpecialSelectors)) -] - { #category : #'trampoline support' } CoInterpreter >> stackLimitAddress [ @@ -6500,14 +5545,6 @@ CoInterpreter >> stackPageHeadroom [ ^self osCogStackPageHeadroom ] -{ #category : #initialization } -CoInterpreter >> stackPagesClass [ - - ^VMBIGENDIAN - ifTrue: [VMStackPagesMSB] - ifFalse: [VMStackPagesLSB] -] - { #category : #initialization } CoInterpreter >> stackPagesInitializedAt: theStackMemory totalSize: stackPagesBytes pageSize: stackPageBytes [ @@ -6519,13 +5556,6 @@ CoInterpreter >> stackPagesInitializedAt: theStackMemory totalSize: stackPagesBy self assert: self minimumUnusedHeadroom = stackPageBytes. ] -{ #category : #'cog jit support' } -CoInterpreter >> stackPointer: theSP [ - "Simulation only" - - stackPointer := theSP -] - { #category : #'trampoline support' } CoInterpreter >> stackPointerAddress [ @@ -6535,105 +5565,10 @@ CoInterpreter >> stackPointerAddress [ ] { #category : #'frame access' } -CoInterpreter >> stackPointerIndexForFrame: theFP WithSP: theSP [ - "Return the 1-based index rel to the given frame" - "In the StackInterpreter stacks grow down." - ^(self isMachineCodeFrame: theFP) - ifTrue: [(((theFP + FoxMFReceiver) - theSP) >> objectMemory shiftForWord) + (self mframeNumArgs: theFP)] - ifFalse: [(((theFP + FoxIFReceiver) - theSP) >> objectMemory shiftForWord) + (self iframeNumArgs: theFP)] -] - -{ #category : #'frame access' } -CoInterpreter >> stackPointerIndexForIFrame: theFP WithSP: theSP numArgs: numArgs [ - "Return the 1-based index rel to the given frame" - "In the StackInterpreter stacks grow down." - ^(((theFP + FoxIFReceiver) - theSP) >> objectMemory shiftForWord) + numArgs -] - -{ #category : #'frame access' } -CoInterpreter >> stackPointerIndexForMFrame: theFP WithSP: theSP numArgs: numArgs [ +CoInterpreter >> stackPointerIndexForFrame: theFP WithSP: theSP numArgs: numArgs [ "Return the 1-based index rel to the given machine code frame" "In the StackInterpreter stacks grow down." - ^(((theFP + FoxMFReceiver) - theSP) >> objectMemory shiftForWord) + numArgs -] - -{ #category : #'compiled methods' } -CoInterpreter >> startPCOfClosure: aBlockClosure [ - "Zero-relative version of BlockClosure>>startpc." - - "It should be implemented for FullBlockClosures... this implementation was for old BlockClosures" - "^(objectMemory integerValueOf: (objectMemory fetchPointer: ClosureStartPCIndex ofObject: aBlockClosure)) - 1" - 1halt. - -] - -{ #category : #'compiled methods' } -CoInterpreter >> startPCOfMethodHeader: aCompiledMethodHeader [ - - "Zero-relative version of CompiledMethod>>startpc." - ^(objectMemory literalCountOfMethodHeader: aCompiledMethodHeader) + LiteralStart * objectMemory bytesPerOop -] - -{ #category : #'stack bytecodes' } -CoInterpreter >> storeAndPopTemporaryVariableBytecode [ - - - self - cCode: [ "this bytecode will be expanded so that refs to currentBytecode below will be constant" - self fetchNextBytecode. - self - itemporary: (currentBytecode bitAnd: 7) - in: framePointer - put: self stackTop. - self pop: 1 ] - inSmalltalk: [ "Interpreter version has fetchNextBytecode out of order" - self - itemporary: (currentBytecode bitAnd: 7) - in: framePointer - put: self stackTop. - self fetchNextBytecode. - self pop: 1 ] -] - -{ #category : #'stack bytecodes' } -CoInterpreter >> storeRemoteTemp: index inVectorAt: tempVectorIndex [ - - "Override to use itemporary:in:put:" - - | tempVector | - tempVector := self itemporary: tempVectorIndex in: framePointer. - TempVectReadBarrier ifTrue: [ - (objectMemory isForwarded: tempVector) ifTrue: [ - tempVector := self - unfollowTempVector: tempVector - atIndex: tempVectorIndex - in: framePointer ] ]. - objectMemory - storePointer: index - ofObject: tempVector - withValue: self stackTop -] - -{ #category : #'process primitive support' } -CoInterpreter >> synchronousSignal: aSemaphore [ - "Signal the given semaphore from within the interpreter. - Answer if the current process was preempted. - Override to add tracing info." - | excessSignals | - - (self isEmptyList: aSemaphore) ifTrue: - ["no process is waiting on this semaphore" - excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphore. - self storeInteger: ExcessSignalsIndex - ofObject: aSemaphore - withValue: excessSignals + 1. - ^false]. - - objectMemory ensureSemaphoreUnforwardedThroughContext: aSemaphore. - - ^self resume: (self removeFirstLinkOfList: aSemaphore) - preemptedYieldingIf: preemptionYields - from: CSSignal + ^(((self frameReceiverLocation: theFP) - theSP) >> objectMemory shiftForWord) + numArgs ] { #category : #'return bytecodes' } @@ -6673,17 +5608,11 @@ CoInterpreter >> tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: cont { #category : #'internal interpreter access' } CoInterpreter >> temporary: offset in: theFP [ - "See StackInterpreter class>>initializeFrameIndices" - | frameNumArgs | + - - ^(self isMachineCodeFrame: theFP) - ifTrue: - [offset < (frameNumArgs := self mframeNumArgs: theFP) - ifTrue: [stackPages unsignedLongAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory wordSize)] - ifFalse: [stackPages unsignedLongAt: theFP + FoxMFReceiver - objectMemory wordSize + ((frameNumArgs - offset) * objectMemory wordSize)]] - ifFalse: - [self itemporary: offset in: theFP] + ^ (self isMachineCodeFrame: theFP) + ifTrue: [ self mtemporary: offset in: theFP ] + ifFalse: [ self itemporary: offset in: theFP ] ] { #category : #'internal interpreter access' } @@ -6694,69 +5623,12 @@ CoInterpreter >> temporary: offset in: theFP put: valueOop [ ifFalse: [self itemporary: offset in: theFP put: valueOop] ] -{ #category : #'internal interpreter access' } -CoInterpreter >> temporaryLocation: offset in: theFP numArgs: numArgs [ - "Answer the pointer to a given temporary (for debug frame printing in odd circumstances)" - - - ^offset < numArgs - ifTrue: [theFP + FoxCallerSavedIP + ((numArgs - offset) * objectMemory wordSize)] - ifFalse: [theFP - + ((self isMachineCodeFrame: theFP) - ifTrue: [FoxMFReceiver - objectMemory wordSize] - ifFalse: [FoxIFReceiver - objectMemory wordSize]) - + ((numArgs - offset) * objectMemory wordSize)] -] - { #category : #simulation } CoInterpreter >> transcript [ ^Transcript ] -{ #category : #'process primitive support' } -CoInterpreter >> transferTo: newProc [ - "replaced by transferTo:from: for better tracing (for debugging)" - - ^ self transferTo: newProc from: 0 -] - -{ #category : #'process primitive support' } -CoInterpreter >> transferTo: newProc from: sourceCode [ - "Record a process to be awoken on the next interpreter cycle. - Reimplement to record the source of the switch for debugging, - and to cope with possible code compaction in makeBaseFrameFor:." - | activeContext sched oldProc | - - statProcessSwitch := statProcessSwitch + 1. - self push: instructionPointer. - self externalWriteBackHeadFramePointers. - self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer. - "ensureMethodIsCogged: in makeBaseFrameFor: in - externalSetStackPageAndPointersForSuspendedContextOfProcess: - below may do a code compaction. Nil instructionPointer to avoid it getting pushed twice." - instructionPointer := 0. - sched := self schedulerPointer. - oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched. - self recordContextSwitchFrom: oldProc in: sourceCode. - activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer + objectMemory wordSize. - objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext. - objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc. - objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject. - self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc -] - -{ #category : #'compiled methods' } -CoInterpreter >> unfollowTempVector: tempVector atIndex: tempVectorIndex in: theFP [ - "override for itemporary" - - "So rare it mustn't bulk up the common path" - | followed | - followed := objectMemory followForwarded: tempVector. - self itemporary: tempVectorIndex in: theFP put: followed. - ^followed -] - { #category : #'image save/restore' } CoInterpreter >> unknownShortOrCodeSizeInKs [ ^desiredCogCodeSize + 1023 // 1024 @@ -6781,8 +5653,6 @@ CoInterpreter >> updateStackZoneReferencesToCompiledCodePreCompaction [ [theMethodField := self frameMethodField: theFP. theFlags := theMethodField bitAnd: MFMethodFlagsMask. theMethod := self cCoerceSimple: theMethodField - theFlags to: #'CogMethod *'. - theMethod cmType = CMBlock ifTrue: - [theMethod := (self cCoerceSimple: theMethodField - theFlags to: #'CogBlockMethod *') cmHomeMethod]. theIP := (stackPages unsignedLongAt: theIPPtr) asUnsignedInteger. (theIP ~= cogit ceCannotResumePC and: [(theIP >= theMethod asUnsignedInteger @@ -6798,56 +5668,6 @@ CoInterpreter >> updateStackZoneReferencesToCompiledCodePreCompaction [ theFP := callerFP]]] ] -{ #category : #'frame access' } -CoInterpreter >> updateStateOfSpouseContextForFrame: theFP WithSP: theSP [ - "Update the frame's spouse context with the frame's current state except for the - sender and instruction pointer, which are used to mark the context as married." - | theContext tempIndex pointer argsPointer | - - - - - - self assert: (self frameHasContext: theFP). - theContext := self frameContext: theFP. - self assert: (objectMemory isContext: theContext). - self assert: (self frameReceiver: theFP) - = (objectMemory noFixupFollowField: ReceiverIndex ofObject: theContext). - (self isMachineCodeFrame: theFP) - ifTrue: - [tempIndex := self mframeNumArgs: theFP. - pointer := theFP + FoxMFReceiver - objectMemory wordSize] - ifFalse: - [tempIndex := self iframeNumArgs: theFP. - pointer := theFP + FoxIFReceiver - objectMemory wordSize]. - "update the arguments. this would appear not to be strictly necessary, but is for two reasons. - First, the fact that arguments are read-only is only as convention in the Smalltalk compiler; - other languages may choose to modify arguments. - Second, the Squeak runUntilErrorOrReturnFrom: nightmare pops the stack top, which may, in - certain circumstances, be the last argument, and hence the last argument may not have been - stored into the context." - argsPointer := theFP + (self frameStackedReceiverOffsetNumArgs: tempIndex). - 1 to: tempIndex do: - [:i| - argsPointer := argsPointer - objectMemory wordSize. - self assert: (objectMemory addressCouldBeOop: (stackPages longAt: argsPointer)). - objectMemory storePointer: ReceiverIndex + i - ofObject: theContext - withValue: (stackPages longAt: argsPointer)]. - "now update the non-argument stack contents." - [pointer >= theSP] whileTrue: - [self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)). - tempIndex := tempIndex + 1. - objectMemory storePointer: ReceiverIndex + tempIndex - ofObject: theContext - withValue: (stackPages longAt: pointer). - pointer := pointer - objectMemory wordSize]. - self assert: ReceiverIndex + tempIndex < (objectMemory lengthOf: theContext). - objectMemory storePointerUnchecked: StackPointerIndex - ofObject: theContext - withValue: (objectMemory integerObjectOf: tempIndex) -] - { #category : #'debug support' } CoInterpreter >> validInstructionPointer: instrPointer inMethod: aMethod framePointer: fp [ @@ -6949,3 +5769,10 @@ CoInterpreter >> widowOrForceToBytecodePC: ctxt [ ifFalse: [self ensureContextHasBytecodePC: ctxt] ] + +{ #category : #'cog jit support' } +CoInterpreter >> writeBackHeadStackPointer [ + self assert: (stackPointer < stackPage baseAddress + and: [stackPointer > (stackPage realStackLimit - (LargeContextSlots * objectMemory bytesPerOop))]). + stackPage headSP: stackPointer +] diff --git a/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st index 8d3bbf57cb..2d2e7c01e4 100644 --- a/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/CoInterpreterPrimitives.class.st @@ -4,40 +4,6 @@ Class { #category : #'VMMaker-JIT' } -{ #category : #'process primitives' } -CoInterpreterPrimitives >> doWaitSemaphore: sema [ - - - - - self doWaitSemaphore: sema reEnterInterpreter: true -] - -{ #category : #'process primitives' } -CoInterpreterPrimitives >> doWaitSemaphore: sema reEnterInterpreter: hasToReenter [ - | excessSignals activeProc inInterpreter | - - - - excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: sema. - excessSignals > 0 - ifTrue: - [self storeInteger: ExcessSignalsIndex - ofObject: sema - withValue: excessSignals - 1] - ifFalse: - ["We're going to switch process, either to an interpreted frame or a machine - code frame. To know whether to return or enter machine code we have to - know from whence we came. We could have come from the interpreter, - either directly or via a machine code primitive. We could have come from - machine code. The instructionPointer tells us where from:" - inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. - activeProc := self activeProcess. - self addLastLink: activeProc toList: sema. - self transferTo: self wakeHighestPriority from: CSWait. - hasToReenter ifTrue: [self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]] -] - { #category : #'object access primitives' } CoInterpreterPrimitives >> frameIsMarked: theFPInt [ | methodField | @@ -256,75 +222,6 @@ CoInterpreterPrimitives >> primitiveContextXray [ self pop: 1 thenPush: (objectMemory integerObjectOf: flags) ] -{ #category : #'process primitives' } -CoInterpreterPrimitives >> 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." - | criticalSection owningProcessIndex owningProcess activeProc inInterpreter | - argumentCount > 0 - ifTrue: - [criticalSection := self stackValue: 1. "rcvr" - 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 pop: argumentCount + 1 thenPush: objectMemory falseObject]. - owningProcess = activeProc ifTrue: - [^self pop: argumentCount + 1 thenPush: objectMemory trueObject]. - "Arrange to answer false (unowned) when the process is resumed." - self pop: argumentCount + 1 thenPush: objectMemory falseObject. - "We're going to switch process, either to an interpreted frame or a machine - code frame. To know whether to return or enter machine code we have to - know from whence we came. We could have come from the interpreter, - either directly or via a machine code primitive. We could have come from - machine code. The instructionPointer tells us where from:" - inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. - self addLastLink: activeProc toList: criticalSection. - self transferTo: self wakeHighestPriority from: CSEnterCriticalSection. - self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter -] - -{ #category : #'process primitives' } -CoInterpreterPrimitives >> primitiveExitCriticalSection [ - "Exit the critical section. - This may change the active process as a result." - | criticalSection owningProcessIndex inInterpreter owningProcess | - criticalSection := self stackTop. "rcvr" - owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores" - (self isEmptyList: criticalSection) - ifTrue: - [objectMemory storePointerUnchecked: owningProcessIndex - ofObject: criticalSection - withValue: objectMemory nilObject] - ifFalse: - ["We're going to switch process, either to an interpreted frame or a machine - code frame. To know whether to return or enter machine code we have to - know from whence we came. We could have come from the interpreter, - either directly or via a machine code primitive. We could have come from - machine code. The instructionPointer tells us where from:" - inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. - owningProcess := self removeFirstLinkOfList: criticalSection. - "store check unnecessary because aSemaphore referred to owningProcess - via its FirstLinkIndex slot before owningProcess was removed." - objectMemory storePointerUnchecked: owningProcessIndex - ofObject: criticalSection - withValue: owningProcess. - "Note that resume: isn't fair; it won't suspend the active process. - For fairness we must do the equivalent of a primitiveYield, but that - may break old code, so we stick with unfair resume:." - (self resume: owningProcess - preemptedYieldingIf: preemptionYields - from: CSExitCriticalSection) ifTrue: - [self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]] -] - { #category : #'system control primitives' } CoInterpreterPrimitives >> primitiveFlushCacheByMethod [ "The receiver is a compiledMethod. Clear all entries in the method lookup cache that @@ -462,7 +359,7 @@ CoInterpreterPrimitives >> primitiveMethodXray [ selector: objectMemory nilObject. (cogMethod = nil and: [ cogCompiledCodeCompactionCalledFor ]) ifTrue: [ - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. self commenceCogCompiledCodeCompaction. cogMethod := cogit cog: self stackTop @@ -593,46 +490,6 @@ CoInterpreterPrimitives >> primitiveResetCountersInMethod [ [cogit resetCountersIn: (self cogMethodOf: methodReceiver)] ] -{ #category : #'process primitives' } -CoInterpreterPrimitives >> 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 inInterpreter | - proc := self stackTop. "rcvr" - (objectMemory isContext: (objectMemory followField: SuspendedContextIndex ofObject: proc)) ifFalse: - [^self primitiveFail]. - "We're about to switch process, either to an interpreted frame or a - machine code frame. To know whether to return or enter machine code - we have to know from whence we came. We could have come from the - interpreter, either directly or via a machine code primitive. We could have - come from machine code. The instructionPointer tells us where from:" - inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. - (self resume: proc preemptedYieldingIf: preemptionYields from: CSResume) ifTrue: - [self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter] - - "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. e.g. - - | proc myList classLinkedList | - proc := self stackTop. - myList := objectMemory fetchPointer: MyListIndex ofObject: proc. - classLinkedList := self superclassOf: (objectMemory splObj: ClassSemaphore). - ((self fetchClassOfNonInt: myList) ~= classLinkedList - and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)]) ifFalse: - [^self primitiveFail]. - ''We're about to switch process, either to an interpreted frame or a - machine code frame. To know whether to return or enter machine code - we have to know from whence we came. We could have come from the - interpreter, either directly or via a machine code primitive. We could have - come from machine code. The instructionPointer tells us where from:'' - inInterpreter := instructionPointer >= objectMemory startOfMemory. - (self resume: proc preemptedYieldingIf: preemptionYields from: CSResume) ifTrue: - [self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]" -] - { #category : #'process primitives' } CoInterpreterPrimitives >> primitiveSignal [ "Synchronously signal the semaphore. @@ -664,39 +521,6 @@ CoInterpreterPrimitives >> primitiveSnapshot [ "NOTREACHED" ] -{ #category : #'process primitives' } -CoInterpreterPrimitives >> 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: - [| inInterpreter | - "We're going to switch process, either to an interpreted frame or a machine - code frame. To know whether to return or enter machine code we have to - know from whence we came. We could have come from the interpreter, - either directly or via a machine code primitive. We could have come from - machine code. The instructionPointer tells us where from:" - self pop: 1 thenPush: objectMemory nilObject. - inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. - self transferTo: self wakeHighestPriority from: CSSuspend. - ^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]. - 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 storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject. - self pop: 1 thenPush: myList] -] - { #category : #'control primitives' } CoInterpreterPrimitives >> primitiveTerminateTo [ "Primitive. Terminate up the context stack from the receiver up to but not including @@ -726,7 +550,7 @@ CoInterpreterPrimitives >> primitiveTerminateTo [ [^self primitiveFail]. "All stackPages need to have current head pointers to avoid confusion." - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. "If we're searching for aContextOrNil it might be on a stack page. Helps to know if we can free a whole page or not, or if we can short-cut the termination." @@ -780,7 +604,7 @@ CoInterpreterPrimitives >> primitiveTerminateTo [ self assert: stackPage = stackPages mostRecentlyUsedPage. ^nil]. self assertValidStackedInstructionPointers: #'__LINE__'. - theFP := self externalEnsureIsBaseFrame: theFP. "May cause a GC!!" + theFP := self ensureIsBaseFrame: theFP. "May cause a GC!!" currentCtx := self frameCallerContext: theFP. "May also reclaim aContextOrNil's page, hence..." (aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil]) @@ -836,7 +660,7 @@ CoInterpreterPrimitives >> primitiveTerminateTo [ ifTrue: [frameAbove := self findFrameAbove: theFP inPage: thePage. self assert: frameAbove ~= 0. - frameAbove := self externalEnsureIsBaseFrame: frameAbove. "May cause a GC!! May also reclaim aContextOrNil's page, hence..." + frameAbove := self ensureIsBaseFrame: frameAbove. "May cause a GC!! May also reclaim aContextOrNil's page, hence..." (aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil]) ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil. pageToStopOn := stackPages stackPageFor: contextsFP] @@ -912,7 +736,7 @@ CoInterpreterPrimitives >> primitiveVoidVMStateForMethod [ self flushMethodCacheForMethod: methodObj. activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer. self ensurePushedInstructionPointer. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. (hasCogMethod := self methodHasCogMethod: methodObj) ifTrue: [self divorceMachineCodeFramesWithMethod: methodObj]. "One might think (as this author did) that the heap scan is unnecessary if the method does not @@ -946,29 +770,6 @@ CoInterpreterPrimitives >> primitiveVoidVMStateForMethod [ self pop: argumentCount ] -{ #category : #'process primitives' } -CoInterpreterPrimitives >> primitiveYield [ -"primitively do the equivalent of Process>yield" - | scheduler activeProc priority processLists processList inInterpreter | - scheduler := self schedulerPointer. - activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: scheduler. - priority := self quickFetchInteger: PriorityIndex ofObject: activeProc. - processLists := objectMemory fetchPointer: ProcessListsIndex ofObject: scheduler. - processList := objectMemory fetchPointer: priority - 1 ofObject: processLists. - - (self isEmptyList: processList) ifTrue: - [^nil]. - "We're going to switch process, either to an interpreted frame or a machine - code frame. To know whether to return or enter machine code we have to - know from whence we came. We could have come from the interpreter, - either directly or via a machine code primitive. We could have come from - machine code. The instructionPointer tells us where from:" - inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. - self addLastLink: activeProc toList: processList. - self transferTo: self wakeHighestPriority from: CSYield. - self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter -] - { #category : #'method introspection support' } CoInterpreterPrimitives >> profilingDataFor: cogMethod [ diff --git a/smalltalksrc/VMMaker/CoInterpreterWithQueueFFI.class.st b/smalltalksrc/VMMaker/CoInterpreterWithQueueFFI.class.st deleted file mode 100644 index e61582cce0..0000000000 --- a/smalltalksrc/VMMaker/CoInterpreterWithQueueFFI.class.st +++ /dev/null @@ -1,8 +0,0 @@ -Class { - #name : #CoInterpreterWithQueueFFI, - #superclass : #CoInterpreterPrimitives, - #instVars : [ - 'disabledFFIFunction' - ], - #category : #'VMMaker-QueueFFI' -} diff --git a/smalltalksrc/VMMaker/CogARMCompiler.class.st b/smalltalksrc/VMMaker/CogARMCompiler.class.st index 04d4950c0d..4b62542f47 100644 --- a/smalltalksrc/VMMaker/CogARMCompiler.class.st +++ b/smalltalksrc/VMMaker/CogARMCompiler.class.st @@ -654,7 +654,7 @@ CogARMCompiler >> computeMaximumSize [ [MoveRMwr] -> [self is12BitValue: (operands at: 1) ifTrue: [:u :i| ^ 4] ifFalse: [^ self literalLoadInstructionBytes + 4]]. - [MoveRdM64r] -> [self literalLoadInstructionBytes + 4]. + [MoveRdM64r] -> [^ 4]. [MoveMbrR] -> [self is12BitValue: (operands at: 0) ifTrue: [:u :i| ^ 4] ifFalse: [^ self literalLoadInstructionBytes + 4]]. diff --git a/smalltalksrc/VMMaker/CogBlockMethod.class.st b/smalltalksrc/VMMaker/CogBlockMethod.class.st deleted file mode 100644 index ba3d02560c..0000000000 --- a/smalltalksrc/VMMaker/CogBlockMethod.class.st +++ /dev/null @@ -1,364 +0,0 @@ -" -I am the rump method header for a block method embedded in a full CogMethod. I am the superclass of CogMethod, which is a Cog method header proper. Instances of both classes have the same second word. The homeOffset and startpc fields are overlaid on the objectHeader in a CogMethod. See Cogit class>>structureOfACogMethod for more information. In C I look like - - typedef struct { - union { - struct { - unsigned short homeOffset; - unsigned short startpc; - #if SpurVM - unsigned int padToWord; - #endif - }; - sqInt/sqLong objectHeader; - }; - unsigned cmNumArgs : 8; - unsigned cmType : 3; - unsigned cmRefersToYoung : 1; - unsigned cpicHasMNUCaseOrCMIsFullBlock : 1; - unsigned cmUsageCount : 3; - unsigned cmUsesPenultimateLit : 1; - unsigned cbUsesInstVars : 1; - unsigned cmUnusedFlags : 2; - unsigned stackCheckOffset : 12; - } CogBlockMethod; - -My instances are not actually used. The methods exist only as input to Slang. The simulator uses my surrogates (CogBlockMethodSurrogate32 and CogBlockMethodSurrogate64) to reference CogBlockMethod and CogMethod structures in the code zone. The start of the structure is 32-bits in the V3 memory manager and 64-bits in the Spour memory manager. In a CMMethod these bits are set to the object header of a marked bits objects, allowing code to masquerade as objects when referred to from the first field of a CompiledMethod. In a CMBlock, they hold the homeOffset and the startpc. - -cbUsesInstVars - - a flag set to true in blocks that refer to instance variables. - -cmNumArgs - - the byte containing the block or method arg count - -cmRefersToYoung - - a flag set to true in methods which contain a reference to an object in new space - -cmType - - one of CMFree, CMMethod, CMBlock, CMClosedPIC, CMOpenPIC - -cmUnusedFlags - - as yet unused bits - -cmUsageCount - - a count used to identify older methods in code compaction. The count decays over time, and compaction frees methods with lower usage counts - -cmUsesPenultimateLit - - a flag that states whether the penultimate literal in the corresponding bytecode method is used. This in turn is used to check that a become of a method does not alter its bytecode. - -cpicHasMNUCaseOrCMIsFullBlock - - a flag that states whether a CMClosedPIC contains one or more MNU cases which are PIC dispatches used to speed-up MNU processing, - or states whether a CMMethod is for a full block instead of for a compiled method. - -homeOffset - - the distance a CMBlock header is away from its enclosing CMMethod header - -objectHeader - - an object header used to fool the garbage collector into thinking that a CMMethod is a normal bits object, so that the first field (the header word) of a bytecoded method can refer directly to a CMMethod without special casing the garbage collector's method scanning code more than it already is. - -padToWord - - a pad that may be necessary to make the homeOffset, startpc, padToWord triple as large as a CMMethod's objectHeader field - -stackCheckOffset - - the distance from the header to the stack limit check in a frame building method or block, used to reenter execution in methods or blocks that have checked for events at what is effectively the first bytecode - -startpc - - the bytecode pc of the start of a CMBlock's bytecode in the bytecode method -" -Class { - #name : #CogBlockMethod, - #superclass : #VMStructType, - #instVars : [ - 'objectHeader', - 'homeOffset', - 'startpc', - 'padToWord', - 'cmNumArgs', - 'cmType', - 'cmRefersToYoung', - 'cpicHasMNUCaseOrCMIsFullBlock', - 'cmUsageCount', - 'cmUsesPenultimateLit', - 'cbUsesInstVars', - 'cmUnusedFlags', - 'stackCheckOffset' - ], - #pools : [ - 'CogMethodConstants', - 'VMBasicConstants', - 'VMBytecodeConstants' - ], - #category : #'VMMaker-JIT' -} - -{ #category : #accessing } -CogBlockMethod class >> alignedByteSize [ - self shouldNotImplement -] - -{ #category : #accessing } -CogBlockMethod class >> alignedByteSizeOf: anObject forClient: aVMClass [ - ^aVMClass cogit cogBlockMethodSurrogateClass alignedByteSize -] - -{ #category : #'class initialization' } -CogBlockMethod class >> initialize [ - "CogBlockMethod initialize" - "CogBlockMethod initialize. CogMethod initialize" - (Smalltalk classNamed: #CogBlockMethodSurrogate32) ifNotNil: - [:cbms32| - self checkGenerateSurrogate: cbms32 bytesPerWord: 4]. - (Smalltalk classNamed: #CogBlockMethodSurrogate64) ifNotNil: - [:cbms64| - self checkGenerateSurrogate: cbms64 bytesPerWord: 8]. - - "see instVarNamesAndTypesForTranslationDo:" - CMMaxUsageCount := (2 raisedTo: 3) - 1. - MaxStackCheckOffset := (2 raisedTo: 12) - 1. - MaxMethodSize := (2 raisedTo: 16) - 1 -] - -{ #category : #translation } -CogBlockMethod class >> instVarNamesAndTypesForTranslationDo: aBinaryBlock [ - "enumerate aBinaryBlock with the names and C type strings for the - inst vars to include in a CogMethod or CogBlockMethod struct." - - self allInstVarNames do: - [:ivn| - "Notionally objectHeader is in a union with homeOffset and startpc but - we don't have any convenient support for unions. So hack, hack, hack, hack." - ((self == CogBlockMethod - ifTrue: [#('objectHeader')] - ifFalse: [#('homeOffset' 'startpc' 'padToWord')]) includes: ivn) ifFalse: - [aBinaryBlock - value: ivn - value: (ivn caseOf: { - ['objectHeader'] -> [VMClass objectMemoryClass baseHeaderSize = 8 - ifTrue: [#sqLong] - ifFalse: [#sqInt]]. - ['cmNumArgs'] -> [#(unsigned ' : 8')]. "SqueakV3 needs only 5 bits" - ['cmType'] -> [#(unsigned ' : 3')]. - ['cmRefersToYoung'] -> [#(unsigned #Boolean ' : 1')]. - ['cpicHasMNUCaseOrCMIsFullBlock'] - -> [#(unsigned #Boolean ' : 1')]. - ['cmUsageCount'] -> [#(unsigned ' : 3')]. "See CMMaxUsageCount in initialize" - ['cmUsesPenultimateLit'] -> [#(unsigned #Boolean ' : 1')]. - ['cbUsesInstVars'] -> [#(unsigned #Boolean ' : 1')]. - ['cmUnusedFlags'] -> [#(unsigned ' : 2')]. - ['stackCheckOffset'] -> [#(unsigned ' : 12')]. "See MaxStackCheckOffset in initialize. a.k.a. cPICNumCases" - ['blockSize'] -> [#'unsigned short']. "See MaxMethodSize in initialize" - ['picUsage'] -> [#'unsigned short']. - ['homeOffset'] -> [#'unsigned short']. - ['startpc'] -> [#'unsigned short']. - ['padToWord'] -> [#(#BaseHeaderSize 8 'unsigned int')]. - ['counters'] -> [#usqInt]} "See SistaCogMethod" - otherwise: - [#sqInt])]] -] - -{ #category : #translation } -CogBlockMethod class >> isAccessor: aSelector [ - "Answer if aSelector is simply an accessor method for one of our fields." - ^(#(cPICNumCases cPICNumCases: nextOpenPIC nextOpenPIC:) includes: aSelector) - or: [super isAccessor: aSelector] -] - -{ #category : #'code generation' } -CogBlockMethod class >> offsetForInstVar: instVarName [ - "Hack to offset accesses to variables by certain values. The inst vars following - the objectHeader must be offset by the baseHeaderSize." - ^(#('objectHeader' 'homeOffset' 'startpc' 'padToWord') includes: instVarName) ifFalse: - ['baseHeaderSize'] -] - -{ #category : #accessing } -CogBlockMethod class >> surrogateClass [ - self shouldNotImplement -] - -{ #category : #accessing } -CogBlockMethod >> cPICNumCases [ - "Answer the value of cPICNumCases (a.k.a. stackCheckOffset)" - - ^stackCheckOffset -] - -{ #category : #accessing } -CogBlockMethod >> cPICNumCases: anObject [ - "Set the value of cPICNumCases (a.k.a. stackCheckOffset)" - - ^stackCheckOffset := anObject -] - -{ #category : #accessing } -CogBlockMethod >> cbUsesInstVars [ - - ^cbUsesInstVars -] - -{ #category : #accessing } -CogBlockMethod >> cbUsesInstVars: anObject [ - - ^cbUsesInstVars := anObject -] - -{ #category : #accessing } -CogBlockMethod >> cmHomeMethod [ - ^SistaV1BytecodeSet - ifTrue: [self cmIsFullBlock - ifTrue: [self cCoerceSimple: self to: #'CogMethod *'] - ifFalse: [self cCoerceSimple: self asUnsignedInteger - self homeOffset to: #'CogMethod *']] - ifFalse: [self cCoerceSimple: self asUnsignedInteger - self homeOffset to: #'CogMethod *'] -] - -{ #category : #accessing } -CogBlockMethod >> cmIsFullBlock [ - "Answer the value of cpicHasMNUCaseOrCMIsFullBlock" - - ^SistaV1BytecodeSet - ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock] - ifFalse: [false] -] - -{ #category : #accessing } -CogBlockMethod >> cmNumArgs [ - "Answer the value of cmNumArgs" - - ^cmNumArgs -] - -{ #category : #accessing } -CogBlockMethod >> cmNumArgs: anObject [ - "Set the value of cmNumArgs" - - ^cmNumArgs := anObject -] - -{ #category : #accessing } -CogBlockMethod >> cmRefersToYoung [ - "Answer the value of cmRefersToYoung" - - ^cmRefersToYoung -] - -{ #category : #accessing } -CogBlockMethod >> cmRefersToYoung: anObject [ - "Set the value of cmRefersToYoung" - - ^cmRefersToYoung := anObject -] - -{ #category : #accessing } -CogBlockMethod >> cmType [ - "Answer the value of cmType" - - ^cmType -] - -{ #category : #accessing } -CogBlockMethod >> cmType: anInteger [ - "Set the value of cmType" - - ^cmType := anInteger -] - -{ #category : #accessing } -CogBlockMethod >> cmUsageCount [ - "Answer the value of cmUsageCount" - - ^cmUsageCount -] - -{ #category : #accessing } -CogBlockMethod >> cmUsageCount: anInteger [ - "Set the value of cmUsageCount" - - ^cmUsageCount := anInteger -] - -{ #category : #accessing } -CogBlockMethod >> cmUsesPenultimateLit [ - "Answer the value of cmUsesPenultimateLit" - - ^cmUsesPenultimateLit -] - -{ #category : #accessing } -CogBlockMethod >> cmUsesPenultimateLit: anObject [ - "Set the value of cmUsesPenultimateLit" - - ^cmUsesPenultimateLit := anObject -] - -{ #category : #accessing } -CogBlockMethod >> cpicHasMNUCase [ - "Answer if the receiver has an MNU case." - - - ^SistaV1BytecodeSet - ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock and: [self cmType = CMPolymorphicIC]] - ifFalse: [cpicHasMNUCaseOrCMIsFullBlock] -] - -{ #category : #accessing } -CogBlockMethod >> cpicHasMNUCase: anObject [ - "Set if the receiver has an MNU case." - - ^cpicHasMNUCaseOrCMIsFullBlock := anObject -] - -{ #category : #accessing } -CogBlockMethod >> cpicHasMNUCaseOrCMIsFullBlock [ - "Answer the value of cpicHasMNUCaseOrCMIsFullBlock" - - ^cpicHasMNUCaseOrCMIsFullBlock -] - -{ #category : #accessing } -CogBlockMethod >> cpicHasMNUCaseOrCMIsFullBlock: anObject [ - "Set the value of cpicHasMNUCaseOrCMIsFullBlock" - - ^cpicHasMNUCaseOrCMIsFullBlock := anObject -] - -{ #category : #accessing } -CogBlockMethod >> homeOffset [ - "Answer the value of homeOffset" - - ^homeOffset -] - -{ #category : #accessing } -CogBlockMethod >> homeOffset: anObject [ - "Set the value of homeOffset" - - ^homeOffset := anObject -] - -{ #category : #accessing } -CogBlockMethod >> stackCheckOffset [ - "Answer the value of stackCheckOffset" - - ^stackCheckOffset -] - -{ #category : #accessing } -CogBlockMethod >> stackCheckOffset: anObject [ - "Set the value of stackCheckOffset" - - ^stackCheckOffset := anObject -] - -{ #category : #accessing } -CogBlockMethod >> startpc [ - "Answer the value of startpc" - - ^startpc -] - -{ #category : #accessing } -CogBlockMethod >> startpc: anObject [ - "Set the value of startpc" - - ^startpc := anObject -] diff --git a/smalltalksrc/VMMaker/CogBlockMethodSurrogate32.class.st b/smalltalksrc/VMMaker/CogBlockMethodSurrogate32.class.st deleted file mode 100644 index c6dd39dc57..0000000000 --- a/smalltalksrc/VMMaker/CogBlockMethodSurrogate32.class.st +++ /dev/null @@ -1,165 +0,0 @@ -Class { - #name : #CogBlockMethodSurrogate32, - #superclass : #CogMethodSurrogate, - #category : #'VMMaker-JITSimulation' -} - -{ #category : #accessing } -CogBlockMethodSurrogate32 class >> alignedByteSize [ - ^4 + self baseHeaderSize -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cbUsesInstVars [ - ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cbUsesInstVars: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 2 - put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmIsUnlinked [ - ^(((memory unsignedByteAt: address + 6) bitShift: -4) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmIsUnlinked: aValue [ - memory - unsignedByteAt: address + 6 - put: (((memory unsignedByteAt: address + 6) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmNumArgs [ - ^memory unsignedByteAt: address + 0 + baseHeaderSize -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmNumArgs: aValue [ - ^memory - unsignedByteAt: address + baseHeaderSize + 0 - put: aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmRefersToYoung [ - ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -3) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmRefersToYoung: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmType [ - ^(memory unsignedByteAt: address + 1 + baseHeaderSize) bitAnd: 16r7 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmType: aValue [ - self assert: (aValue between: 0 and: 16r7). - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF8) + aValue. - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmUsageCount [ - ^((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -5) bitAnd: 16r7 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmUsageCount: aValue [ - self assert: (aValue between: 0 and: 16r7). - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16r1F) + (aValue bitShift: 5). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmUsesPenultimateLit [ - ^((memory unsignedByteAt: address + 2 + baseHeaderSize) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cmUsesPenultimateLit: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 2 - put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cpicHasMNUCaseOrCMIsFullBlock [ - ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -4) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> cpicHasMNUCaseOrCMIsFullBlock: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> homeOffset [ - ^memory unsignedShortAt: address + 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> homeOffset: aValue [ - ^memory - unsignedShortAt: address + 0 - put: aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> padToWord [ - ^memory unsignedLong32At: address + 4 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> padToWord: aValue [ - ^memory - unsignedLong32At: address + 4 - put: aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> stackCheckOffset [ - ^((memory unsignedShortAt: address + 2 + baseHeaderSize) bitShift: -4) bitAnd: 16rFFF -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> stackCheckOffset: aValue [ - self assert: (aValue between: 0 and: 16rFFF). - memory - unsignedShortAt: address + baseHeaderSize + 2 - put: ((memory unsignedShortAt: address + baseHeaderSize + 2) bitAnd: 16rF) + (aValue bitShift: 4). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> startpc [ - ^memory unsignedShortAt: address + 2 -] - -{ #category : #accessing } -CogBlockMethodSurrogate32 >> startpc: aValue [ - ^memory - unsignedShortAt: address + 2 - put: aValue -] diff --git a/smalltalksrc/VMMaker/CogBlockMethodSurrogate64.class.st b/smalltalksrc/VMMaker/CogBlockMethodSurrogate64.class.st deleted file mode 100644 index 7fe45b3c8b..0000000000 --- a/smalltalksrc/VMMaker/CogBlockMethodSurrogate64.class.st +++ /dev/null @@ -1,165 +0,0 @@ -Class { - #name : #CogBlockMethodSurrogate64, - #superclass : #CogMethodSurrogate, - #category : #'VMMaker-JITSimulation' -} - -{ #category : #accessing } -CogBlockMethodSurrogate64 class >> alignedByteSize [ - ^8 + self baseHeaderSize -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cbUsesInstVars [ - ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cbUsesInstVars: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 2 - put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmIsUnlinked [ - ^(((memory unsignedByteAt: address + 10) bitShift: -4) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmIsUnlinked: aValue [ - memory - unsignedByteAt: address + 10 - put: (((memory unsignedByteAt: address + 10) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmNumArgs [ - ^memory unsignedByteAt: address + 0 + baseHeaderSize -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmNumArgs: aValue [ - ^memory - unsignedByteAt: address + baseHeaderSize + 0 - put: aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmRefersToYoung [ - ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -3) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmRefersToYoung: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmType [ - ^(memory unsignedByteAt: address + 1 + baseHeaderSize) bitAnd: 16r7 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmType: aValue [ - self assert: (aValue between: 0 and: 16r7). - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF8) + aValue. - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmUsageCount [ - ^((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -5) bitAnd: 16r7 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmUsageCount: aValue [ - self assert: (aValue between: 0 and: 16r7). - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16r1F) + (aValue bitShift: 5). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmUsesPenultimateLit [ - ^((memory unsignedByteAt: address + 2 + baseHeaderSize) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cmUsesPenultimateLit: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 2 - put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cpicHasMNUCaseOrCMIsFullBlock [ - ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -4) bitAnd: 16r1) ~= 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> cpicHasMNUCaseOrCMIsFullBlock: aValue [ - memory - unsignedByteAt: address + baseHeaderSize + 1 - put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> homeOffset [ - ^memory unsignedShortAt: address + 0 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> homeOffset: aValue [ - ^memory - unsignedShortAt: address + 0 - put: aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> padToWord [ - ^memory unsignedLong64At: address + 4 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> padToWord: aValue [ - ^memory - unsignedLong64At: address + 4 - put: aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> stackCheckOffset [ - ^((memory unsignedShortAt: address + 2 + baseHeaderSize) bitShift: -4) bitAnd: 16rFFF -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> stackCheckOffset: aValue [ - self assert: (aValue between: 0 and: 16rFFF). - memory - unsignedShortAt: address + baseHeaderSize + 2 - put: ((memory unsignedShortAt: address + baseHeaderSize + 2) bitAnd: 16rF) + (aValue bitShift: 4). - ^aValue -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> startpc [ - ^memory unsignedShortAt: address + 2 -] - -{ #category : #accessing } -CogBlockMethodSurrogate64 >> startpc: aValue [ - ^memory - unsignedShortAt: address + 2 - put: aValue -] diff --git a/smalltalksrc/VMMaker/CogMethod.class.st b/smalltalksrc/VMMaker/CogMethod.class.st index 6c34df0c11..af7a85ae94 100644 --- a/smalltalksrc/VMMaker/CogMethod.class.st +++ b/smalltalksrc/VMMaker/CogMethod.class.st @@ -27,17 +27,40 @@ My instances are not actually used. The methods exist only as input to Slang. " Class { #name : #CogMethod, - #superclass : #CogBlockMethod, + #superclass : #VMStructType, #instVars : [ + 'objectHeader', + 'homeOffset', + 'startpc', + 'padToWord', + 'cmNumArgs', + 'cmType', + 'cmRefersToYoung', + 'cpicHasMNUCaseOrCMIsFullBlock', + 'cmUsageCount', + 'cmUsesPenultimateLit', + 'cbUsesInstVars', + 'cmUnusedFlags', + 'stackCheckOffset', 'blockSize', 'picUsage', 'methodObject', 'methodHeader', 'selector' ], + #pools : [ + 'CogMethodConstants', + 'VMBasicConstants', + 'VMBytecodeConstants' + ], #category : #'VMMaker-JIT' } +{ #category : #accessing } +CogMethod class >> alignedByteSize [ + self shouldNotImplement +] + { #category : #accessing } CogMethod class >> alignedByteSizeOf: anObject forClient: aVMClass [ ^aVMClass cogit cogMethodSurrogateClass alignedByteSize @@ -45,22 +68,68 @@ CogMethod class >> alignedByteSizeOf: anObject forClient: aVMClass [ { #category : #translation } CogMethod class >> cogMethodHeader [ - ^String streamContents: - [:s| - CogBlockMethod printTypedefOn: s. - s newLine. - self printTypedefOn: s] + + ^ String streamContents: [ :s | self printTypedefOn: s ] ] { #category : #'class initialization' } CogMethod class >> initialize [ - "self initialize" - (Smalltalk classNamed: #CogMethodSurrogate32) ifNotNil: - [:cms32| - self checkGenerateSurrogate: cms32 bytesPerWord: 4]. - (Smalltalk classNamed: #CogMethodSurrogate64) ifNotNil: - [:cms64| - self checkGenerateSurrogate: cms64 bytesPerWord: 8] + "CogMethod initialize" + "see instVarNamesAndTypesForTranslationDo:" + CMMaxUsageCount := (2 raisedTo: 3) - 1. + MaxStackCheckOffset := (2 raisedTo: 12) - 1. + MaxMethodSize := (2 raisedTo: 16) - 1 +] + +{ #category : #translation } +CogMethod class >> instVarNamesAndTypesForTranslationDo: aBinaryBlock [ + "enumerate aBinaryBlock with the names and C type strings for the + inst vars to include in a CogMethod or CogBlockMethod struct." + + self allInstVarNames do: + [:ivn| + "Notionally objectHeader is in a union with homeOffset and startpc but + we don't have any convenient support for unions. So hack, hack, hack, hack." + (#('homeOffset' 'startpc' 'padToWord') includes: ivn) ifFalse: + [aBinaryBlock + value: ivn + value: (ivn caseOf: { + ['objectHeader'] -> [VMClass objectMemoryClass baseHeaderSize = 8 + ifTrue: [#sqLong] + ifFalse: [#sqInt]]. + ['cmNumArgs'] -> [#(unsigned ' : 8')]. "SqueakV3 needs only 5 bits" + ['cmType'] -> [#(unsigned ' : 3')]. + ['cmRefersToYoung'] -> [#(unsigned #Boolean ' : 1')]. + ['cpicHasMNUCaseOrCMIsFullBlock'] + -> [#(unsigned #Boolean ' : 1')]. + ['cmUsageCount'] -> [#(unsigned ' : 3')]. "See CMMaxUsageCount in initialize" + ['cmUsesPenultimateLit'] -> [#(unsigned #Boolean ' : 1')]. + ['cbUsesInstVars'] -> [#(unsigned #Boolean ' : 1')]. + ['cmUnusedFlags'] -> [#(unsigned ' : 2')]. + ['stackCheckOffset'] -> [#(unsigned ' : 12')]. "See MaxStackCheckOffset in initialize. a.k.a. cPICNumCases" + ['blockSize'] -> [#'unsigned short']. "See MaxMethodSize in initialize" + ['picUsage'] -> [#'unsigned short']. + ['homeOffset'] -> [#'unsigned short']. + ['startpc'] -> [#'unsigned short']. + ['padToWord'] -> [#(#BaseHeaderSize 8 'unsigned int')]. + ['counters'] -> [#usqInt]} "See SistaCogMethod" + otherwise: + [#sqInt])]] +] + +{ #category : #translation } +CogMethod class >> isAccessor: aSelector [ + "Answer if aSelector is simply an accessor method for one of our fields." + ^(#(cPICNumCases cPICNumCases: nextOpenPIC nextOpenPIC:) includes: aSelector) + or: [super isAccessor: aSelector] +] + +{ #category : #'code generation' } +CogMethod class >> offsetForInstVar: instVarName [ + "Hack to offset accesses to variables by certain values. The inst vars following + the objectHeader must be offset by the baseHeaderSize." + ^(#('objectHeader' 'homeOffset' 'startpc' 'padToWord') includes: instVarName) ifFalse: + ['baseHeaderSize'] ] { #category : #accessing } @@ -82,6 +151,111 @@ CogMethod >> blockSize: anObject [ ^blockSize := anObject ] +{ #category : #accessing } +CogMethod >> cPICNumCases [ + "Answer the value of cPICNumCases (a.k.a. stackCheckOffset)" + + ^stackCheckOffset +] + +{ #category : #accessing } +CogMethod >> cPICNumCases: anObject [ + "Set the value of cPICNumCases (a.k.a. stackCheckOffset)" + + ^stackCheckOffset := anObject +] + +{ #category : #accessing } +CogMethod >> cbUsesInstVars [ + + ^cbUsesInstVars +] + +{ #category : #accessing } +CogMethod >> cbUsesInstVars: anObject [ + + ^cbUsesInstVars := anObject +] + +{ #category : #accessing } +CogMethod >> cmIsFullBlock [ + "Answer the value of cpicHasMNUCaseOrCMIsFullBlock" + + ^SistaV1BytecodeSet + ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock] + ifFalse: [false] +] + +{ #category : #accessing } +CogMethod >> cmNumArgs [ + "Answer the value of cmNumArgs" + + ^cmNumArgs +] + +{ #category : #accessing } +CogMethod >> cmNumArgs: anObject [ + "Set the value of cmNumArgs" + + ^cmNumArgs := anObject +] + +{ #category : #accessing } +CogMethod >> cmRefersToYoung [ + "Answer the value of cmRefersToYoung" + + ^cmRefersToYoung +] + +{ #category : #accessing } +CogMethod >> cmRefersToYoung: anObject [ + "Set the value of cmRefersToYoung" + + ^cmRefersToYoung := anObject +] + +{ #category : #accessing } +CogMethod >> cmType [ + "Answer the value of cmType" + + ^cmType +] + +{ #category : #accessing } +CogMethod >> cmType: anInteger [ + "Set the value of cmType" + + ^cmType := anInteger +] + +{ #category : #accessing } +CogMethod >> cmUsageCount [ + "Answer the value of cmUsageCount" + + ^cmUsageCount +] + +{ #category : #accessing } +CogMethod >> cmUsageCount: anInteger [ + "Set the value of cmUsageCount" + + ^cmUsageCount := anInteger +] + +{ #category : #accessing } +CogMethod >> cmUsesPenultimateLit [ + "Answer the value of cmUsesPenultimateLit" + + ^cmUsesPenultimateLit +] + +{ #category : #accessing } +CogMethod >> cmUsesPenultimateLit: anObject [ + "Set the value of cmUsesPenultimateLit" + + ^cmUsesPenultimateLit := anObject +] + { #category : #testing } CogMethod >> containsAddress: anAddress [ "is anAddress within my bounds; not a test of addresses referred to within instructions in the method" @@ -95,6 +269,37 @@ CogMethod >> counters [ ^ 0 ] +{ #category : #accessing } +CogMethod >> cpicHasMNUCase [ + "Answer if the receiver has an MNU case." + + + ^SistaV1BytecodeSet + ifTrue: [self cpicHasMNUCaseOrCMIsFullBlock and: [self cmType = CMPolymorphicIC]] + ifFalse: [cpicHasMNUCaseOrCMIsFullBlock] +] + +{ #category : #accessing } +CogMethod >> cpicHasMNUCase: anObject [ + "Set if the receiver has an MNU case." + + ^cpicHasMNUCaseOrCMIsFullBlock := anObject +] + +{ #category : #accessing } +CogMethod >> cpicHasMNUCaseOrCMIsFullBlock [ + "Answer the value of cpicHasMNUCaseOrCMIsFullBlock" + + ^cpicHasMNUCaseOrCMIsFullBlock +] + +{ #category : #accessing } +CogMethod >> cpicHasMNUCaseOrCMIsFullBlock: anObject [ + "Set the value of cpicHasMNUCaseOrCMIsFullBlock" + + ^cpicHasMNUCaseOrCMIsFullBlock := anObject +] + { #category : #accessing } CogMethod >> methodHeader [ "Answer the value of methodHeader" @@ -178,3 +383,31 @@ CogMethod >> selector: anObject [ ^selector := anObject ] + +{ #category : #accessing } +CogMethod >> stackCheckOffset [ + "Answer the value of stackCheckOffset" + + ^stackCheckOffset +] + +{ #category : #accessing } +CogMethod >> stackCheckOffset: anObject [ + "Set the value of stackCheckOffset" + + ^stackCheckOffset := anObject +] + +{ #category : #accessing } +CogMethod >> startpc [ + "Answer the value of startpc" + + ^startpc +] + +{ #category : #accessing } +CogMethod >> startpc: anObject [ + "Set the value of startpc" + + ^startpc := anObject +] diff --git a/smalltalksrc/VMMaker/CogMethodSurrogate.class.st b/smalltalksrc/VMMaker/CogMethodSurrogate.class.st index 9760b970bc..8779eaa1a5 100644 --- a/smalltalksrc/VMMaker/CogMethodSurrogate.class.st +++ b/smalltalksrc/VMMaker/CogMethodSurrogate.class.st @@ -128,13 +128,6 @@ CogMethodSurrogate >> cPICNumCases: n [ ^self stackCheckOffset: n ] -{ #category : #accessing } -CogMethodSurrogate >> cmHomeMethod [ - ^cogit cogMethodSurrogateAt: ((SistaV1BytecodeSet and: [self cmIsFullBlock]) - ifTrue: [address] - ifFalse: [address - self homeOffset]) -] - { #category : #accessing } CogMethodSurrogate >> cmIsFullBlock [ "Answer the value of cpicHasMNUCaseOrCMIsFullBlock" diff --git a/smalltalksrc/VMMaker/CogMethodSurrogate32.class.st b/smalltalksrc/VMMaker/CogMethodSurrogate32.class.st index aea16be868..254117a505 100644 --- a/smalltalksrc/VMMaker/CogMethodSurrogate32.class.st +++ b/smalltalksrc/VMMaker/CogMethodSurrogate32.class.st @@ -23,7 +23,7 @@ Here's a doit to generate my code: " Class { #name : #CogMethodSurrogate32, - #superclass : #CogBlockMethodSurrogate32, + #superclass : #CogMethodSurrogate, #category : #'VMMaker-JITSimulation' } @@ -57,6 +57,123 @@ CogMethodSurrogate32 >> blockSize: aValue [ put: aValue ] +{ #category : #accessing } +CogMethodSurrogate32 >> cbUsesInstVars [ + ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cbUsesInstVars: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 2 + put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmIsUnlinked [ + ^(((memory unsignedByteAt: address + 6) bitShift: -4) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmIsUnlinked: aValue [ + memory + unsignedByteAt: address + 6 + put: (((memory unsignedByteAt: address + 6) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmNumArgs [ + ^memory unsignedByteAt: address + 0 + baseHeaderSize +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmNumArgs: aValue [ + ^memory + unsignedByteAt: address + baseHeaderSize + 0 + put: aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmRefersToYoung [ + ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -3) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmRefersToYoung: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmType [ + ^(memory unsignedByteAt: address + 1 + baseHeaderSize) bitAnd: 16r7 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmType: aValue [ + self assert: (aValue between: 0 and: 16r7). + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF8) + aValue. + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmUsageCount [ + ^((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -5) bitAnd: 16r7 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmUsageCount: aValue [ + self assert: (aValue between: 0 and: 16r7). + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16r1F) + (aValue bitShift: 5). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmUsesPenultimateLit [ + ^((memory unsignedByteAt: address + 2 + baseHeaderSize) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cmUsesPenultimateLit: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 2 + put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cpicHasMNUCaseOrCMIsFullBlock [ + ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -4) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> cpicHasMNUCaseOrCMIsFullBlock: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> homeOffset [ + ^memory unsignedShortAt: address + 0 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> homeOffset: aValue [ + ^memory + unsignedShortAt: address + 0 + put: aValue +] + { #category : #accessing } CogMethodSurrogate32 >> methodHeader [ ^memory unsignedLong32At: address + 12 + baseHeaderSize @@ -81,6 +198,18 @@ CogMethodSurrogate32 >> methodObject: aValue [ put: aValue ] +{ #category : #accessing } +CogMethodSurrogate32 >> padToWord [ + ^memory unsignedLong32At: address + 4 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> padToWord: aValue [ + ^memory + unsignedLong32At: address + 4 + put: aValue +] + { #category : #accessing } CogMethodSurrogate32 >> picUsage [ ^memory unsignedShortAt: address + 6 + baseHeaderSize @@ -104,3 +233,29 @@ CogMethodSurrogate32 >> selector: aValue [ unsignedLong32At: address + baseHeaderSize + 16 put: aValue ] + +{ #category : #accessing } +CogMethodSurrogate32 >> stackCheckOffset [ + ^((memory unsignedShortAt: address + 2 + baseHeaderSize) bitShift: -4) bitAnd: 16rFFF +] + +{ #category : #accessing } +CogMethodSurrogate32 >> stackCheckOffset: aValue [ + self assert: (aValue between: 0 and: 16rFFF). + memory + unsignedShortAt: address + baseHeaderSize + 2 + put: ((memory unsignedShortAt: address + baseHeaderSize + 2) bitAnd: 16rF) + (aValue bitShift: 4). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate32 >> startpc [ + ^memory unsignedShortAt: address + 2 +] + +{ #category : #accessing } +CogMethodSurrogate32 >> startpc: aValue [ + ^memory + unsignedShortAt: address + 2 + put: aValue +] diff --git a/smalltalksrc/VMMaker/CogMethodSurrogate64.class.st b/smalltalksrc/VMMaker/CogMethodSurrogate64.class.st index 4c21b5aa8c..eba1676e29 100644 --- a/smalltalksrc/VMMaker/CogMethodSurrogate64.class.st +++ b/smalltalksrc/VMMaker/CogMethodSurrogate64.class.st @@ -23,7 +23,7 @@ Here's a doit to generate my code: " Class { #name : #CogMethodSurrogate64, - #superclass : #CogBlockMethodSurrogate64, + #superclass : #CogMethodSurrogate, #category : #'VMMaker-JITSimulation' } @@ -57,6 +57,123 @@ CogMethodSurrogate64 >> blockSize: aValue [ put: aValue ] +{ #category : #accessing } +CogMethodSurrogate64 >> cbUsesInstVars [ + ^(((memory unsignedByteAt: address + 2 + baseHeaderSize) bitShift: -1) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cbUsesInstVars: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 2 + put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFD) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 1)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmIsUnlinked [ + ^(((memory unsignedByteAt: address + 10) bitShift: -4) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmIsUnlinked: aValue [ + memory + unsignedByteAt: address + 10 + put: (((memory unsignedByteAt: address + 10) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmNumArgs [ + ^memory unsignedByteAt: address + 0 + baseHeaderSize +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmNumArgs: aValue [ + ^memory + unsignedByteAt: address + baseHeaderSize + 0 + put: aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmRefersToYoung [ + ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -3) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmRefersToYoung: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF7) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 3)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmType [ + ^(memory unsignedByteAt: address + 1 + baseHeaderSize) bitAnd: 16r7 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmType: aValue [ + self assert: (aValue between: 0 and: 16r7). + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rF8) + aValue. + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmUsageCount [ + ^((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -5) bitAnd: 16r7 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmUsageCount: aValue [ + self assert: (aValue between: 0 and: 16r7). + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: ((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16r1F) + (aValue bitShift: 5). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmUsesPenultimateLit [ + ^((memory unsignedByteAt: address + 2 + baseHeaderSize) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cmUsesPenultimateLit: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 2 + put: (((memory unsignedByteAt: address + baseHeaderSize + 2) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cpicHasMNUCaseOrCMIsFullBlock [ + ^(((memory unsignedByteAt: address + 1 + baseHeaderSize) bitShift: -4) bitAnd: 16r1) ~= 0 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> cpicHasMNUCaseOrCMIsFullBlock: aValue [ + memory + unsignedByteAt: address + baseHeaderSize + 1 + put: (((memory unsignedByteAt: address + baseHeaderSize + 1) bitAnd: 16rEF) + ((aValue ifTrue: [1] ifFalse: [0]) bitShift: 4)). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> homeOffset [ + ^memory unsignedShortAt: address + 0 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> homeOffset: aValue [ + ^memory + unsignedShortAt: address + 0 + put: aValue +] + { #category : #accessing } CogMethodSurrogate64 >> methodHeader [ ^memory unsignedLong64At: address + 16 + baseHeaderSize @@ -81,6 +198,18 @@ CogMethodSurrogate64 >> methodObject: aValue [ put: aValue ] +{ #category : #accessing } +CogMethodSurrogate64 >> padToWord [ + ^memory unsignedLong64At: address + 4 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> padToWord: aValue [ + ^memory + unsignedLong64At: address + 4 + put: aValue +] + { #category : #accessing } CogMethodSurrogate64 >> picUsage [ ^memory unsignedShortAt: address + 6 + baseHeaderSize @@ -104,3 +233,29 @@ CogMethodSurrogate64 >> selector: aValue [ unsignedLong64At: address + baseHeaderSize + 24 put: aValue ] + +{ #category : #accessing } +CogMethodSurrogate64 >> stackCheckOffset [ + ^((memory unsignedShortAt: address + 2 + baseHeaderSize) bitShift: -4) bitAnd: 16rFFF +] + +{ #category : #accessing } +CogMethodSurrogate64 >> stackCheckOffset: aValue [ + self assert: (aValue between: 0 and: 16rFFF). + memory + unsignedShortAt: address + baseHeaderSize + 2 + put: ((memory unsignedShortAt: address + baseHeaderSize + 2) bitAnd: 16rF) + (aValue bitShift: 4). + ^aValue +] + +{ #category : #accessing } +CogMethodSurrogate64 >> startpc [ + ^memory unsignedShortAt: address + 2 +] + +{ #category : #accessing } +CogMethodSurrogate64 >> startpc: aValue [ + ^memory + unsignedShortAt: address + 2 + put: aValue +] diff --git a/smalltalksrc/VMMaker/CogObjectRepresentationFor64BitSpur.class.st b/smalltalksrc/VMMaker/CogObjectRepresentationFor64BitSpur.class.st index aae2db44f1..d4b8247ab6 100644 --- a/smalltalksrc/VMMaker/CogObjectRepresentationFor64BitSpur.class.st +++ b/smalltalksrc/VMMaker/CogObjectRepresentationFor64BitSpur.class.st @@ -68,14 +68,6 @@ CogObjectRepresentationFor64BitSpur >> bitAndByteOffsetOfIsFullBlockBitInto: aBl offset. The following assert tests whether the values are correct by creating a surrogate on an empty ByteArray, setting the bit, and checking that the expected values are set in the ByteArray." - self cCode: [] inSmalltalk: - [| m | - m := ByteArray new: 16. - CogBlockMethodSurrogate64 new - at: 0 memory: m headerSize: 8 cogit: nil; - cpicHasMNUCaseOrCMIsFullBlock: true. - self assert: m = #[0 0 0 0 0 0 0 0 16 0 0 0 0 0 0 0 ]. - self assert: (m at: objectMemory baseHeaderSize + 1) = 16]. aBlock value: 16 value: objectMemory baseHeaderSize + 1 "zero-relative" ] diff --git a/smalltalksrc/VMMaker/CogVMSimulator.class.st b/smalltalksrc/VMMaker/CogVMSimulator.class.st index c3d3af29e1..5ab1d97bff 100644 --- a/smalltalksrc/VMMaker/CogVMSimulator.class.st +++ b/smalltalksrc/VMMaker/CogVMSimulator.class.st @@ -188,21 +188,6 @@ CogVMSimulator >> atEachStepBlock: aBlock [ atEachStepBlock := aBlock ] -{ #category : #'jump bytecodes' } -CogVMSimulator >> attemptToSwitchToMachineCode: bcpc [ - "method = 16r96A294 ifTrue: [self halt]." - ^super attemptToSwitchToMachineCode: bcpc -] - -{ #category : #'return bytecodes' } -CogVMSimulator >> baseFrameReturn [ - "| contextToReturnTo | - contextToReturnTo := self frameCallerContext: localFP. - (self stringOf: (self penultimateLiteralOf: (self fetchPointer: MethodIndex ofObject: contextToReturnTo))) = #indexOf:startingAt:ifAbsent: ifTrue: - [self halt]." - ^super baseFrameReturn -] - { #category : #initialization } CogVMSimulator >> basicInitialize [ "Initialize the CogVMSimulator when running the interpreter inside Smalltalk. The @@ -325,11 +310,11 @@ CogVMSimulator >> byteCountText [ CogVMSimulator >> cCoerceSimple: value to: cTypeString [ "Type coercion for translation and simulation. For simulation answer a suitable surrogate for the struct types" - ^cTypeString - caseOf: - { [#'CogMethod *'] -> [cogit cogMethodSurrogateAt: value asUnsignedInteger]. - [#'CogBlockMethod *'] -> [cogit cogBlockMethodSurrogateAt: value asUnsignedInteger] } - otherwise: [value] + + ^ cTypeString + caseOf: { ([ #'CogMethod *' ] + -> [ cogit cogMethodSurrogateAt: value asUnsignedInteger ]) } + otherwise: [ value ] ] { #category : #'plugin support' } @@ -343,72 +328,6 @@ CogVMSimulator >> callExternalPrimitive: mapIndex [ ^ (entry at: 1) perform: (entry at: 2) ] -{ #category : #enilopmarts } -CogVMSimulator >> ceActivateFailingPrimitiveMethod: aPrimitiveMethod [ - "self halt." - ^super ceActivateFailingPrimitiveMethod: aPrimitiveMethod -] - -{ #category : #trampolines } -CogVMSimulator >> ceBaseFrameReturn: returnValue [ - "self printCallStackOf: (stackPages longAt: stackPage baseAddress) currentFP: stackPage baseFP. - Transcript print: byteCount; tab; print: thisContext; cr. - (self confirm: 'continue?') ifFalse: [self returnValue hex]." - "returnValue = 16r01934F78 ifTrue: [self halt]." - "| contextToReturnTo | - contextToReturnTo := stackPages longAt: stackPage baseAddress. - (self stringOf: (self penultimateLiteralOf: (self fetchPointer: MethodIndex ofObject: contextToReturnTo))) = #indexOf:startingAt:ifAbsent: ifTrue: - [self halt]." - ^super ceBaseFrameReturn: returnValue -] - -{ #category : #trampolines } -CogVMSimulator >> ceContext: aOnceMarriedContext instVar: slotIndex [ - cogit assertCStackWellAligned. - ^super ceContext: aOnceMarriedContext instVar: slotIndex -] - -{ #category : #trampolines } -CogVMSimulator >> ceContext: aOnceMarriedContext instVar: slotIndex value: anOop [ - "aOnceMarriedContext = 26431360 ifTrue: - [transcript cr; cr. - self printContext: aOnceMarriedContext. - transcript cr. - (self isContext: anOop) - ifTrue: [self printContext: anOop] - ifFalse: [self printOop: anOop]. - self halt]." - cogit assertCStackWellAligned. - ^super ceContext: aOnceMarriedContext instVar: slotIndex value: anOop -] - -{ #category : #'cog jit support' } -CogVMSimulator >> ceCounterTripped: condition [ - | counterTrippedSelector | - self transcript cr; nextPutAll: 'counter tripped in '. - self shortPrintFrame: framePointer. - counterTrippedSelector := objectMemory maybeSplObj: SelectorCounterTripped. - (counterTrippedSelector isNil - or: [counterTrippedSelector = objectMemory nilObject]) ifFalse: - [self halt: 'counter tripped']. - ^super ceCounterTripped: condition -] - -{ #category : #trampolines } -CogVMSimulator >> ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr [ - | cPIC | - cPIC := self cCoerceSimple: self stackTop - cogit mnuOffset to: #'CogMethod *'. - self assert: (cPIC cmType = CMPolymorphicIC or: [cPIC cmType = CMMegamorphicIC]). - self mnuBreakpoint: cPIC selector receiver: nil. - ^super ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr -] - -{ #category : #'debug support' } -CogVMSimulator >> ceNonLocalReturn: returnValue [ - "self halt." - ^super ceNonLocalReturn: returnValue -] - { #category : #trampolines } CogVMSimulator >> ceReapAndResetErrorCodeFor: cogMethod [ "Override to map the address into a CogMethodSurrogate" @@ -419,78 +338,6 @@ CogVMSimulator >> ceReapAndResetErrorCodeFor: cogMethod [ ^super ceReapAndResetErrorCodeFor: surrogate ] -{ #category : #trampolines } -CogVMSimulator >> ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs [ - "self stringOf: selector" - "self printOop: rcvr" - "(superNormalBar ~= 0 and: [(self stringOf: selector) = #bitShift:]) ifTrue: - [self halt]." - self logSend: selector. - cogit assertCStackWellAligned. - self maybeCheckStackDepth: numArgs + 1 sp: stackPointer pc: (stackPages longAt: stackPointer). - ^super ceSend: selector super: superNormalBar to: rcvr numArgs: numArgs -] - -{ #category : #trampolines } -CogVMSimulator >> ceSendAbort: selector to: rcvr numArgs: numArgs [ - "self stringOf: selector" - "self printOop: rcvr" - self logSend: selector. - cogit assertCStackWellAligned. - self maybeCheckStackDepth: numArgs + 1 - sp: stackPointer - pc: (stackPages longAt: stackPointer). - ^super ceSendAbort: selector to: rcvr numArgs: numArgs -] - -{ #category : #trampolines } -CogVMSimulator >> ceSendFromInLineCacheMiss: oPIC [ - "Override to map the address into a CogMethodSurrogate" - | surrogate | - surrogate := oPIC isInteger - ifTrue: [cogit cogMethodSurrogateAt: oPIC] - ifFalse: [oPIC]. - self logSend: surrogate selector. - (surrogate cmNumArgs = 0 - and: [(self stackValue: 1) = 16r8169D0 - and: [self stackTop = 16r53EA7]]) ifTrue: - [self halt]. - ^super ceSendFromInLineCacheMiss: surrogate -] - -{ #category : #trampolines } -CogVMSimulator >> ceSendMustBeBoolean: anObject [ - self halt. - ^super ceSendMustBeBoolean: anObject -] - -{ #category : #trampolines } -CogVMSimulator >> ceStackOverflow: contextSwitchIfNotNil [ - "Override to bump up the byteCount from which the microsecond clock is derived." - byteCount := byteCount + 1000. - ^super ceStackOverflow: contextSwitchIfNotNil -] - -{ #category : #'debug support' } -CogVMSimulator >> ceTraceBlockActivation [ - cogit printOnTrace ifTrue: - [transcript print: byteCount; nextPut: $/; print: (sendCount := sendCount + 1); space]. - cogit assertCStackWellAligned. - super ceTraceBlockActivation. - ^#continue -] - -{ #category : #'debug support' } -CogVMSimulator >> ceTraceLinkedSend: theReceiver [ - (sendCount := sendCount + 1) \\ 500 = 0 ifTrue: - [self changed: #byteCountText]. - cogit printOnTrace ifTrue: - [transcript print: byteCount; nextPut: $/; print: sendCount; space]. - cogit assertCStackWellAligned. - super ceTraceLinkedSend: theReceiver. - ^#continue -] - { #category : #'object memory support' } CogVMSimulator >> checkStackIntegrity [ "Override to deal with incomplete initialization." @@ -606,18 +453,6 @@ CogVMSimulator >> collectSends [ expecting := false ] -{ #category : #'cog jit support' } -CogVMSimulator >> commenceCogCompiledCodeCompaction [ - - ^super commenceCogCompiledCodeCompaction -] - -{ #category : #'frame access' } -CogVMSimulator >> convertToMachineCodeFrame: cogHomeMethod bcpc: bcpc [ - "bytecodeSetSelector ~= 0 ifTrue: [self halt]". - ^super convertToMachineCodeFrame: cogHomeMethod bcpc: bcpc -] - { #category : #'I/O primitives support' } CogVMSimulator >> copyBits [ @@ -689,6 +524,13 @@ CogVMSimulator >> dispatchOn: anInteger in: selectorArray [ self perform: (selectorArray at: (anInteger + 1)). ] +{ #category : #'debugging traps' } +CogVMSimulator >> divorceFrame: theFP andContext: ctxt [ + "((#(16r100570 16r101BC8) includes: theFP) or: [#(16r17159A4 16r1715948) includes: ctxt]) ifTrue: + [self halt]." + ^super divorceFrame: theFP andContext: ctxt +] + { #category : #'process primitive support' } CogVMSimulator >> doSignalExternalSemaphores: minTableSize [ "This is a non-thread-safe simulation. See platforms/Cross/vm/sqExternalSemaphores.c @@ -760,22 +602,6 @@ CogVMSimulator >> enableCog: aBoolean [ enableCog := aBoolean ] -{ #category : #'frame access' } -CogVMSimulator >> ensureContextIsExecutionSafeAfterAssignToStackPointer: aContext [ - "16r1934F80 = aContext ifTrue: - [self halt]." - ^super ensureContextIsExecutionSafeAfterAssignToStackPointer: aContext -] - -{ #category : #'frame access' } -CogVMSimulator >> ensureMethodIsCogged: methodObj maybeClosure: maybeClosure [ - "Uncomment this to compact frequently and hence test if clients are ready for the shock." - "[self commenceCogCompiledCodeCompaction] - on: Halt - do: [:ex| ex resume: nil]." - ^super ensureMethodIsCogged: methodObj maybeClosure: maybeClosure -] - { #category : #'debug support' } CogVMSimulator >> expectSends: anArray [ expectedSends := ReadStream on: anArray. @@ -808,76 +634,6 @@ CogVMSimulator >> extUnconditionalJump [ ^super extUnconditionalJump ] -{ #category : #'debugging traps' } -CogVMSimulator >> externalCannotReturn: resultOop from: aContext [ - self halt. - ^super externalCannotReturn: resultOop from: aContext -] - -{ #category : #'debugging traps' } -CogVMSimulator >> externalDivorceFrame: theFP andContext: ctxt [ - "((#(16r100570 16r101BC8) includes: theFP) or: [#(16r17159A4 16r1715948) includes: ctxt]) ifTrue: - [self halt]." - ^super externalDivorceFrame: theFP andContext: ctxt -] - -{ #category : #'debugging traps' } -CogVMSimulator >> externalInstVar: offset ofContext: aContext [ - - "offset = InstructionPointerIndex ifTrue: - [transcript nextPutAll: '==================='; cr. - self printContext: 16r1715630. - self printCallStackOf: aContext currentFP: framePointer. - transcript nextPutAll: '==================='; cr. - self halt]." - - | result | - "self shortPrintFrameAndCallers: framePointer. - transcript print: byteCount; tab; print: thisContext; cr. - self print: offset; cr. - self printContext: aContext. - (self confirm: 'continue?') ifFalse: [self halt]." - result := super externalInstVar: offset ofContext: aContext. - "(offset = InstructionPointerIndex - and: [(self stringOf: (self penultimateLiteralOf: (self fetchPointer: MethodIndex ofObject: aContext))) = #indexOf:startingAt:ifAbsent:]) ifTrue: - [transcript space; nextPutAll: '^pc '; nextPutAll: result hex. - (objectMemory isIntegerObject: result) ifTrue: - [transcript space; print: (objectMemory integerValueOf: result)]. - transcript tab. - self shortPrintContext: aContext]." - "offset = StackPointerIndex ifTrue: - [transcript nextPutAll: '^stackp ', (self integerValueOf: result) printString; tab. - self shortPrintContext: aContext. - (#(24205456 24205732) includes: aContext) ifTrue: - [(self checkIsStillMarriedContext: aContext currentFP: framePointer) - ifTrue: [self printFrame: (self frameOfMarriedContext: aContext) WithSP: (self frameOfMarriedContext: aContext) - 48] - ifFalse: [self printContext: aContext]]]." - ^result -] - -{ #category : #'frame access' } -CogVMSimulator >> externalInstVar: index ofContext: aContext put: anOop [ - "self shortPrintFrameAndCallers: framePointer. - Transcript print: byteCount; tab; print: thisContext; cr. - self print: index; cr. - self printContext: aContext. - self shortPrintOop: anOop. - (self confirm: 'continue?') ifFalse: [self halt]." - "(self stringOf: (self penultimateLiteralOf: (self fetchPointer: MethodIndex ofObject: aContext))) = #indexOf:startingAt:ifAbsent: ifTrue: - [self halt]." - ^super externalInstVar: index ofContext: aContext put: anOop -] - -{ #category : #'frame access' } -CogVMSimulator >> externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess [ - "Override to check stack depth (hence in the simulator only)." - super externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess. - (self isMachineCodeFrame: framePointer) ifTrue: - [self maybeCheckStackDepth: 0 - sp: stackPointer - pc: instructionPointer] -] - { #category : #'interpreter shell' } CogVMSimulator >> fetchByte [ ^objectMemory byteAt: (instructionPointer := instructionPointer + 1) @@ -900,33 +656,6 @@ CogVMSimulator >> filterPerformOf: selector to: receiver [ ^false ] -{ #category : #testing } -CogVMSimulator >> findNewMethodInClassTag: classTag [ -" - | cName | - traceOn ifTrue: - [cName := (self sizeBitsOf: class) = 16r20 - ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))] - ifFalse: [(self nameOfClass: class)]. - self cr; print: cName , '>>' , (self stringOf: messageSelector)]. -" - messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [self halt]. - - self logSend: messageSelector. -" - (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue: - [Transcript print: sendCount; space. - self validate]. -" -" - (sendCount > 100150) ifTrue: - [self qvalidate. - messageQueue == nil ifTrue: [messageQueue := OrderedCollection new]. - messageQueue addLast: (self stringOf: messageSelector)]. -" - ^super findNewMethodInClassTag: classTag -] - { #category : #'memory access' } CogVMSimulator >> firstIndexableField: oop [ "This is in ObjectMemory and overridden in the obj mem simulators" @@ -952,23 +681,6 @@ CogVMSimulator >> forShortPrintString: shortPrintString filterPerformMessages: a performFilters at: shortPrintString put: aCollection ] -{ #category : #'frame access' } -CogVMSimulator >> frameCallerContext: theFP [ - "In the StackInterpreter the saved ip field of a base frame holds the base - frame's caller context. But in the Cog VM the first word on the stack holds - the base frame's caller context, which is immediately above the stacked - receiver. The asserts using frameStackedReceiverOffset: are simulation - only since they depend on being able to access numArgs and frameContext - from the frame's method and in a base return the frame state, being below - the stack pointer, may have already been smashed by an interrupt." - | thePage | - self assert: (self isBaseFrame: theFP). - thePage := stackPages stackPageFor: theFP. - self assert: theFP + (self frameStackedReceiverOffset: theFP) + (2 * objectMemory wordSize) = thePage baseAddress. - self assert: (stackPages unsignedLongAt: thePage baseAddress - objectMemory wordSize) = (self frameContext: theFP). - ^super frameCallerContext: theFP -] - { #category : #'frame access' } CogVMSimulator >> frameOfMarriedContext: aContext [ | senderOop | @@ -1017,13 +729,6 @@ CogVMSimulator >> halfWordLowInLong32: long32 [ ^self subclassResponsibility ] -{ #category : #'message sending' } -CogVMSimulator >> handleMNU: selectorIndex InMachineCodeTo: rcvr classForMessage: classForMessage [ - selectorIndex = SelectorCannotInterpret ifTrue: - [self halt]. - ^super handleMNU: selectorIndex InMachineCodeTo: rcvr classForMessage: classForMessage -] - { #category : #'debug support' } CogVMSimulator >> headerStart: oop [ @@ -1035,36 +740,6 @@ CogVMSimulator >> heapMapAtWord: address Put: aBit [ ^objectMemory heapMap heapMapAtWord: address asUnsignedInteger Put: aBit ] -{ #category : #'debugging traps' } -CogVMSimulator >> ifAppropriateCompileToNativeCode: aMethodObject selector: selector [ - enableCog ifTrue: - [super ifAppropriateCompileToNativeCode: aMethodObject selector: selector] -] - -{ #category : #'frame access' } -CogVMSimulator >> iframeIsBlockActivation: theFP [ - self assert: (self isMachineCodeFrame: theFP) not. - ^super iframeIsBlockActivation: theFP -] - -{ #category : #'frame access' } -CogVMSimulator >> iframeMethod: theFP [ - self assert: (self isMachineCodeFrame: theFP) not. - ^super iframeMethod: theFP -] - -{ #category : #'frame access' } -CogVMSimulator >> iframeNumArgs: theFP [ - self assert: (self isMachineCodeFrame: theFP) not. - ^super iframeNumArgs: theFP -] - -{ #category : #'frame access' } -CogVMSimulator >> iframeSavedIP: theFP [ - self assert: (self isMachineCodeFrame: theFP) not. - ^super iframeSavedIP: theFP -] - { #category : #'image save/restore' } CogVMSimulator >> imageName [ ^imageName @@ -1162,97 +837,11 @@ CogVMSimulator >> initializePluginEntries [ self loadNewPlugin: '' ] -{ #category : #'debugging traps' } -CogVMSimulator >> instVar: offset ofContext: aContext [ - - "offset = InstructionPointerIndex ifTrue: - [Transcript nextPutAll: '==================='; cr. - self printContext: 16r1715630. - self printCallStackOf: aContext currentFP: framePointer. - Transcript nextPutAll: '==================='; cr. - self halt]." - - | result | - "self shortPrintFrameAndCallers: localFP. - Transcript print: byteCount; tab; print: thisContext; cr. - self print: offset; cr. - self printContext: aContext. - (self confirm: 'continue?') ifFalse: [self halt]." - result := super instVar: offset ofContext: aContext. - "(offset = InstructionPointerIndex - and: [(self stringOf: (self penultimateLiteralOf: (self fetchPointer: MethodIndex ofObject: aContext))) = #indexOf:startingAt:ifAbsent:]) ifTrue: - [transcript space; nextPutAll: '^pc '; nextPutAll: result hex. - (objectMemory isIntegerObject: result) ifTrue: - [transcript space; print: (objectMemory integerValueOf: result)]. - transcript tab. - self shortPrintContext: aContext]." - "offset = StackPointerIndex ifTrue: - [Transcript nextPutAll: '^stackp ', (self integerValueOf: result) printString; tab. - self shortPrintContext: aContext. - (#(24205456 24205732) includes: aContext) ifTrue: - [(self checkIsStillMarriedContext: aContext currentFP: localFP) - ifTrue: [self printFrame: (self frameOfMarriedContext: aContext) WithSP: (self frameOfMarriedContext: aContext) - 48] - ifFalse: [self printContext: aContext]]]." - ^result -] - -{ #category : #'frame access' } -CogVMSimulator >> instVar: index ofContext: aMarriedContext put: anOop [ - "self shortPrintFrameAndCallers: localFP. - Transcript print: byteCount; tab; print: thisContext; cr. - self print: index; cr. - self printContext: aMarriedContext. - self shortPrintOop: anOop. - (self confirm: 'continue?') ifFalse: [self halt]." - "(self stringOf: (self penultimateLiteralOf: (self fetchPointer: MethodIndex ofObject: aMarriedContext))) = #indexOf:startingAt:ifAbsent: ifTrue: - [self halt]." - ^super instVar: index ofContext: aMarriedContext put: anOop -] - { #category : #'interpreter shell' } CogVMSimulator >> insufficientMemorySpecifiedError [ self error: 'Insufficient memory for this image' ] -{ #category : #'debugging traps' } -CogVMSimulator >> internalCannotReturn: resultOop [ - self halt. - ^super internalCannotReturn: resultOop -] - -{ #category : #testing } -CogVMSimulator >> internalFindNewMethodOrdinary [ -" - | cName | - traceOn ifTrue: - [cName := (self sizeBitsOf: class) = 16r20 - ifTrue: ['class ' , (self nameOfClass: (self fetchPointer: 6 ofObject: class))] - ifFalse: [(self nameOfClass: class)]. - self cr; print: cName , '>>' , (self stringOf: messageSelector)]. -" - messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue: [self halt]. - - self logSend: messageSelector. -" - (sendCount > 1000 and: [sendCount\\10 = 0]) ifTrue: - [Transcript print: sendCount; space. - self validate]. -" -" - (sendCount > 100150) ifTrue: - [self qvalidate. - messageQueue == nil ifTrue: [messageQueue := OrderedCollection new]. - messageQueue addLast: (self stringOf: messageSelector)]. -" - ^super internalFindNewMethodOrdinary -] - -{ #category : #'debugging traps' } -CogVMSimulator >> internalMustBeBoolean [ - self halt. - ^super internalMustBeBoolean -] - { #category : #'interpreter shell' } CogVMSimulator >> interpret [ "This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes. @@ -1264,23 +853,20 @@ CogVMSimulator >> interpret [ Override for simulation to insert bytecode breakpoint support." - "If stacklimit is zero then the stack pages have not been initialized." - stackLimit = 0 ifTrue: - [^self initStackPagesAndInterpret]. - self internalizeIPandSP. + + stackLimit = 0 ifTrue: [ ^ self initStackPagesAndInterpret ]. + self initExtensions. self fetchNextBytecode. - [true] whileTrue: - [self assertValidExecutionPointers. - atEachStepBlock value. "N.B. may be nil" - self dispatchOn: currentBytecode in: BytecodeTable. - self incrementByteCount]. - instructionPointer := instructionPointer - 1. "undo the pre-increment of IP before returning" - self externalizeIPandSP. - ^nil - + [ true ] whileTrue: [ + self assertValidExecutionPointers. + atEachStepBlock value. "N.B. may be nil" + self dispatchOn: currentBytecode in: BytecodeTable. + self incrementByteCount ]. + instructionPointer := instructionPointer - 1. "undo the pre-increment of IP before returning" + ^ nil ] { #category : #'stack pages' } @@ -1525,20 +1111,6 @@ CogVMSimulator >> isPrimitiveFunctionPointerAnIndex [ and: [primitiveFunctionPointer <= MaxQuickPrimitiveIndex]] ] -{ #category : #'frame access' } -CogVMSimulator >> isWidowedContext: aOnceMarriedContext [ - "See if the argument is connected with a live frame or not. - If it is not, turn it into a bereaved single context." - (stackPages isFree: stackPage) ifFalse: "in baseReturn the active page has been freed." - [((stackPages somePageHasHeadFrameFP: framePointer) - or: [(stackPages somePageHasHeadFrameFP: framePointer) - or: [stackPages allPagesFree]]) ifFalse: - [(thisContext sender sender method = (CoInterpreter >> #baseFrameReturn) - or: [thisContext sender sender method = (CoInterpreter >> #ceBaseFrameReturn:)]) ifFalse: - [self halt: 'currentFP may not be written back to stack page']]]. - ^super isWidowedContext: aOnceMarriedContext -] - { #category : #'plugin support' } CogVMSimulator >> loadNewPlugin: pluginString [ (breakSelector notNil @@ -1575,26 +1147,12 @@ CogVMSimulator >> longAt: byteAddress put: a32BitValue [ ^objectMemory longAt: byteAddress put: a32BitValue ] -{ #category : #'message sending' } -CogVMSimulator >> lookupMethodInClass: class [ - lookupCount := lookupCount + 1. - ^super lookupMethodInClass: class -] - { #category : #'callback support' } CogVMSimulator >> lookupOrdinaryNoMNUEtcInClass: class [ lookupCount := lookupCount + 1. ^super lookupOrdinaryNoMNUEtcInClass: class ] -{ #category : #'frame access' } -CogVMSimulator >> makeBaseFrameFor: aContext [ "" - "aContext = 26431360 ifTrue: [self halt]." - "(objectMemory fetchPointer: MethodIndex ofObject: aContext) = 16rD4C178 ifTrue: - [self halt]." - ^super makeBaseFrameFor: aContext -] - { #category : #'cog jit support' } CogVMSimulator >> mapFunctionToAddress: aSymbolOrIndexOrBlock [ "Hackery to deal with the plugin primitive simulation hoops. @@ -1626,38 +1184,37 @@ CogVMSimulator >> mappedPluginEntries [ { #category : #'debug support' } CogVMSimulator >> maybeCheckStackDepth: delta sp: sp pc: mcpc [ - | asp bcpc startbcpc cogHomeMethod cogBlockMethod csp debugStackPointers | - debugStackDepthDictionary ifNil: [^self]. - (self isMachineCodeFrame: framePointer) ifFalse: [^self]. - cogBlockMethod := self mframeCogMethod: framePointer. - cogHomeMethod := self asCogHomeMethod: cogBlockMethod. + + | asp bcpc startbcpc cogMethod csp debugStackPointers | + debugStackDepthDictionary ifNil: [ ^ self ]. + (self isMachineCodeFrame: framePointer) ifFalse: [ ^ self ]. + cogMethod := self mframeCogMethod: framePointer. debugStackPointers := debugStackDepthDictionary - at: cogHomeMethod methodObject - ifAbsentPut: [self debugStackPointersFor: cogHomeMethod methodObject]. - startbcpc := cogHomeMethod = cogBlockMethod - ifTrue: [self startPCOfMethod: cogHomeMethod methodObject] - ifFalse: [self startPCOfClosure: (self pushedReceiverOrClosureOfFrame: framePointer)]. - bcpc := cogit bytecodePCFor: mcpc startBcpc: startbcpc in: cogBlockMethod. + at: cogMethod methodObject + ifAbsentPut: [ + self debugStackPointersFor: + cogMethod methodObject ]. + startbcpc := self startPCOfMethod: cogMethod methodObject. + bcpc := cogit bytecodePCFor: mcpc startBcpc: startbcpc in: cogMethod. self assert: bcpc ~= 0. - ((cogBlockMethod ~= cogHomeMethod or: [cogBlockMethod cmIsFullBlock]) - and: [cogit isNonLocalReturnPC: mcpc]) ifTrue: - [| lastbcpc | - "Method returns within a block (within an unwind-protect) must check the stack depth at the + (cogMethod cmIsFullBlock and: [ cogit isNonLocalReturnPC: mcpc ]) + ifTrue: [ + | lastbcpc | + "Method returns within a block (within an unwind-protect) must check the stack depth at the return, not the bytecode following, but the pc mapping maps to the bytecode following the return. lastBytecodePCForBlockAt:in: catches method returns at the end of a block, modifying the bcpc to that of the return. isNonLocalReturnPC: catches method returns not at the end. Assumes method return bytecodes are 1 bytecode long;a dodgy assumption, but good enough." - lastbcpc := cogit endPCOf: cogHomeMethod methodObject. - bcpc > lastbcpc ifTrue: [bcpc := lastbcpc]]. - asp := self stackPointerIndexForFrame: framePointer WithSP: sp + objectMemory wordSize. - csp := debugStackPointers at: bcpc ifAbsent: [-1]. + lastbcpc := cogit endPCOf: cogMethod methodObject. + bcpc > lastbcpc ifTrue: [ bcpc := lastbcpc ] ]. + asp := self + stackPointerIndexForFrame: framePointer + WithSP: sp + objectMemory wordSize. + csp := debugStackPointers at: bcpc ifAbsent: [ -1 ]. "Compensate for some edge cases" - asp - delta = csp ifTrue: - ["Compensate for the implicit context receiver push in a trap bytecode with the absence of a contnuation. + asp - delta = csp ifTrue: [ "Compensate for the implicit context receiver push in a trap bytecode with the absence of a contnuation. Assumes trap bytecodes are 1 byte bytecodes." - (SistaVM - and: [cogit isTrapAt: mcpc]) ifTrue: - [csp := csp + 1] ]. + (SistaVM and: [ cogit isTrapAt: mcpc ]) ifTrue: [ csp := csp + 1 ] ]. self assert: asp - delta + 1 = csp ] @@ -1833,14 +1390,6 @@ CogVMSimulator >> pluginList: aCollection [ pluginList := aCollection ] -{ #category : #'object memory support' } -CogVMSimulator >> preGCAction: gcModeArg [ - "Override to void debugStackPointers on any GC/remap" - debugStackDepthDictionary ifNotNil: - [debugStackDepthDictionary := Dictionary new]. - ^super preGCAction: gcModeArg -] - { #category : #'other primitives' } CogVMSimulator >> primStringcomparewithcollated [ ^ self primitiveFail @@ -2270,16 +1819,18 @@ CogVMSimulator >> reverseBytesInImage [ { #category : #'method lookup cache' } CogVMSimulator >> rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress [ + super rewriteMethodCacheEntryForExternalPrimitiveToFunction: - (self mapFunctionToAddress: (localPrimAddress = 0 - ifTrue: [#primitiveFail] - ifFalse: [localPrimAddress])). + (self mapFunctionToAddress: (localPrimAddress = 0 + ifTrue: [ #primitiveFail ] + ifFalse: [ localPrimAddress ])). "Hack; the super call will rewrite the entry to the address of the function. So (when simulating) undo the damage and put back the functionPointer" - (methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) = newMethod ifTrue: - [methodCache + (methodCache at: lastMethodCacheProbeWrite + MethodCacheMethod) + = newMethod ifTrue: [ + methodCache at: lastMethodCacheProbeWrite + MethodCachePrimFunction - put: (self cCoerce: localPrimAddress to: #'sqIntptr_t')] + put: (self cCoerce: localPrimAddress to: #sqIntptr_t) ] ] { #category : #'rump c stack' } @@ -2302,16 +1853,14 @@ CogVMSimulator >> rumpCStackSize [ { #category : #testing } CogVMSimulator >> run [ - "Just run" quitBlock := [ ^ self close ]. self initStackPages. self loadInitialContext. self initialEnterSmalltalkExecutive. - instructionPointer := instructionPointer - 1. + instructionPointer := instructionPointer - 1 "undo the pre-increment of IP before returning" - self externalizeIPandSP ] { #category : #'primitive support' } @@ -2357,12 +1906,6 @@ CogVMSimulator >> shortPrintContext: aContext [ ^super shortPrintContext: aContext ] -{ #category : #'debug printing' } -CogVMSimulator >> shortPrintFrame: theFP [ - self transcript newLine. - ^super shortPrintFrame: theFP -] - { #category : #'process primitive support' } CogVMSimulator >> signalSemaphoreWithIndex: index [ "This is a simulation. See platforms/Cross/vm/sqExternalSemaphores.c for the real code. @@ -2496,12 +2039,6 @@ CogVMSimulator >> tab [ traceOn ifTrue: [ transcript tab ]. ] -{ #category : #'return bytecodes' } -CogVMSimulator >> tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue [ - self halt. - ^super tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue -] - { #category : #testing } CogVMSimulator >> testBecome [ "Become some young things. AA testBecome " @@ -2532,30 +2069,6 @@ CogVMSimulator >> testBecome [ (objectMemory fetchPointer: 1 ofObject: list2) = p2 ifFalse: [self halt]. ] -{ #category : #testing } -CogVMSimulator >> testPCMapping [ - objectMemory allObjectsDo: - [:o| - ((objectMemory isCompiledMethod: o) - and: [self methodShouldBeCogged: o]) ifTrue: - [(self methodHasCogMethod: o) ifFalse: - [[([cogit cog: o selector: objectMemory nilObject] - on: Error - do: [:ex| - ex messageText = 'This won''t work...' ifTrue: - [ex resumeUnchecked: nil]. - ex pass]) isNil - and: [cogCompiledCodeCompactionCalledFor]] whileTrue: - [cogMethodZone clearCogCompiledCode. - cogCompiledCodeCompactionCalledFor := false]]. - (self methodHasCogMethod: o) - ifTrue: - [transcript nextPut: $.; flush. - cogit testMcToBcPcMappingForMethod: (self cogMethodOf: o)] - ifFalse: - [transcript nextPutAll: 'failed to compile method '; print: o; cr; flush]]] -] - { #category : #'simulation only' } CogVMSimulator >> transcript [ ^transcript @@ -2571,15 +2084,6 @@ CogVMSimulator >> unableToReadImageError [ self error: 'Read failed or premature end of image file' ] -{ #category : #'frame access' } -CogVMSimulator >> updateStateOfSpouseContextForFrame: theFP WithSP: theSP [ - "26431360 = (self frameContext: theFP) ifTrue: - [self halt]." - "((self stringOf: (self penultimateLiteralOf: (self frameMethodObject: theFP))) = #indexOf:startingAt:ifAbsent:) ifTrue: - [self halt]." - ^super updateStateOfSpouseContextForFrame: theFP WithSP: theSP -] - { #category : #'debug support' } CogVMSimulator >> veryDeepCopyWith: deepCopier [ "Override to short-circuit the copying of any VMPluginCodeGenerators referenced from mappedPluginEntries and @@ -2614,12 +2118,6 @@ CogVMSimulator >> warpBits [ ^ myBitBlt warpBits ] -{ #category : #'debug printing' } -CogVMSimulator >> whereIs: anOop [ - (self isOnRumpCStack: anOop) ifTrue: [^'is on rump C stack']. - ^super whereIs: anOop -] - { #category : #UI } CogVMSimulator >> windowColorToUse [ ^Color lightBlue diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index b6be7c9123..366cd45a9f 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -353,7 +353,6 @@ Cogit class >> ancilliaryClasses [ CogBytecodeDescriptor. CogBytecodeFixup. CogPrimitiveDescriptor. - CogBlockMethod. CogMethod. CogPrimitiveCallState. self activeCompilerClass literalsManagerClass}, @@ -493,124 +492,131 @@ Cogit class >> cogToBytecodeMethodMapping [ { #category : #translation } Cogit class >> declareCVarsIn: aCCodeGenerator [ - #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation' - 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'processor' 'lastNInstructions' 'simulatedAddresses' - 'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters' - 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do: - [:simulationVariableNotNeededForRealVM| - aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM]. - #( 'selfSendTrampolines' 'dynamicSuperSendTrampolines' - 'implicitReceiverSendTrampolines' 'outerSendTrampolines' - 'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do: - [:variableNotNeededInNormalVM| - aCCodeGenerator removeVariable: variableNotNeededInNormalVM]. + + #( 'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation' + 'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' + 'processor' 'lastNInstructions' 'simulatedAddresses' + 'simulatedTrampolines' 'simulatedVariableGetters' + 'simulatedVariableSetters' 'printRegisters' 'printInstructions' + 'clickConfirm' 'singleStep' ) do: [ + :simulationVariableNotNeededForRealVM | + aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM ]. + #( 'selfSendTrampolines' 'dynamicSuperSendTrampolines' + 'implicitReceiverSendTrampolines' + 'outerSendTrampolines' 'ceEnclosingObjectTrampoline' + 'numIRCs' 'indexOfIRC' 'theIRCs' ) do: [ + :variableNotNeededInNormalVM | + aCCodeGenerator removeVariable: variableNotNeededInNormalVM ]. aCCodeGenerator - addHeaderFile:''; "for e.g. offsetof" - addHeaderFile:'"jit/jit.h"'; - addHeaderFile:'"debug.h"'; - addHeaderFile:'"sqCogStackAlignment.h"'; - addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up" - addHeaderFile:'"cogmethod.h"'. + addHeaderFile: ''; + "for e.g. offsetof"addHeaderFile: '"jit/jit.h"'; + addHeaderFile: '"debug.h"'; + addHeaderFile: '"sqCogStackAlignment.h"'; + addHeaderFile: '"dispdbg.h"'; + "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up" + addHeaderFile: '"cogmethod.h"'. aCCodeGenerator - addHeaderFile:'"vmMemoryMap.h"'; - addHeaderFile:'"vmRememberedSet.h"'; - addHeaderFile:'"cointerp.h"'; - addHeaderFile:'"cogit.h"'; - addHeaderFile:''. - - aCCodeGenerator - addHeaderFile: ''. - + addHeaderFile: '"vmMemoryMap.h"'; + addHeaderFile: '"vmRememberedSet.h"'; + addHeaderFile: '"cointerp.h"'; + addHeaderFile: '"cogit.h"'; + addHeaderFile: ''. + + aCCodeGenerator addHeaderFile: ''. + aCCodeGenerator - var: #ceGetFP - declareC: 'usqIntptr_t (*ceGetFP)(void)'; - var: #ceGetSP - declareC: 'usqIntptr_t (*ceGetSP)(void)'; + var: #ceGetFP declareC: 'usqIntptr_t (*ceGetFP)(void)'; + var: #ceGetSP declareC: 'usqIntptr_t (*ceGetSP)(void)'; var: #ceCaptureCStackPointers - declareC: 'void (*ceCaptureCStackPointers)(void)'; + declareC: 'void (*ceCaptureCStackPointers)(void)'; var: #ceEnterCogCodePopReceiverReg - declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)'; + declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)'; var: #realCEEnterCogCodePopReceiverReg - declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)'; + declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverReg - declareC: 'void (*ceCallCogCodePopReceiverReg)(void)'; + declareC: 'void (*ceCallCogCodePopReceiverReg)(void)'; var: #realCECallCogCodePopReceiverReg - declareC: 'void (*realCECallCogCodePopReceiverReg)(void)'; + declareC: 'void (*realCECallCogCodePopReceiverReg)(void)'; var: #ceCallCogCodePopReceiverAndClassRegs - declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)'; + declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)'; var: #realCECallCogCodePopReceiverAndClassRegs - declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)'; + declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)'; var: #ceFlushICache - declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'; + declareC: + 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'; var: #ceCheckFeaturesFunction - declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)'; + declareC: 'static usqIntptr_t (*ceCheckFeaturesFunction)(void)'; var: #ceTryLockVMOwner - declareC: 'usqIntptr_t (*ceTryLockVMOwner)(void)'; - var: #ceUnlockVMOwner - declareC: 'void (*ceUnlockVMOwner)(void)'; + declareC: 'usqIntptr_t (*ceTryLockVMOwner)(void)'; + var: #ceUnlockVMOwner declareC: 'void (*ceUnlockVMOwner)(void)'; var: #postCompileHook - declareC: 'void (*postCompileHook)(CogMethod *)'; + declareC: 'void (*postCompileHook)(CogMethod *)'; var: #openPICList declareC: 'CogMethod *openPICList = 0'; - var: #maxMethodBefore type: #'CogBlockMethod *'; + var: #maxMethodBefore type: #'CogMethod *'; var: 'enumeratingCogMethod' type: #'CogMethod *'. aCCodeGenerator - declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel" - var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel'; - var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'. - self declareC: #(abstractOpcodes stackCheckLabel - blockEntryLabel blockEntryNoContextSwitch - stackOverflowCall sendMiss - entry noCheckEntry selfSendEntry dynSuperEntry - fullBlockNoContextSwitchEntry fullBlockEntry - picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 cPICEndOfCodeLabel) - as: #'AbstractInstruction *' - in: aCCodeGenerator. - aCCodeGenerator - declareVar: #fixups type: #'BytecodeFixup *'. + declareVar: 'aMethodLabel' type: #AbstractInstruction; + "Has to come lexicographically before backEnd & methodLabel"var: + #backEnd + declareC: 'AbstractInstruction * const backEnd = &aMethodLabel'; + var: #methodLabel + declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'. + self + declareC: + #( abstractOpcodes stackCheckLabel blockEntryLabel blockEntryNoContextSwitch + stackOverflowCall sendMiss entry noCheckEntry selfSendEntry + dynSuperEntry fullBlockNoContextSwitchEntry + fullBlockEntry picMNUAbort picInterpretAbort endCPICCase0 + endCPICCase1 cPICEndOfCodeLabel ) + as: #'AbstractInstruction *' + in: aCCodeGenerator. + aCCodeGenerator declareVar: #fixups type: #'BytecodeFixup *'. aCCodeGenerator var: #jitCodeZoneWriteEnabled - declareC: 'int jitCodeZoneWriteEnabled = 0'; + declareC: 'int jitCodeZoneWriteEnabled = 0'; var: #ordinarySendTrampolines - declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]'; + declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]'; var: #superSendTrampolines - declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'. - BytecodeSetHasDirectedSuperSend ifTrue: - [aCCodeGenerator + declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'. + BytecodeSetHasDirectedSuperSend ifTrue: [ + aCCodeGenerator var: #directedSuperSendTrampolines - declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]'; + declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]'; var: #directedSuperBindingSendTrampolines - declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]']. + declareC: + 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]' ]. aCCodeGenerator var: #trampolineAddresses - declareC: 'static char *trampolineAddresses[NumTrampolines*2]'; + declareC: 'static char *trampolineAddresses[NumTrampolines*2]'; var: #objectReferencesInRuntime - declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]'; - var: #labelCounter - type: #int; + declareC: + 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]'; + var: #labelCounter type: #int; var: #traceFlags - declareC: 'int traceFlags = 8 /* prim trace log on by default */'; + declareC: 'int traceFlags = 8 /* prim trace log on by default */'; var: #cStackAlignment - declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'. + declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'. aCCodeGenerator declareVar: #CFramePointer type: #'void *'; declareVar: #CStackPointer type: #'void *'; - declareVar: #minValidCallAddress type: #'usqIntptr_t'; - declareVar: #debugPrimCallStackOffset type: #'usqIntptr_t'. - aCCodeGenerator vmClass generatorTable ifNotNil: - [:bytecodeGenTable| + declareVar: #minValidCallAddress type: #usqIntptr_t; + declareVar: #debugPrimCallStackOffset type: #usqIntptr_t. + aCCodeGenerator vmClass generatorTable ifNotNil: [ :bytecodeGenTable | aCCodeGenerator var: #generatorTable - declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']', - (self tableInitializerFor: bytecodeGenTable - in: aCCodeGenerator)]. + declareC: 'static BytecodeDescriptor generatorTable[' + , bytecodeGenTable size printString , ']' + , (self tableInitializerFor: bytecodeGenTable in: aCCodeGenerator) ]. "In C the abstract opcode names clash with the Smalltak generator syntactic sugar. Most of the syntactic sugar is inlined, but alas some remains. Rename the syntactic sugar to avoid the clash." - (self organization listAtCategoryNamed: #'abstract instructions') do: - [:s| - aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)]. + (self organization listAtCategoryNamed: + #'abstract instructions') do: [ :s | + aCCodeGenerator + addSelectorTranslation: s + to: 'g' , (aCCodeGenerator cFunctionNameFor: s) ]. aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg' ] @@ -869,7 +875,7 @@ Cogit class >> initializeBytecodeTable [ { #category : #'class initialization' } Cogit class >> initializeCogMethodConstants [ - CMMegamorphicIC := 1 + (CMPolymorphicIC := 1 + (CMBlock := 1 + (CMMethod := 1 + (CMFree := 1)))) + CMMegamorphicIC := 1 + (CMPolymorphicIC := 1 + (CMMethod := 1 + (CMFree := 1))) ] { #category : #'class initialization' } @@ -1469,7 +1475,7 @@ Cogit class >> runtime [ { #category : #translation } Cogit class >> shouldGenerateTypedefFor: aStructClass [ "Hack to work-around mutliple definitions. Sometimes a type has been defined in an include." - ^({ CogBlockMethod. CogMethod. SistaCogMethod } includes: aStructClass) not + ^({ CogMethod. SistaCogMethod } includes: aStructClass) not ] { #category : #translation } @@ -3179,31 +3185,6 @@ Cogit >> allButTopBitOfAddressSpaceMask [ ^((1 << (8 * objectMemory wordSize - 1)) - 1) bitAnd: -4 ] -{ #category : #disassembly } -Cogit >> allCogMethodsFor: cogMethod [ - - | blockEntry end methods pc | - cogMethod isInteger ifTrue: [^self allCogMethodsFor: (self cogMethodSurrogateAt: cogMethod)]. - cogMethod cmType = CMBlock ifTrue: - [^self allCogMethodsFor: cogMethod cmHomeMethod]. - (cogMethod cmType ~= CMMethod - or: [cogMethod picUsage = 0]) ifTrue: - [^{cogMethod}]. - - methods := OrderedCollection with: cogMethod. - pc := blockEntry := cogMethod picUsage + cogMethod asInteger. - end := (self mapEndFor: cogMethod) - 1. - [pc < end] whileTrue: - [| targetpc | - targetpc := blockEntry. - (backEnd isJumpAt: pc) ifTrue: - [targetpc := backEnd jumpTargetPCAt: pc. - targetpc < blockEntry ifTrue: - [methods add: (self cCoerceSimple: targetpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *')]]. - pc := pc + (backEnd instructionSizeAt: pc)]. - ^methods sort -] - { #category : #'garbage collection' } Cogit >> allMachineCodeObjectReferencesValid [ "Check that all methods have valid selectors, and that all linked sends are to valid targets and have valid cache tags" @@ -3596,9 +3577,9 @@ Cogit >> bytecodeFixupClass [ { #category : #'method map' } Cogit >> bytecodePCFor: mcpc startBcpc: startbcpc in: cogMethod [ "Answer the zero-relative bytecode pc matching the machine code pc argument in - cogMethod, given the start of the bytecodes for cogMethod's block or method object." + cogMethod, given the start of the bytecodes for cogMethod's method object." - + ^self mapFor: cogMethod bcpc: startbcpc @@ -3624,8 +3605,6 @@ Cogit >> cCoerceSimple: value to: cTypeString [ [^(value isInteger and: [value < 0]) ifTrue: [value] "it's an error code; leave it be" ifFalse: [self cogMethodSurrogateAt: value asUnsignedInteger]]. - cTypeString == #'CogBlockMethod *' ifTrue: - [^self cogBlockMethodSurrogateAt: value asUnsignedInteger]. (cTypeString == #'AbstractInstruction *' and: [value isBehavior]) ifTrue: [^CogCompilerClass]. @@ -4552,57 +4531,6 @@ Cogit >> codeEntryNameFor: address [ ^nil ] -{ #category : #disassembly } -Cogit >> codeRangesFor: cogMethod [ - "Answer a sequence of ranges of code for the main method and all of the blocks in a CogMethod. - N.B. These are in order of block dispatch, _not_ necessarily address order in the method." - - | pc end blockEntry starts | - cogMethod cmType = CMPolymorphicIC ifTrue: - [end := cogMethod asInteger + cPICEndOfCodeOffset - backEnd jumpLongByteSize. - ^{ CogCodeRange - from: cogMethod asInteger + (self sizeof: CogMethod) - to: end - cogMethod: cogMethod - startpc: nil }]. - end := (self mapEndFor: cogMethod) - 1. - cogMethod picUsage = 0 ifTrue: - [^{ CogCodeRange - from: cogMethod asInteger + (self sizeof: CogMethod) - to: end - cogMethod: cogMethod - startpc: (cogMethod cmType ~= CMMegamorphicIC ifTrue: - [coInterpreter startPCOfMethodHeader: cogMethod methodHeader]) }]. - pc := blockEntry := cogMethod picUsage + cogMethod asInteger. - starts := OrderedCollection with: cogMethod. - [pc < end] whileTrue: - [| targetpc | - targetpc := blockEntry. - (backEnd isJumpAt: pc) ifTrue: - [targetpc := backEnd jumpTargetPCAt: pc. - targetpc < blockEntry ifTrue: - [starts add: (self cCoerceSimple: targetpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *')]]. - pc := pc + (backEnd instructionSizeAt: pc)]. - starts := starts asSortedCollection. - ^(1 to: starts size + 1) collect: - [:i| | cogSubMethod nextpc | - i <= starts size - ifTrue: - [cogSubMethod := starts at: i. - nextpc := i < starts size ifTrue: [(starts at: i + 1) address] ifFalse: [blockEntry]. - CogCodeRange - from: cogSubMethod address + (self sizeof: cogSubMethod) - to: nextpc - 1 - cogMethod: cogSubMethod - startpc: (i = 1 - ifTrue: [coInterpreter startPCOfMethodHeader: cogMethod methodHeader] - ifFalse: [cogSubMethod startpc])] - ifFalse: - [CogCodeRange - from: blockEntry - to: end]] -] - { #category : #'jit - api' } Cogit >> cog: aMethodObj selector: aSelectorOop [ "Attempt to produce a machine code method for the bytecode method @@ -4653,22 +4581,6 @@ Cogit >> cog: aMethodObj selector: aSelectorOop [ ^cogMethod ] -{ #category : #'simulation only' } -Cogit >> cogBlockMethodSurrogateAt: address [ - - self assert: (address bitAnd: objectMemory wordSize - 1) = 0. - ^cogBlockMethodSurrogateClass new - at: address - objectMemory: objectMemory - cogit: self -] - -{ #category : #'simulation only' } -Cogit >> cogBlockMethodSurrogateClass [ - - ^cogBlockMethodSurrogateClass -] - { #category : #disassembly } Cogit >> cogCodeBase [ @@ -4996,16 +4908,6 @@ Cogit >> cogMethodDoesntLookKosher: cogMethod [ ^9 ] -{ #category : #'simulation only' } -Cogit >> cogMethodOrBlockSurrogateAt: address [ - - | surrogate | - surrogate := self cogMethodSurrogateAt: address. - ^surrogate cmType = CMBlock - ifTrue: [self cogBlockMethodSurrogateAt: address] - ifFalse: [surrogate] -] - { #category : #'simulation only' } Cogit >> cogMethodSurrogateAt: address [ @@ -5191,12 +5093,10 @@ Cogit >> collectCogMethodConstituent: cogMethod [ First value is the address of the cog method. Following values are pairs of machine code pc and bytecode pc" - - | cm nSlots errCode cogBlockMethod address data | + | cm nSlots errCode address data | (cogMethod cmType = CMMethod) ifFalse: [^self positiveMachineIntegerFor: cogMethod asUnsignedInteger ]. - cogBlockMethod := self cCoerceSimple: cogMethod to: #'CogBlockMethod *'. - cogBlockMethod stackCheckOffset = 0 "isFrameless ?" + cogMethod stackCheckOffset = 0 "isFrameless ?" ifTrue: [^self positiveMachineIntegerFor: cogMethod asUnsignedInteger]. cm := cogMethod methodObject. nSlots := ((objectMemory byteSizeOf: cm) - (coInterpreter startPCOfMethod: cm)) * 2 + objectMemory minSlotsForShortening + 1."+1 for first address" @@ -5212,7 +5112,7 @@ Cogit >> collectCogMethodConstituent: cogMethod [ withValue: address. cogConstituentIndex := 1. errCode := self - mapFor: cogBlockMethod + mapFor: cogMethod bcpc: (coInterpreter startPCOfMethod: cogMethod methodObject) performUntil: #collectCogConstituentFor:Annotation:Mcpc:Bcpc:Method: arg: cogMethod asVoidPointer. @@ -6017,20 +5917,6 @@ Cogit >> disableCodeZoneWrite [ jitCodeZoneWriteEnabled := false ] -{ #category : #disassembly } -Cogit >> disassemble: targetmcpc from: startpc to: endpc arg: aStream [ - - | startbcpc | - self disassembleFrom: startpc to: endpc - 1 labels: Dictionary new on: aStream. - startbcpc := (self cCoerceSimple: targetmcpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *') startpc. - aStream nextPutAll: 'block startpc: '. - startbcpc printOn: aStream base: 16. - aStream nextPut: $/. - (objectMemory integerObjectOf: startbcpc) printOn: aStream base: 16. - aStream cr; flush. - ^0 -] - { #category : #disassembly } Cogit >> disassembleFrom: startAddress to: endAddress [ @@ -8325,10 +8211,10 @@ Cogit >> halt: aString [ Halt new signal: aString ] -{ #category : #'translation support' } +{ #category : #halting } Cogit >> haltIf: aBlock [ - aBlock ifTrue: [ self halt ] + aBlock value ifTrue: [ self halt ] ] @@ -8618,11 +8504,7 @@ Cogit >> initialize [ wordSize := self class objectMemoryClass wordSize. cogMethodSurrogateClass := wordSize = 4 ifTrue: [CogMethodSurrogate32] - ifFalse: [CogMethodSurrogate64]. - cogBlockMethodSurrogateClass := wordSize = 4 - ifTrue: [CogBlockMethodSurrogate32] - ifFalse: [CogBlockMethodSurrogate64]. - + ifFalse: [CogMethodSurrogate64]. statCompileFullBlockCount := 0. statCompileFullBlockUsecs := 0. statCompileMethodCount := 0. @@ -9131,7 +9013,7 @@ Cogit >> mapFor: cogMethod bcpc: startbcpc performUntil: functionSymbol arg: arg and to be usable for both pc-mapping and method introspection, we encode the annotation and the isBackwardBranch flag in the same parameter. Guilty as charged." - + @@ -9820,16 +9702,10 @@ Cogit >> markLiteralsAndUnlinkUnmarkedSendsIn: cogMethod [ { #category : #'jit - api' } Cogit >> markMethodAndReferents: aCogMethod [ - - | cogMethod | - - self assert: (aCogMethod cmType = CMMethod - or: [aCogMethod cmType = CMBlock]). - cogMethod := aCogMethod cmType = CMMethod - ifTrue: [self cCoerceSimple: aCogMethod to: #'CogMethod *'] - ifFalse: [aCogMethod cmHomeMethod]. - cogMethod cmUsageCount: CMMaxUsageCount. - self mapFor: cogMethod + + self assert: (aCogMethod cmType = CMMethod). + aCogMethod cmUsageCount: CMMaxUsageCount. + self mapFor: aCogMethod performUntil: #incrementUsageOfTargetIfLinkedSend:mcpc:ignored: arg: 0 ] @@ -10025,7 +9901,7 @@ Cogit >> maybeUnsafeJumpContinuation: latestContinuation at: bcpc for: descripto Cogit >> mcPCFor: bcpc startBcpc: startbcpc in: cogMethod [ "Answer the absolute machine code pc matching the zero-relative bytecode pc argument in cogMethod, given the start of the bytecodes for cogMethod's block or method object." - + ^self mapFor: cogMethod @@ -10038,9 +9914,9 @@ Cogit >> mcPCFor: bcpc startBcpc: startbcpc in: cogMethod [ Cogit >> mcPCForBackwardBranch: bcpc startBcpc: startbcpc in: cogMethod [ "Answer the absolute machine code pc matching the zero-relative bytecode pc of a backward branch in cogMethod, given the start - of the bytecodes for cogMethod's block or method object." + of the bytecodes for cogMethod's method object." - + ^self mapFor: cogMethod @@ -10550,22 +10426,16 @@ Cogit >> printMethodHeader: cogMethod on: aStream [ self cCode: '' inSmalltalk: [cogMethod isInteger ifTrue: - [^self printMethodHeader: (self cogMethodOrBlockSurrogateAt: cogMethod) on: aStream]]. + [^self printMethodHeader: (self cogMethodSurrogateAt: cogMethod) on: aStream]]. aStream newLine. cogMethod asInteger printOn: aStream base: 16. cogMethod cmType = CMMethod ifTrue: [aStream newLine; tab; nextPutAll: 'objhdr: '. cogMethod objectHeader printOn: aStream base: 16]. - cogMethod cmType = CMBlock ifTrue: - [aStream newLine; tab; nextPutAll: 'homemth: '. - cogMethod cmHomeMethod asUnsignedInteger printOn: aStream base: 16. - aStream - nextPutAll: ' (offset '; print: cogMethod homeOffset; nextPut: $); - newLine; tab; nextPutAll: 'startpc: '; print: cogMethod startpc]. aStream newLine; tab; nextPutAll: 'nArgs: '; print: cogMethod cmNumArgs; tab; nextPutAll: 'type: '; print: cogMethod cmType. - (cogMethod cmType ~= 0 and: [cogMethod cmType ~= CMBlock]) ifTrue: + (cogMethod cmType ~= 0) ifTrue: [aStream newLine; tab; nextPutAll: 'blksiz: '. cogMethod blockSize printOn: aStream base: 16. cogMethod cmType = CMMethod ifTrue: @@ -10597,20 +10467,13 @@ Cogit >> printMethodHeader: cogMethod on: aStream [ cogMethod stackCheckOffset > 0 ifTrue: [aStream nextPut: $/. cogMethod asInteger + cogMethod stackCheckOffset printOn: aStream base: 16]. - cogMethod cmType = CMBlock - ifTrue: - [aStream - newLine; tab; - nextPutAll: 'cbUsesInstVars '; - nextPutAll: (cogMethod cbUsesInstVars ifTrue: ['yes'] ifFalse: ['no'])] - ifFalse: - [aStream + aStream newLine; tab; nextPutAll: 'cmRefersToYoung: '; nextPutAll: (cogMethod cmRefersToYoung ifTrue: ['yes'] ifFalse: ['no']); tab; nextPutAll: 'cmIsFullBlock: '; - nextPutAll: (cogMethod cmIsFullBlock ifTrue: ['yes'] ifFalse: ['no'])]. + nextPutAll: (cogMethod cmIsFullBlock ifTrue: ['yes'] ifFalse: ['no']). cogMethod cmType = CMMethod ifTrue: [([cogMethod nextMethodOrIRCs] on: MessageNotUnderstood do: [:ex| nil]) ifNotNil: [:nmoircs| aStream newLine; tab; nextPutAll: 'nextMethodOrIRCs: '. @@ -11805,25 +11668,6 @@ Cogit >> stackPointerAlignment [ ^ backEnd stackPointerAlignment ] -{ #category : #disassembly } -Cogit >> startMcpcAndCogMethodForMcpc: mcpc in: cogMethod do: aBinaryBlock [ - "Evaluate aBinaryBlock with the startmcpc and method containing mcpc in cogMethod." - - | startMcpc | - startMcpc := ((self codeRangesFor: cogMethod) - detect: [:range| range includes: mcpc] - ifNone: - [(self codeRangesFor: cogMethod) - detect: [:range| range last + 1 = mcpc] - ifNone: [^nil]]) first. - ^aBinaryBlock - value: startMcpc - value: (startMcpc = (cogMethod asInteger + (self sizeof: CogMethod)) - ifTrue: [cogMethod] - ifFalse: [self cCoerceSimple: startMcpc - (self sizeof: CogBlockMethod) - to: #'CogBlockMethod *']) -] - { #category : #literals } Cogit >> storeLiteral: objOop atAnnotatedAddress: address [ @@ -11832,20 +11676,6 @@ Cogit >> storeLiteral: objOop atAnnotatedAddress: address [ ] -{ #category : #'method map' } -Cogit >> subMethodsAsRangesFor: surrogateOrAddress [ - - | cogMethod codeRanges | - cogMethod := surrogateOrAddress isInteger - ifTrue: [self cogMethodSurrogateAt: surrogateOrAddress] - ifFalse: [surrogateOrAddress]. - ^cogMethod cmType = CMMethod ifTrue: - [codeRanges := self codeRangesFor: cogMethod. - ^codeRanges size > 1 "omit the block dispatch range" - ifTrue: [codeRanges allButLast] - ifFalse: [codeRanges]] -] - { #category : #'in-line cacheing' } Cogit >> subsequentPrototypeMethodOop [ "Answer a fake value for the method oop in other than the first case in the PIC prototype. diff --git a/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st b/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st index 7bb1f07ae7..c5a1351c75 100644 --- a/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st +++ b/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacade.class.st @@ -173,11 +173,13 @@ CurrentImageCoInterpreterFacade >> bytesPerOop [ CurrentImageCoInterpreterFacade >> cCoerceSimple: value to: cTypeString [ "Type coercion for translation and simulation. For simulation answer a suitable surrogate for the struct types" - ^cTypeString - caseOf: - { [#'CogMethod *'] -> [value < 0 ifTrue: [value] ifFalse: [cogit cogMethodSurrogateAt: value asUnsignedInteger]]. - [#'CogBlockMethod *'] -> [cogit cogBlockMethodSurrogateAt: value asUnsignedInteger] } - otherwise: [super cCoerceSimple: value to: cTypeString] + + ^ cTypeString + caseOf: { ([ #'CogMethod *' ] -> [ + value < 0 + ifTrue: [ value ] + ifFalse: [ cogit cogMethodSurrogateAt: value asUnsignedInteger ] ]) } + otherwise: [ super cCoerceSimple: value to: cTypeString ] ] { #category : #'cog jit support' } @@ -908,9 +910,6 @@ CurrentImageCoInterpreterFacade >> printCogMethod: cogMethod [ header: cogMethod methodHeader. primitive ~= 0 ifTrue: [self print: ' prim '; printNum: primitive]]. - cogMethod cmType = CMBlock ifTrue: - [self print: ': block home: '; - printHex: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') cmHomeMethod asUnsignedInteger]. cogMethod cmType = CMPolymorphicIC ifTrue: [self print: ': Closed PIC N: '; printHex: cogMethod cPICNumCases]. diff --git a/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacadeForSpurObjectRepresentation.class.st b/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacadeForSpurObjectRepresentation.class.st index fcc6dd30a7..12fe1e4047 100644 --- a/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacadeForSpurObjectRepresentation.class.st +++ b/smalltalksrc/VMMaker/CurrentImageCoInterpreterFacadeForSpurObjectRepresentation.class.st @@ -83,11 +83,6 @@ CurrentImageCoInterpreterFacadeForSpurObjectRepresentation >> classTagForClass: ^(self objectForOop: classOop) identityHash ] -{ #category : #accessing } -CurrentImageCoInterpreterFacadeForSpurObjectRepresentation >> defaultNativeStackFrameSize [ - ^ coInterpreter defaultNativeStackFrameSize -] - { #category : #'cog jit support' } CurrentImageCoInterpreterFacadeForSpurObjectRepresentation >> eeInstantiateClassIndex: knownClassIndex format: objFormat numSlots: numSlots [ self assert: knownClassIndex = ClassArrayCompactIndex. diff --git a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st b/smalltalksrc/VMMaker/InterpreterPrimitives.class.st index b9c39404c0..2f78231cb9 100644 --- a/smalltalksrc/VMMaker/InterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/InterpreterPrimitives.class.st @@ -220,27 +220,12 @@ InterpreterPrimitives >> canBeImmutable: oop [ ] { #category : #'process primitive support' } -InterpreterPrimitives >> doWaitSemaphore: aSemaphoreOop [ - | excessSignals activeProc | - - - - excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: aSemaphoreOop. - excessSignals > 0 - ifTrue: - [self storeInteger: ExcessSignalsIndex ofObject: aSemaphoreOop withValue: excessSignals - 1 ] - ifFalse: - [activeProc := self activeProcess. - self addLastLink: activeProc toList: aSemaphoreOop. - self transferTo: self wakeHighestPriority ] -] +InterpreterPrimitives >> doWaitSemaphore: sema [ -{ #category : #'process primitive support' } -InterpreterPrimitives >> doWaitSemaphore: sema reEnterInterpreter: hasToReenter [ - self doWaitSemaphore: sema + self doWaitSemaphore: sema reEnterInterpreter: true ] { #category : #'primitive support' } @@ -604,6 +589,7 @@ InterpreterPrimitives >> pop: nItems thenPushBool: boolean [ InterpreterPrimitives >> positive32BitValueOf: oop [ "Convert the given object into an integer value. The object may be either a positive SmallInteger or a four-byte LargePositiveInteger." + objectMemory hasSixtyFourBitImmediates ifTrue: @@ -625,7 +611,7 @@ InterpreterPrimitives >> positive32BitValueOf: oop [ InterpreterPrimitives >> positive64BitValueOf: oop [ "Convert the given object into an integer value. The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger." - + | sz value ok | @@ -1519,36 +1505,6 @@ InterpreterPrimitives >> primitiveDivideLargeIntegers [ ] -{ #category : #'process primitives' } -InterpreterPrimitives >> 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] - 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 pop: argumentCount + 1 thenPush: objectMemory falseObject]. - owningProcess = activeProc ifTrue: - [^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 -] - { #category : #'arithmetic integer primitives' } InterpreterPrimitives >> primitiveEqual [ | integerReceiver integerArgument result | @@ -1583,31 +1539,6 @@ InterpreterPrimitives >> primitiveEqualLargeIntegers [ [self pop: 2 thenPushBool: integerRcvr = integerArg] ] -{ #category : #'process primitives' } -InterpreterPrimitives >> primitiveExitCriticalSection [ - "Exit the critical section. - This may change the active process as a result." - | criticalSection owningProcessIndex owningProcess | - criticalSection := self stackTop. "rcvr" - owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores" - (self isEmptyList: criticalSection) - ifTrue: - [objectMemory storePointerUnchecked: owningProcessIndex - ofObject: criticalSection - withValue: objectMemory nilObject] - ifFalse: - [owningProcess := self removeFirstLinkOfList: criticalSection. - "store check unnecessary because criticalSection referred to owningProcess - via its FirstLinkIndex slot before owningProcess was removed." - objectMemory storePointerUnchecked: owningProcessIndex - ofObject: criticalSection - withValue: owningProcess. - "Note that resume: isn't fair; it won't suspend the active process. - For fairness we must do the equivalent of a primitiveYield, but that - may break old code, so we stick with unfair resume:." - self resume: owningProcess preemptedYieldingIf: preemptionYields] -] - { #category : #'system control primitives' } InterpreterPrimitives >> primitiveExitToDebugger [ @@ -3025,7 +2956,7 @@ InterpreterPrimitives >> primitivePathToUsing [ the current context" | err path | - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. argumentCount >= 2 ifFalse: [^self primitiveFailFor: PrimErrBadNumArgs]. (self stackTop = objectMemory trueObject @@ -3254,32 +3185,6 @@ InterpreterPrimitives >> primitiveRemLargeIntegers [ self successful ifTrue: [self pop: 2 thenPush: oopResult]. ] -{ #category : #'process primitives' } -InterpreterPrimitives >> 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 | - proc := self stackTop. "rcvr" - (objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)) ifFalse: - [^self primitiveFail]. - 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. e.g. - - | proc myList classLinkedList | - proc := self stackTop. - myList := objectMemory fetchPointer: MyListIndex ofObject: proc. - classLinkedList := self superclassOf: (objectMemory splObj: ClassSemaphore). - ((self fetchClassOfNonInt: myList) ~= classLinkedList - and: [objectMemory isContext: (objectMemory fetchPointer: SuspendedContextIndex ofObject: proc)]) ifFalse: - [^self primitiveFail]. - self resume: proc preemptedYieldingIf: preemptionYields" -] - { #category : #'I/O primitives' } InterpreterPrimitives >> primitiveScreenDepth [ "Return a SmallInteger indicating the current depth of the OS screen. Negative values are used to imply LSB type pixel format an there is some support in the VM for handling either MSB or LSB" @@ -4259,31 +4164,6 @@ InterpreterPrimitives >> primitiveSubtractLargeIntegers [ ] -{ #category : #'process primitives' } -InterpreterPrimitives >> 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 storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject. - self pop: 1 thenPush: myList] -] - { #category : #'process primitives' } InterpreterPrimitives >> primitiveTestAndSetOwnershipOfCriticalSection [ "Attempt to test-and-set the ownership of the critical section. If not owned, @@ -4584,21 +4464,6 @@ InterpreterPrimitives >> primitiveWait [ self doWaitSemaphore: sema ] -{ #category : #'process primitives' } -InterpreterPrimitives >> primitiveYield [ - "Primitively do the equivalent of Process>yield, avoiding the overhead of a fork and a wait in the standard implementation." - | scheduler activeProc priority processLists processList | - scheduler := self schedulerPointer. - activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: scheduler. - priority := self quickFetchInteger: PriorityIndex ofObject: activeProc. - processLists := objectMemory fetchPointer: ProcessListsIndex ofObject: scheduler. - processList := objectMemory fetchPointer: priority - 1 ofObject: processLists. - - (self isEmptyList: processList) ifFalse: - [self addLastLink: activeProc toList: processList. - self transferTo: self wakeHighestPriority] -] - { #category : #accessing } InterpreterPrimitives >> profileMethod: anOop [ @@ -4668,6 +4533,7 @@ InterpreterPrimitives >> signalNoResume: aSemaphore [ InterpreterPrimitives >> signed32BitValueOf: oop [ "Convert the given object into an integer value. The object may be either a SmallInteger or a four-byte LargeInteger." + objectMemory hasSixtyFourBitImmediates @@ -4692,6 +4558,7 @@ InterpreterPrimitives >> signed64BitValueOf: oop [ "Convert the given object into an integer value. The object may be either a positive SmallInteger or a eight-byte LargeInteger." | sz value negative ok magnitude | + diff --git a/smalltalksrc/VMMaker/InterpreterProxy.class.st b/smalltalksrc/VMMaker/InterpreterProxy.class.st index 0646964827..2ccf3b1df4 100644 --- a/smalltalksrc/VMMaker/InterpreterProxy.class.st +++ b/smalltalksrc/VMMaker/InterpreterProxy.class.st @@ -119,13 +119,6 @@ InterpreterProxy >> cStringOrNullFor: oop [ oop isString ifTrue: [^oop] ifFalse: [self primitiveFail. ^0] ] -{ #category : #'callback support' } -InterpreterProxy >> callbackEnter: callbackID [ - "Re-enter the interpreter for executing a callback" - - ^self notYetImplementedError -] - { #category : #'callback support' } InterpreterProxy >> callbackLeave: cbID [ "Leave from a previous callback" diff --git a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st index 6dfc64b92e..7b85fae92e 100644 --- a/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st +++ b/smalltalksrc/VMMaker/SimpleStackBasedCogit.class.st @@ -388,7 +388,7 @@ SimpleStackBasedCogit >> compileFullBlockMethodFrameBuild: numCopied [ We arrange this using a labelOffset. A hack, but it works." methodLabel addDependent: (self annotateAbsolutePCRef: (self PushCw: methodLabel asInteger)); - setLabelOffset: MFMethodFlagIsBlockFlag.. "method" + setLabelOffset: MFMethodFlagIsBlockFlag. "method" self genMoveNilR: SendNumArgsReg. self PushR: SendNumArgsReg. "context" "Closure is on stack and initially in ReceiverResultReg. @@ -1065,23 +1065,6 @@ SimpleStackBasedCogit >> extendedStoreAndPopBytecode [ ^EncounteredUnknownBytecode ] -{ #category : #'bytecode generators' } -SimpleStackBasedCogit >> extendedStoreBytecode [ - | variableType variableIndex | - variableType := byte1 >> 6 bitAnd: 3. - variableIndex := byte1 bitAnd: 63. - variableType = 0 ifTrue: - [^self genStorePop: false ReceiverVariable: variableIndex]. - variableType = 1 ifTrue: - [self genStorePop: false TemporaryVariable: variableIndex. - "needs a fake map entry if Immutability is ON..." - self cppIf: IMMUTABILITY ifTrue: [ self annotateBytecode: self Label. ]. - ^ 0]. - variableType = 3 ifTrue: - [^self genStorePop: false LiteralVariable: variableIndex]. - ^EncounteredUnknownBytecode -] - { #category : #'bytecode generator support' } SimpleStackBasedCogit >> firstSpecialSelectorBytecodeOffset [ @@ -2888,7 +2871,7 @@ SimpleStackBasedCogit >> mapPCDataFor: cogMethod into: arrayObj [ storePointerUnchecked: 3 ofObject: introspectionData withValue: (objectMemory integerObjectOf: cmNoCheckEntryOffset)]. ^4]. errCode := self - mapFor: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') + mapFor: cogMethod bcpc: (coInterpreter startPCOfMethod: cogMethod methodObject) performUntil: #pcDataFor:Annotation:Mcpc:Bcpc:Method: arg: cogMethod asVoidPointer. diff --git a/smalltalksrc/VMMaker/SpurMemoryManager.class.st b/smalltalksrc/VMMaker/SpurMemoryManager.class.st index 7cbdcf0f7a..cf09e54b23 100644 --- a/smalltalksrc/VMMaker/SpurMemoryManager.class.st +++ b/smalltalksrc/VMMaker/SpurMemoryManager.class.st @@ -4462,11 +4462,11 @@ SpurMemoryManager >> eeInstantiateSmallClassIndex: knownClassIndex format: objFo before returning it to Smalltalk. Since this call is used in routines that do just that we are safe. Break this rule and die in GC. Result is guaranteed to be young." - self assert: (numSlots >= 0 and: [knownClassIndex ~= 0 and: [(self knownClassAtIndex: knownClassIndex) ~= nilObj]]). + self assert: (numSlots >= 0 and: [knownClassIndex ~= 0 and: [(self classAtIndex: knownClassIndex) ~= nilObj]]). self assert: (objFormat < self firstByteFormat ifTrue: [objFormat] ifFalse: [objFormat bitAnd: self byteFormatMask]) - = (self instSpecOfClass: (self knownClassAtIndex: knownClassIndex)). + = (self instSpecOfClass: (self classAtIndex: knownClassIndex)). ^self allocateSmallNewSpaceSlots: numSlots format: objFormat classIndex: knownClassIndex ] @@ -4875,7 +4875,7 @@ SpurMemoryManager >> fetchLong64: longIndex ofObject: objOop [ { #category : #'heap management' } SpurMemoryManager >> fetchPointer: fieldIndex ofFreeChunk: objOop [ - ^self longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + ^self unsignedLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) ] { #category : #'heap management' } @@ -12281,7 +12281,7 @@ SpurMemoryManager >> storePointerUnchecked: fieldIndex ofObject: objOop withValu self assert: (self isOopForwarded: objOop) not. ^self - unsignedLongAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) + longAt: objOop + self baseHeaderSize + (fieldIndex << self shiftForWord) put: valuePointer ] diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index ef2b9ecc6c..accc19700f 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -402,7 +402,6 @@ Class { 'libFFI', 'codeGeneratorToComputeAccessorDepth', 'showSurfaceFn', - 'messageCount', 'imageReader', 'imageWriter', 'pendingFinalizationSignals', @@ -421,6 +420,16 @@ Class { 'AtPutBase', 'BytecodeEncoderClassName', 'BytecodeTable', + 'CSCallbackEnter', + 'CSCallbackLeave', + 'CSCheckEvents', + 'CSEnterCriticalSection', + 'CSExitCriticalSection', + 'CSResume', + 'CSSignal', + 'CSSuspend', + 'CSWait', + 'CSYield', 'CacheProbeMax', 'DirBadPath', 'DirEntryFound', @@ -974,6 +983,17 @@ StackInterpreter class >> initializeMiscConstants [ StackPageUnreached := 0. StackPageReachedButUntraced := 1. StackPageTraced := 2. + + CSCallbackEnter := 3. + CSCallbackLeave := 4. + CSEnterCriticalSection := 5. + CSExitCriticalSection := 6. + CSResume := 7. + CSSignal := 8. + CSSuspend := 9. + CSWait := 10. + CSYield := 11. + CSCheckEvents := 12. DumpStackOnLowSpace := 0. MillisecondClockMask := 16r1FFFFFFF. @@ -1814,9 +1834,12 @@ StackInterpreter >> activateFailingPrimitiveMethod [ { #category : #'control primitives' } StackInterpreter >> activateNewFullClosure: blockClosure method: theMethod numArgs: numArgs mayContextSwitch: mayContextSwitch [ "Similar to activateNewMethod but for Closure and newMethod." - | numCopied methodHeader numTemps | + | numCopied methodHeader numTemps inInterpreter switched | self assert: theMethod = (objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure). + + inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. + numCopied := self copiedValueCountOfFullClosure: blockClosure. self push: instructionPointer. self push: framePointer. @@ -1824,6 +1847,7 @@ StackInterpreter >> activateNewFullClosure: blockClosure method: theMethod numAr self push: theMethod. self push: objectMemory nilObject. "FxThisContext field" self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs). + COGVM ifTrue: [ self push: 0. "FoxIFSavedIP" ]. "Because inst var access is not checked, we must follow the receiver in Spur to ensure it is valid." self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure). @@ -1847,18 +1871,25 @@ StackInterpreter >> activateNewFullClosure: blockClosure method: theMethod numAr self setMethod: theMethod. "Now check for stack overflow or an event (interrupt, must scavenge, etc)" + switched := false. stackPointer < stackLimit ifTrue: - [self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch] + [switched := self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]. + self returnToExecutive: inInterpreter postContextSwitch: switched ] { #category : #'message sending' } StackInterpreter >> activateNewMethod [ - | methodHeader | + + | methodHeader switched | methodHeader := self justActivateNewMethod: false. "either interpreted or machine code" "Now check for stack overflow or an event (interrupt, must scavenge, etc)." - stackPointer < stackLimit ifTrue: - [self handleStackOverflowOrEventAllowContextSwitch: (self canContextSwitchIfActivating: newMethod header: methodHeader)] + stackPointer < stackLimit ifTrue: [ + switched := self handleStackOverflowOrEventAllowContextSwitch: + (self + canContextSwitchIfActivating: newMethod + header: methodHeader). + self returnToExecutive: true postContextSwitch: switched ] ] { #category : #'process primitive support' } @@ -2082,6 +2113,18 @@ StackInterpreter >> alternateHeaderNumLiteralsMask [ ^AlternateHeaderNumLiteralsMask ] +{ #category : #'cog jit support' } +StackInterpreter >> argumentCount [ + + ^argumentCount +] + +{ #category : #'cog jit support' } +StackInterpreter >> argumentCount: numArgs [ + + argumentCount := numArgs +] + { #category : #'compiled methods' } StackInterpreter >> argumentCountOf: methodPointer [ @@ -2144,23 +2187,23 @@ StackInterpreter >> assertValidExecutionPointe: lip r: lifp s: lisp [ ] { #category : #'debug support' } -StackInterpreter >> assertValidExecutionPointe: lip r: lfp s: lsp imbar: inInterpreter line: ln [ +StackInterpreter >> assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter line: ln [ - - + + self assert: inInterpreter l: ln. self assert: stackPage = stackPages mostRecentlyUsedPage l: ln. self assertValidStackLimits: ln. - self assert: (stackPage addressIsInPage: lfp) l: ln. - self assert: lsp < lfp l: ln. - self assert: lfp > lsp l: ln. - self assert: lsp >= (stackPage realStackLimit - self stackLimitOffset) l: ln. - self assert: (lfp - lsp) / objectMemory bytesPerOop < LargeContextSlots l: ln. - self assert: (self validInstructionPointer: lip inFrame: lfp) l: ln. - self assert: ((self frameIsBlockActivation: lfp) - or: [(self pushedReceiverOrClosureOfFrame: lfp) = (self frameReceiver: lfp)]) + self assert: (stackPage addressIsInPage: lifp) l: ln. + self assert: lisp < lifp l: ln. + self assert: lifp > lisp l: ln. + self assert: lisp >= (stackPage realStackLimit - self stackLimitOffset) l: ln. + self assert: (lifp - lisp) / objectMemory bytesPerOop < LargeContextSlots l: ln. + self assert: (self validInstructionPointer: lip inFrame: lifp) l: ln. + self assert: ((self frameIsBlockActivation: lifp) + or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self frameReceiver: lifp)]) l: ln. - self assert: method = (self frameMethod: lfp) l: ln + self assert: method = (self iframeMethod: lifp) l: ln ] { #category : #'debug support' } @@ -2183,57 +2226,76 @@ StackInterpreter >> assertValidStackLimits: ln [ ] { #category : #'return bytecodes' } -StackInterpreter >> baseFrameReturn [ +StackInterpreter >> baseFrameCannotReturnTo: contextToReturnTo [ + + ^ self sendCannotReturn: localReturnValue +] - "Return from a baseFrame (the bottom frame in a stackPage). The context to - return to (which may be married) is stored in the saved instruction pointer slot." +{ #category : #'return bytecodes' } +StackInterpreter >> baseFrameReturn [ + "Return from a baseFrame (the bottom frame in a stackPage). + The context to return to may be married" + - | contextToReturnTo isAContext theFP theSP thePage frameAbove | + + | contextToReturnTo retToContext theFP theSP thePage newPage frameAbove | contextToReturnTo := self frameCallerContext: framePointer. - isAContext := objectMemory isContext: contextToReturnTo. - (isAContext and: [ self isStillMarriedContext: contextToReturnTo ]) - ifTrue: [ + + "The stack page is effectively free now, so free it. We must free it to be + correct in determining if contextToReturnTo is still married, and in case + makeBaseFrameFor: cogs a method, which may cause a code compaction, + in which case the frame must be free to avoid the relocation machinery + tracing the dead frame. Since freeing now temporarily violates the page-list + ordering invariant, use the assert-free version." + stackPages freeStackPageNoAssert: stackPage. + retToContext := objectMemory isContext: contextToReturnTo. + (retToContext and: [ self isStillMarriedContext: contextToReturnTo ]) + ifTrue: [ theFP := self frameOfMarriedContext: contextToReturnTo. thePage := stackPages stackPageFor: theFP. theFP = thePage headFP - ifTrue: [ - theSP := thePage headSP. - stackPages freeStackPageNoAssert: stackPage "for a short time invariant is violated; assert follows" ] + ifTrue: [ theSP := thePage headSP ] ifFalse: [ "Returning to some interior frame, presumably because of a sender assignment. Move the frames above to another page (they may be in use, e.g. via coroutining). Make the interior frame the top frame." frameAbove := self findFrameAbove: theFP inPage: thePage. - "Reuse the page we're exiting, which avoids allocating a new page and - manipulating the page list to mark the page we're entering as least recently - used (to avoid it being deallocated when allocating a new page)." - self moveFramesIn: thePage through: frameAbove toPage: stackPage. + "Since we've just deallocated a page we know that newStackPage won't deallocate an existing one." + newPage := stackPages newStackPage. + self assert: newPage = stackPage. + self moveFramesIn: thePage through: frameAbove toPage: newPage. + stackPages markStackPageMostRecentlyUsed: newPage. theFP := thePage headFP. theSP := thePage headSP ] ] - ifFalse: [ - (isAContext and: [ + ifFalse: [ + (retToContext and: [ objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex - ofObject: contextToReturnTo) ]) ifFalse: [ - ^ self internalCannotReturn: localReturnValue ]. + ofObject: contextToReturnTo) ]) ifFalse: [ + ^ self baseFrameCannotReturnTo: contextToReturnTo ]. + "We must void the instructionPointer to stop it being updated if makeBaseFrameFor: + cogs a method, which may cause a code compaction." + instructionPointer := 0. thePage := self makeBaseFrameFor: contextToReturnTo. theFP := thePage headFP. - theSP := thePage headSP. - stackPages freeStackPageNoAssert: stackPage "for a short time invariant is violated; assert follows" ]. + theSP := thePage headSP ]. self setStackPageAndLimit: thePage. self assert: (stackPages stackPageFor: theFP) = stackPage. + stackPointer := theSP. framePointer := theFP. - self setMethod: (self frameMethod: framePointer). instructionPointer := self pointerForOop: self stackTop. - self stackTopPut: localReturnValue. + self maybeReturnToMachineCodeFrame. + self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer). + self setMethod: (self iframeMethod: framePointer). + self stackTopPut: localReturnValue. ^ self fetchNextBytecode ] @@ -2278,9 +2340,7 @@ StackInterpreter >> binaryAtInlinePrimitive: primIndex [ ((objectMemory isContextNonImm: rec) and: [ self isMarriedOrWidowedContext: rec ]) ifTrue: [ - self externalizeIPandSP. - result := self externalInstVar: argIntAdjusted ofContext: rec. - self internalizeIPandSP ] + result := self instVar: argIntAdjusted ofContext: rec. ] ifFalse: [ result := objectMemory fetchPointer: argIntAdjusted ofObject: rec ] ]). "2066 byteAt: @@ -2723,9 +2783,7 @@ StackInterpreter >> bytecodePrimAdd [ [self pop: 2 thenPush: (objectMemory integerObjectOf: result). ^ self fetchNextBytecode "success"]] ifFalse: [self initPrimCall. - self externalizeIPandSP. self primitiveFloatAdd: rcvr toArg: arg. - self internalizeIPandSP. self successful ifTrue: [^ self fetchNextBytecode "success"]]. messageSelector := self specialSelector: 0. @@ -2835,9 +2893,7 @@ StackInterpreter >> bytecodePrimBitAnd [ ^self fetchNextBytecode "success"]. self initPrimCall. - self externalizeIPandSP. self primitiveBitAnd. - self internalizeIPandSP. self successful ifTrue: [^self fetchNextBytecode "success"]. @@ -2857,9 +2913,7 @@ StackInterpreter >> bytecodePrimBitOr [ ^self fetchNextBytecode "success"]. self initPrimCall. - self externalizeIPandSP. self primitiveBitOr. - self internalizeIPandSP. self successful ifTrue: [^self fetchNextBytecode "success"]. @@ -2872,9 +2926,7 @@ StackInterpreter >> bytecodePrimBitOr [ StackInterpreter >> bytecodePrimBitShift [ self initPrimCall. - self externalizeIPandSP. self primitiveBitShift. - self internalizeIPandSP. self successful ifTrue: [^ self fetchNextBytecode "success"]. messageSelector := self specialSelector: 12. @@ -2921,9 +2973,7 @@ StackInterpreter >> bytecodePrimDivide [ ifTrue: [self pop: 2 thenPush: (objectMemory integerObjectOf: result). ^ self fetchNextBytecode"success"]]] ifFalse: [self initPrimCall. - self externalizeIPandSP. self primitiveFloatDivide: rcvr byArg: arg. - self internalizeIPandSP. self successful ifTrue: [^ self fetchNextBytecode"success"]]. messageSelector := self specialSelector: 9. @@ -3322,9 +3372,7 @@ StackInterpreter >> bytecodePrimMultiply [ self pop: 2 thenPush: oop. ^self fetchNextBytecode "success"]] ifFalse: [self initPrimCall. - self externalizeIPandSP. self primitiveFloatMultiply: rcvr byArg: arg. - self internalizeIPandSP. self successful ifTrue: [^ self fetchNextBytecode "success"]]. messageSelector := self specialSelector: 8. @@ -3527,9 +3575,7 @@ StackInterpreter >> bytecodePrimSubtract [ [self pop: 2 thenPush: (objectMemory integerObjectOf: result). ^self fetchNextBytecode "success"]] ifFalse: [self initPrimCall. - self externalizeIPandSP. self primitiveFloatSubtract: rcvr fromArg: arg. - self internalizeIPandSP. self successful ifTrue: [^self fetchNextBytecode "success"]]. messageSelector := self specialSelector: 1. @@ -3545,10 +3591,8 @@ StackInterpreter >> bytecodePrimValue [ argumentCount := 0. isBlock := self isInstanceOfClassBlockClosure: rcvr. isBlock ifTrue: [ - self externalizeIPandSP. self initPrimCall. self primitiveFullClosureValue. - self internalizeIPandSP. self successful ifTrue: [ ^ self fetchNextBytecode ]. primFailCode := 0 ]. messageSelector := self specialSelector: 25. @@ -3557,18 +3601,16 @@ StackInterpreter >> bytecodePrimValue [ { #category : #'common selector sends' } StackInterpreter >> bytecodePrimValueWithArg [ + | rcvr isBlock | rcvr := self stackValue: 1. argumentCount := 1. isBlock := self isInstanceOfClassBlockClosure: rcvr. - isBlock ifTrue: - [self externalizeIPandSP. + isBlock ifTrue: [ self initPrimCall. self primitiveFullClosureValue. - self internalizeIPandSP. - self successful ifTrue: - [^self fetchNextBytecode]. - primFailCode := 0]. + self successful ifTrue: [ ^ self fetchNextBytecode ]. + primFailCode := 0 ]. messageSelector := self specialSelector: 26. self normalSend ] @@ -3642,70 +3684,6 @@ StackInterpreter >> callPrimitiveBytecode [ [^self respondToUnknownBytecode]] ] -{ #category : #'callback support' } -StackInterpreter >> callbackEnter: callbackID [ - "Re-enter the interpreter to execute a (non-ALien,non-FFI) callback (as used by the Python bridge)." - - - - | savedReenterInterpreter | - - - "For now, do not allow a callback unless we're in a primitiveResponse" - (self asserta: primitiveFunctionPointer ~= 0) ifFalse: - [^false]. - - self assert: primFailCode = 0. - - "Check if we've exceeded the callback depth" - (self asserta: jmpDepth < MaxJumpBuf) ifFalse: - [^false]. - jmpDepth := jmpDepth + 1. - - "Suspend the currently active process" - suspendedCallbacks at: jmpDepth put: self activeProcess. - "We need to preserve newMethod explicitly since it is not activated yet - and therefore no context has been created for it. If the caller primitive - for any reason decides to fail we need to make sure we execute the correct - method and not the one 'last used' in the call back" - suspendedMethods at: jmpDepth put: newMethod. - "Signal external semaphores since a signalSemaphoreWithIndex: request may - have been issued immediately prior to this callback before the VM has any - chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:" - self signalExternalSemaphores. - "If no process is awakened by signalExternalSemaphores then transfer - to the highest priority runnable one." - (suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue: - [self transferTo: self wakeHighestPriority]. - - "Typically, invoking the callback means that some semaphore has been - signaled to indicate the callback. Force an interrupt check as soon as possible." - self forceInterruptCheck. - - "Save the previous interpreter entry jmp_buf." - self memcpy: savedReenterInterpreter asVoidPointer - _: reenterInterpreter - _: (self sizeof: #'jmp_buf'). - (self setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID" - [callbackID at: 0 put: jmpDepth. - self enterSmalltalkExecutive. - self assert: false "NOTREACHED"]. - - "Restore the previous interpreter entry jmp_buf." - self memcpy: reenterInterpreter - _: (self cCoerceSimple: savedReenterInterpreter to: #'void *') - _: (self sizeof: #'jmp_buf'). - - "Transfer back to the previous process so that caller can push result" - self putToSleep: self activeProcess yieldingIf: preemptionYields. - self transferTo: (suspendedCallbacks at: jmpDepth). - newMethod := suspendedMethods at: jmpDepth. "see comment above" - argumentCount := self argumentCountOf: newMethod. - self assert: primFailCode = 0. - jmpDepth := jmpDepth - 1. - ^true -] - { #category : #'callback support' } StackInterpreter >> callbackLeave: cbID [ "Leave from a previous callback" @@ -3895,7 +3873,7 @@ StackInterpreter >> checkForEventsMayContextSwitch: mayContextSwitch [ "restore the stackLimit if it has been smashed." self restoreStackLimit. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. self assert: stackPage = stackPages mostRecentlyUsedPage. "Allow the platform to do anything it needs to do synchronously." @@ -4016,7 +3994,7 @@ StackInterpreter >> checkForStackOverflow [ piggy-backs off the stackLimit by setting it to all ones, the check for overflow must be against the real stack limit to find out if overflow has actually occurred." - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. stackPointer < stackPage realStackLimit ifTrue: [self handleStackOverflow] ] @@ -4216,7 +4194,7 @@ StackInterpreter >> checkOkayStackZone: writeBack [ writeBack ifTrue: - [self externalWriteBackHeadFramePointers]. + [self writeBackHeadFramePointers]. ok := true. 0 to: numStackPages - 1 do: @@ -4294,7 +4272,7 @@ StackInterpreter >> checkStackIntegrity [ and: [(self frameOfMarriedContext: oop) = theFP]]) ifFalse: [self printFrameThing: 'frame ctxt should be married to this frame ' andFrame: theFP at: theFP + FoxThisContext. ok := false]]. - oop := self frameMethod: theFP. + oop := self iframeMethod: theFP. ((objectMemory isImmediate: oop) or: [(objectMemory heapMapAtWord: (self pointerForOop: oop)) = 0]) ifTrue: [self printFrameThing: 'object leak in frame mthd' andFrame: theFP at: theFP + FoxMethod. @@ -4506,14 +4484,14 @@ StackInterpreter >> commonCallerReturn [ stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer). framePointer := callersFPOrNull. - self setMethod: (self frameMethod: framePointer). + self maybeReturnToMachineCodeFrame. + self setMethod: (self iframeMethod: framePointer). self fetchNextBytecode. self stackTopPut: localReturnValue ] { #category : #'return bytecodes' } StackInterpreter >> commonReturn [ - "Do an ^-return (return from method), checking for unwinds if this is a block activation. Note: Assumed to be inlined into the dispatch loop." @@ -4524,7 +4502,7 @@ StackInterpreter >> commonReturn [ | closure home unwindContextOrNilOrZero frameToReturnTo contextToReturnTo theFP callerFP newPage | - (self iframeIsBlockActivation: framePointer) ifFalse: [ + (self iframeIsBlockActivation: framePointer) ifFalse: [ ^ self commonCallerReturn ]. "If this is a method simply return to the sender/caller." @@ -4532,28 +4510,27 @@ StackInterpreter >> commonReturn [ "Update the current page's headFrame pointers to enable the search for unwind protects below to identify widowed contexts correctly." self writeBackHeadFramePointers. - self externalizeIPandSP. "Since this is a block activation the closure is on the stack above any args and the frame." closure := self pushedReceiverOrClosureOfFrame: framePointer. home := nil. "avoid compiler warning" "Walk the closure's lexical chain to find the context or frame to return from (home). If home is missing (Sista closures) then throw cannotReturn rather than crash." - [ closure ~= objectMemory nilObject ] whileTrue: [ + [ closure ~= objectMemory nilObject ] whileTrue: [ home := objectMemory followField: FullClosureOuterContextIndex ofObject: closure. - (objectMemory isContext: home) ifFalse: [ - ^ self internalCannotReturn: localReturnValue ]. + (objectMemory isContext: home) ifFalse: [ + ^ self sendCannotReturn: localReturnValue ]. closure := objectMemory followField: ClosureIndex ofObject: home ]. "home is to be returned from provided there is no unwind-protect activation between this frame and home's sender. Search for an unwind. findUnwindThroughContext: will answer either the context for an unwind-protect activation or nilObj if the sender cannot be found or 0 if no unwind is found but the sender is." unwindContextOrNilOrZero := self findUnwindThroughContext: home. - unwindContextOrNilOrZero = objectMemory nilObject ifTrue: [ "error: can't find home on chain; cannot return" - ^ self internalCannotReturn: localReturnValue ]. - unwindContextOrNilOrZero ~= 0 ifTrue: [ + unwindContextOrNilOrZero = objectMemory nilObject ifTrue: [ "error: can't find home on chain; cannot return" + ^ self sendCannotReturn: localReturnValue ]. + unwindContextOrNilOrZero ~= 0 ifTrue: [ ^ self internalAboutToReturn: localReturnValue through: unwindContextOrNilOrZero ]. @@ -4562,19 +4539,19 @@ StackInterpreter >> commonReturn [ We could be returning to either a context or a frame. Find out which." contextToReturnTo := nil. (self isMarriedOrWidowedContext: home) - ifTrue: [ + ifTrue: [ self assert: (self checkIsStillMarriedContext: home currentFP: framePointer). theFP := self frameOfMarriedContext: home. (self isBaseFrame: theFP) ifTrue: [ contextToReturnTo := self frameCallerContext: theFP ] ifFalse: [ frameToReturnTo := self frameCallerFP: theFP ] ] - ifFalse: [ + ifFalse: [ contextToReturnTo := objectMemory fetchPointer: SenderIndex ofObject: home. - ((objectMemory isContext: contextToReturnTo) and: [ - self isMarriedOrWidowedContext: contextToReturnTo ]) ifTrue: [ + ((objectMemory isContext: contextToReturnTo) and: [ + self isMarriedOrWidowedContext: contextToReturnTo ]) ifTrue: [ self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer). @@ -4582,11 +4559,11 @@ StackInterpreter >> commonReturn [ contextToReturnTo := nil ] ]. "If returning to a context we must make a frame for it unless it is dead." - contextToReturnTo ~= nil ifTrue: [ + contextToReturnTo ~= nil ifTrue: [ frameToReturnTo := self establishFrameForContextToReturnTo: contextToReturnTo. - frameToReturnTo = 0 ifTrue: [ "error: home's sender is dead; cannot return" - ^ self internalCannotReturn: localReturnValue ] ]. + frameToReturnTo = 0 ifTrue: [ "error: home's sender is dead; cannot return" + ^ self sendCannotReturn: localReturnValue ] ]. "Now we have a frame to return to. If it is on a different page we must free intervening pages and nil out intervening contexts. We must free intervening stack pages because if we leave the pages @@ -4595,18 +4572,18 @@ StackInterpreter >> commonReturn [ frame linked to because these may be in use, e.g. via co-routining (see baseFrameReturn)." self assert: stackPages pageListIsWellFormed. newPage := stackPages stackPageFor: frameToReturnTo. - newPage ~~ stackPage ifTrue: [ + newPage ~~ stackPage ifTrue: [ | currentCtx thePage nextCntx | currentCtx := self frameCallerContext: stackPage baseFP. stackPages freeStackPage: stackPage. - [ + [ self assert: (objectMemory isContext: currentCtx). - (self isMarriedOrWidowedContext: currentCtx) and: [ + (self isMarriedOrWidowedContext: currentCtx) and: [ (stackPages stackPageFor: - (theFP := self frameOfMarriedContext: currentCtx)) = newPage ] ] - whileFalse: [ + (theFP := self frameOfMarriedContext: currentCtx)) = newPage ] ] + whileFalse: [ (self isMarriedOrWidowedContext: currentCtx) - ifTrue: [ + ifTrue: [ thePage := stackPages stackPageFor: theFP. theFP ~= thePage headFP ifTrue: [ "Since we've just deallocated a page we know that newStackPage won't deallocate an existing one." self @@ -4615,7 +4592,7 @@ StackInterpreter >> commonReturn [ toPage: stackPages newStackPage ]. currentCtx := self frameCallerContext: thePage baseFP. stackPages freeStackPage: thePage ] - ifFalse: [ + ifFalse: [ nextCntx := objectMemory fetchPointer: SenderIndex ofObject: currentCtx. @@ -4630,10 +4607,10 @@ StackInterpreter >> commonReturn [ in the caller frame. We need to peel back any frames on the page until we get to the correct frame." framePointer = frameToReturnTo - ifTrue: [ "pop the saved IP, push the return value and continue." + ifTrue: [ "pop the saved IP, push the return value and continue." instructionPointer := self pointerForOop: self stackTop ] - ifFalse: [ - [ + ifFalse: [ + [ callerFP := framePointer. framePointer := self frameCallerFP: framePointer. framePointer ~~ frameToReturnTo ] whileTrue. @@ -4641,7 +4618,7 @@ StackInterpreter >> commonReturn [ stackPointer := (self frameCallerSP: callerFP) - objectMemory wordSize ]. self maybeReturnToMachineCodeFrame. - self setMethod: (self frameMethod: framePointer). + self setMethod: (self iframeMethod: framePointer). self fetchNextBytecode. self stackTopPut: localReturnValue ] @@ -4654,11 +4631,9 @@ StackInterpreter >> commonSendOrdinary [ "Note: This method is inlined into the interpreter dispatch loop." self sendBreakpoint: messageSelector receiver: (self stackValue: argumentCount). - self printSends ifTrue: - [self printActivationNameForSelector: messageSelector startClass: (objectMemory classForClassTag: lkupClassTag); cr]. - messageCount := messageCount + 1. - self internalFindNewMethodOrdinary. - self internalExecuteNewMethod. + self doRecordSendTrace. + self findNewMethodOrdinary. + self executeNewMethod. self fetchNextBytecode ] @@ -4945,12 +4920,6 @@ StackInterpreter >> currentBytecode [ ^ currentBytecode ] -{ #category : #'stack pages' } -StackInterpreter >> defaultNativeStackFrameSize [ - "default native stack frame size" - ^ 256 -] - { #category : #initialization } StackInterpreter >> defaultNumStackPages [ "Return the default number of stack pages allocate at startup. @@ -5018,7 +4987,7 @@ StackInterpreter >> divorceAllFrames [ stackPage ~= 0 ifTrue: - [self externalWriteBackHeadFramePointers]. + [self writeBackHeadFramePointers]. activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer + objectMemory wordSize. @@ -5031,6 +5000,57 @@ StackInterpreter >> divorceAllFrames [ ^activeContext ] +{ #category : #'frame access' } +StackInterpreter >> divorceFrame: theFP andContext: ctxt [ + "Divorce a single frame and its context. If it is not the top frame of a stack this means splitting its stack." + | thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP | + + + + + + + + + "stackPage needs to have current head pointers to avoid confusion." + self assert: (stackPage = 0 or: [stackPage = stackPages mostRecentlyUsedPage]). + thePage := stackPages stackPageFor: theFP. + (onCurrent := thePage = stackPage) ifFalse: + [stackPages markStackPageNextMostRecentlyUsed: thePage]. + theSP := self findSPOf: theFP on: thePage. + self updateStateOfSpouseContextForFrame: theFP WithSP: theSP. + callerCtx := self ensureCallerContext: theFP. + (frameAbove := self findFrameAbove: theFP inPage: thePage) = 0 + ifTrue: "If we're divorcing the top frame we can simply peel it off." + [theIP := stackPages unsignedLongAt: thePage headSP] + ifFalse: "othewise move all frames above to a new stack and then peel the frame off." + [newPage := stackPages newStackPage. + theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove). + frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage. + onCurrent + ifTrue: + [self setStackPageAndLimit: newPage. + self setStackPointersFromPage: newPage] + ifFalse: + [stackPages markStackPageMostRecentlyUsed: newPage]. + self assert: (self frameCallerContext: frameAbove) = ctxt]. + objectMemory storePointerUnchecked: InstructionPointerIndex + ofObject: ctxt + withValue: (self contextInstructionPointer: theIP frame: theFP). + objectMemory storePointer: SenderIndex + ofObject: ctxt + withValue: callerCtx. + callerFP := self frameCallerFP: theFP. + callerFP = 0 "theFP is a base frame; it is now alone; free the entire page" + ifTrue: [stackPages freeStackPage: thePage] + ifFalse: + [callerIP := self oopForPointer: (self frameCallerSavedIP: theFP). + callerSP := (self frameCallerSP: theFP) - objectMemory wordSize. + stackPages unsignedLongAt: callerSP put: callerIP. + self setHeadFP: callerFP andSP: callerSP inPage: thePage] + +] + { #category : #'frame access' } StackInterpreter >> divorceFramesIn: aStackPage [ | theFP calleeFP theSP theIP calleeContext theContext | @@ -5138,6 +5158,16 @@ StackInterpreter >> doPrimitiveMod: rcvr by: arg [ ^ integerResult ] +{ #category : #'send bytecodes' } +StackInterpreter >> doRecordSendTrace [ + + self printSends ifTrue: [ + self + printActivationNameForSelector: messageSelector + startClass: (objectMemory classForClassTag: lkupClassTag); + cr ] +] + { #category : #'process primitive support' } StackInterpreter >> doSignalSemaphoreWithIndex: index [ "Signal the external semaphore with the given index. Answer if a context switch @@ -5151,6 +5181,31 @@ StackInterpreter >> doSignalSemaphoreWithIndex: index [ and: [self synchronousSignal: sema] ] +{ #category : #'process primitive support' } +StackInterpreter >> doWaitSemaphore: sema reEnterInterpreter: hasToReenter [ + | excessSignals activeProc inInterpreter | + + + + excessSignals := self fetchInteger: ExcessSignalsIndex ofObject: sema. + excessSignals > 0 + ifTrue: + [self storeInteger: ExcessSignalsIndex + ofObject: sema + withValue: excessSignals - 1] + ifFalse: + ["We're going to switch process, either to an interpreted frame or a machine + code frame. To know whether to return or enter machine code we have to + know from whence we came. We could have come from the interpreter, + either directly or via a machine code primitive. We could have come from + machine code. The instructionPointer tells us where from:" + inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. + activeProc := self activeProcess. + self addLastLink: activeProc toList: sema. + self transferTo: self wakeHighestPriority from: CSWait. + hasToReenter ifTrue: [self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]] +] + { #category : #initialization } StackInterpreter >> dummyReferToProxy [ @@ -5269,6 +5324,36 @@ StackInterpreter >> ensureImageFormatIsUpToDate: swapBytes [ ifFalse: [self convertFloatsToPlatformOrder] ] +{ #category : #'frame access' } +StackInterpreter >> ensureIsBaseFrame: aFramePtr [ + "Ensure aFramePtr is a base frame. Then we can assign its sender. + Answer the possibly moved location of the frame." + | theFP thePage onCurrent | + + + + + (self isBaseFrame: aFramePtr) ifTrue: + [^aFramePtr]. + theFP := aFramePtr. + thePage := stackPages stackPageFor: theFP. + onCurrent := thePage = stackPage. + "Storing the frame's sender with its caller's context + has the side effect of making theFP a base frame." + theFP := self + storeSenderOfFrame: theFP + withValue: (self ensureCallerContext: theFP). + onCurrent + ifTrue: + [self assert: stackPage ~~ thePage. "stackPage has moved to a new page" + self setStackPointersFromPage: stackPage] + ifFalse: + [stackPages markStackPageMostRecentlyUsed: stackPage]. + self assert: stackPages pageListIsWellFormed. + self assert: stackPage = stackPages mostRecentlyUsedPage. + ^theFP +] + { #category : #'send bytecodes' } StackInterpreter >> ensureReceiverUnforwarded [ "To maintain the invariant that all receivers are unforwarded we need an explicit @@ -5304,12 +5389,19 @@ StackInterpreter >> enterSmalltalkExecutiveImplementation [ "Setjmp for reentry into interpreter from elsewhere, e.g. FFI exception primitive failure." self sigset: reenterInterpreter jmp: 0. - self setMethod: (self frameMethod: framePointer). + self setMethod: (self iframeMethod: framePointer). self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'. self interpret. ^0 ] +{ #category : #'cog jit support' } +StackInterpreter >> error: aString [ + + + super error: aString +] + { #category : #'frame access' } StackInterpreter >> establishFrameForContextToReturnTo: contextToReturnTo [ | thePage | @@ -5331,17 +5423,72 @@ StackInterpreter >> establishFrameForContextToReturnTo: contextToReturnTo [ { #category : #'message sending' } StackInterpreter >> executeNewMethod [ - "Execute newMethod - either primitiveFunctionPointer must be set directly - (i.e. from primitiveExecuteMethod et al), or it would have been set probing - the method cache (i.e. primitivePerform et al)." - primitiveFunctionPointer ~= 0 ifTrue: - [self isPrimitiveFunctionPointerAnIndex ifTrue: - [self externalQuickPrimitiveResponse. - ^nil]. - self slowPrimitiveResponse. - self successful ifTrue: [^nil]]. "if not primitive, or primitive failed, activate the method" - self activateNewMethod + + | inInterpreter | + inInterpreter := self isInstructionPointerInInterpreter: + instructionPointer. + self + executePrimitiveFromInterpreter: inInterpreter + ifFail: [ "if not primitive, or primitive failed, activate the method" + self activateNewMethod ] +] + +{ #category : #'message sending' } +StackInterpreter >> executePrimitiveFromInterpreter: inInterpreter ifFail: aBlock [ + "For interpreter performance and to ease the objectAsMethod implementation eagerly + evaluate the primtiive, i.e. if the method is cogged and has a primitive /do not/ evaluate + the machine code primitive, just evaluate primitiveFunctionPointer directly." + + primitiveFunctionPointer ~= 0 ifTrue: [ + | succeeded | + self isPrimitiveFunctionPointerAnIndex ifTrue: [ + self executeQuickPrimitive. + self returnToExecutive: inInterpreter. + ^ nil ]. + "slowPrimitiveResponse may of course context-switch. + If so we must reenter the new process appropriately, returning only if we've found an interpreter frame. + The instructionPointer tells us from whence we came." + succeeded := self slowPrimitiveResponse. + succeeded ifTrue: [ + self returnToExecutive: inInterpreter. + ^ nil ] ]. + + ^ aBlock value +] + +{ #category : #'primitive support' } +StackInterpreter >> executeQuickPrimitive [ + + "Invoke a quick primitive. + Called under the assumption that primFunctionPtr has been preloaded" + + | localPrimIndex | + self assert: self isPrimitiveFunctionPointerAnIndex. + localPrimIndex := self + cCoerceSimple: primitiveFunctionPointer + to: #sqInt. + self assert: (localPrimIndex > 255 and: [ localPrimIndex < 520 ]). + "Quick return inst vars" + localPrimIndex >= 264 ifTrue: [ + self stackTopPut: (objectMemory + fetchPointer: localPrimIndex - 264 + ofObject: self stackTop). + ^ true ]. + "Quick return constants" + localPrimIndex = 256 ifTrue: [ ^ true "return self" ]. + localPrimIndex = 257 ifTrue: [ + self stackTopPut: objectMemory trueObject. + ^ true ]. + localPrimIndex = 258 ifTrue: [ + self stackTopPut: objectMemory falseObject. + ^ true ]. + localPrimIndex = 259 ifTrue: [ + self stackTopPut: objectMemory nilObject. + ^ true ]. + self stackTopPut: + (objectMemory integerObjectOf: localPrimIndex - 261). + ^ true ] { #category : #'translation support' } @@ -5621,311 +5768,48 @@ StackInterpreter >> extendedPushBytecode [ ] -{ #category : #'stack bytecodes' } -StackInterpreter >> extendedStoreAndPopBytecode [ - - self extendedStoreBytecodePop: true - "may not be reached (immutable receiver)" +{ #category : #'primitive support' } +StackInterpreter >> failUnbalancedPrimitive [ + "not inlined for breakpoint value..." + + self primitiveFailFor: PrimErrBadNumArgs ] -{ #category : #'stack bytecodes' } -StackInterpreter >> extendedStoreBytecode [ - - self extendedStoreBytecodePop: false - "may not be reached (immutable receiver)" +{ #category : #utilities } +StackInterpreter >> fetchArray: fieldIndex ofObject: objectPointer [ + "Fetch the instance variable at the given index of the given object. Return the address of first indexable field of resulting array object, or fail if the instance variable does not contain an indexable bytes or words object." + "Note: May be called by translated primitive code." + + | arrayOop | + + arrayOop := objectMemory fetchPointer: fieldIndex ofObject: objectPointer. + ^ self arrayValueOf: arrayOop + ] -{ #category : #'stack bytecodes' } -StackInterpreter >> extendedStoreBytecodePop: popBoolean [ +{ #category : #'interpreter shell' } +StackInterpreter >> fetchByte [ + "This method uses the preIncrement builtin function which has no Smalltalk equivalent. Thus, it must be overridden in the simulator." - - | descriptor variableType variableIndex value | - descriptor := self fetchByte. - variableType := descriptor >> 6 bitAnd: 3. - variableIndex := descriptor bitAnd: 63. - value := self stackTop. - popBoolean ifTrue: [ self pop: 1 ]. - variableType = 0 ifTrue: [ - objectMemory - storePointerImmutabilityCheck: variableIndex - ofObject: self receiver - withValue: value. - ^ self fetchNextBytecode ]. - variableType = 1 ifTrue: [ - self fetchNextBytecode. - self temporary: variableIndex in: framePointer put: value. - ^ self "keep slang happy" ]. - variableType = 3 ifTrue: [ - self storeLiteralVariable: variableIndex withValue: value. - ^ self fetchNextBytecode ]. - self error: 'illegal store' + ^objectMemory byteAtPointer: instructionPointer preIncrement ] -{ #category : #'frame access' } -StackInterpreter >> externalDivorceFrame: theFP andContext: ctxt [ - "Divorce a single frame and its context. If it is not the top frame of a stack this means splitting its stack." - | thePage onCurrent theSP callerCtx newPage frameAbove callerFP callerSP callerIP theIP | - - - - - - - - - "stackPage needs to have current head pointers to avoid confusion." - self assert: (stackPage = 0 or: [stackPage = stackPages mostRecentlyUsedPage]). - thePage := stackPages stackPageFor: theFP. - (onCurrent := thePage = stackPage) ifFalse: - [stackPages markStackPageNextMostRecentlyUsed: thePage]. - theSP := self findSPOf: theFP on: thePage. - self updateStateOfSpouseContextForFrame: theFP WithSP: theSP. - callerCtx := self ensureCallerContext: theFP. - (frameAbove := self findFrameAbove: theFP inPage: thePage) = 0 - ifTrue: "If we're divorcing the top frame we can simply peel it off." - [theIP := stackPages unsignedLongAt: thePage headSP] - ifFalse: "othewise move all frames above to a new stack and then peel the frame off." - [newPage := stackPages newStackPage. - theIP := self oopForPointer: (self frameCallerSavedIP: frameAbove). - frameAbove := self moveFramesIn: thePage through: frameAbove toPage: newPage. - onCurrent - ifTrue: - [self setStackPageAndLimit: newPage. - self setStackPointersFromPage: newPage] - ifFalse: - [stackPages markStackPageMostRecentlyUsed: newPage]. - self assert: (self frameCallerContext: frameAbove) = ctxt]. - objectMemory storePointerUnchecked: InstructionPointerIndex - ofObject: ctxt - withValue: (self contextInstructionPointer: theIP frame: theFP). - objectMemory storePointer: SenderIndex - ofObject: ctxt - withValue: callerCtx. - callerFP := self frameCallerFP: theFP. - callerFP = 0 "theFP is a base frame; it is now alone; free the entire page" - ifTrue: [stackPages freeStackPage: thePage] - ifFalse: - [callerIP := self oopForPointer: (self frameCallerSavedIP: theFP). - callerSP := (self frameCallerSP: theFP) - objectMemory wordSize. - stackPages unsignedLongAt: callerSP put: callerIP. - self setHeadFP: callerFP andSP: callerSP inPage: thePage] - -] - -{ #category : #'frame access' } -StackInterpreter >> externalEnsureIsBaseFrame: aFramePtr [ - "Ensure aFramePtr is a base frame. Then we can assign its sender. - Answer the possibly moved location of the frame." - | theFP thePage onCurrent | - - - - - (self isBaseFrame: aFramePtr) ifTrue: - [^aFramePtr]. - theFP := aFramePtr. - thePage := stackPages stackPageFor: theFP. - onCurrent := thePage = stackPage. - "Storing the frame's sender with its caller's context - has the side effect of making theFP a base frame." - theFP := self - storeSenderOfFrame: theFP - withValue: (self ensureCallerContext: theFP). - onCurrent - ifTrue: - [self assert: stackPage ~~ thePage. "stackPage has moved to a new page" - self setStackPointersFromPage: stackPage] - ifFalse: - [stackPages markStackPageMostRecentlyUsed: stackPage]. - self assert: stackPages pageListIsWellFormed. - self assert: stackPage = stackPages mostRecentlyUsedPage. - ^theFP -] - -{ #category : #'frame access' } -StackInterpreter >> externalInstVar: offset ofContext: aContext [ - "Fetch an instance variable from a maybe married context. - If the context is still married compute the value of the - relevant inst var from the spouse frame's state." - - - self assert: (objectMemory isContext: aContext). - self assert: offset <= (ReceiverIndex + (self checkStackPointerForMaybeMarriedContext: aContext)). - "method, closureOrNil & receiver need no special handling; only - sender, pc & stackp have to be computed for married contexts." - (self isReadMediatedContextInstVarIndex: offset) ifTrue: - [self externalWriteBackHeadFramePointers. - (self isStillMarriedContext: aContext) ifTrue: - [^self fetchPointer: offset ofMarriedContext: aContext]]. - - ^objectMemory fetchPointer: offset ofObject: aContext -] - -{ #category : #'frame access' } -StackInterpreter >> externalInstVar: index ofContext: maybeMarriedContext put: anOop [ - | theFP thePage onCurrentPage | - - - self assert: (objectMemory isContext: maybeMarriedContext). - self externalWriteBackHeadFramePointers. - "Assign the field of a married context." - self deny: (objectMemory isObjImmutable: maybeMarriedContext). - (self isStillMarriedContext: maybeMarriedContext) ifFalse: - [objectMemory storePointer: index ofObject: maybeMarriedContext withValue: anOop. - index = StackPointerIndex ifTrue: - [self ensureContextIsExecutionSafeAfterAssignToStackPointer: maybeMarriedContext]. - ^nil]. - theFP := self frameOfMarriedContext: maybeMarriedContext. - thePage := stackPages stackPageFor: theFP. - self assert: stackPage = stackPages mostRecentlyUsedPage. - onCurrentPage := thePage = stackPage. - index = SenderIndex - ifTrue: - [self storeSenderOfFrame: theFP withValue: anOop] - ifFalse: - [self externalDivorceFrame: theFP andContext: maybeMarriedContext. - (self is: index methodAssignmentToContextWithMachineCodePC: maybeMarriedContext) ifTrue: - [self ensureContextHasBytecodePC: maybeMarriedContext]. - objectMemory storePointer: index ofObject: maybeMarriedContext withValue: anOop. - index = StackPointerIndex ifTrue: - [self ensureContextIsExecutionSafeAfterAssignToStackPointer: maybeMarriedContext]]. - onCurrentPage - ifTrue: - [self setStackPointersFromPage: stackPage] - ifFalse: - [stackPages markStackPageMostRecentlyUsed: stackPage]. - stackPages assert: stackPage = stackPages mostRecentlyUsedPage. - stackPages assert: stackPages pageListIsWellFormed. - stackPages assert: self validStackPageBaseFrames -] - -{ #category : #'primitive support' } -StackInterpreter >> externalQuickPrimitiveResponse [ - "Invoke a quick primitive. - Called under the assumption that primFunctionPtr has been preloaded" - - | localPrimIndex | - self assert: self isPrimitiveFunctionPointerAnIndex. - localPrimIndex := self cCoerceSimple: primitiveFunctionPointer to: #sqInt. - self assert: (localPrimIndex > 255 and: [localPrimIndex < 520]). - "Quick return inst vars" - localPrimIndex >= 264 ifTrue: - [self pop: 1 thenPush: (objectMemory fetchPointer: localPrimIndex - 264 ofObject: self stackTop). - ^true]. - "Quick return constants" - localPrimIndex = 256 ifTrue: [^true "return self"]. - localPrimIndex = 257 ifTrue: [self pop: 1 thenPush: objectMemory trueObject. ^true]. - localPrimIndex = 258 ifTrue: [self pop: 1 thenPush: objectMemory falseObject. ^true]. - localPrimIndex = 259 ifTrue: [self pop: 1 thenPush: objectMemory nilObject. ^true]. - self pop: 1 thenPush: (objectMemory integerObjectOf: localPrimIndex - 261). - ^true -] - -{ #category : #'frame access' } -StackInterpreter >> externalSetStackPageAndPointersForSuspendedContextOfProcess: aProcess [ - "Set stackPage, instructionPointer, framePointer and stackPointer for the suspendedContext of - aProcess, marrying the context if necessary, and niling the suspendedContext slot. This is used - on process switch to ensure a context has a stack frame and so can continue execution." - | newContext theFrame thePage newPage | - - - - - - newContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess. - self assert: (objectMemory isContext: newContext). - (self isMarriedOrWidowedContext: newContext) ifTrue: - [self assert: (self checkIsStillMarriedContext: newContext currentFP: framePointer)]. - objectMemory - storePointerUnchecked: SuspendedContextIndex - ofObject: aProcess - withValue: objectMemory nilObject. - (self isStillMarriedContext: newContext) - ifTrue: - [theFrame := self frameOfMarriedContext: newContext. - thePage := stackPages stackPageFor: theFrame. - theFrame ~= thePage headFP ifTrue: - ["explicit assignment of suspendedContext can cause switch to interior frame." - newPage := stackPages newStackPage. - self moveFramesIn: thePage - through: (self findFrameAbove: theFrame inPage: thePage) - toPage: newPage. - stackPages markStackPageLeastMostRecentlyUsed: newPage]. - self assert: thePage headFP = theFrame] - ifFalse: - [thePage := self makeBaseFrameFor: newContext. - theFrame := thePage baseFP]. - self setStackPageAndLimit: thePage. - self setStackPointersFromPage: thePage. - (self isMachineCodeFrame: framePointer) ifFalse: - [self setMethod: (self iframeMethod: framePointer)]. - instructionPointer := self popStack. - self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer -] - -{ #category : #'stack pages' } -StackInterpreter >> externalWriteBackHeadFramePointers [ - self assert: (framePointer - stackPointer) < (LargeContextSlots * objectMemory bytesPerOop). - self assert: stackPage = stackPages mostRecentlyUsedPage. - self deny: stackPage isFree. - self setHeadFP: framePointer andSP: stackPointer inPage: stackPage. - self assert: stackPages pageListIsWellFormed -] - -{ #category : #utilities } -StackInterpreter >> externalizeFPandSP [ - "Copy the frame and stack pointers to global variables for use in primitives and other functions outside the interpret loop." - self assert: (stackPointer < stackPage baseAddress - and: [stackPointer > (stackPage realStackLimit - (LargeContextSlots * objectMemory bytesPerOop))]). -] - -{ #category : #utilities } -StackInterpreter >> externalizeIPandSP [ - "Copy the local instruction, stack and frame pointers to global variables for use in primitives and other functions outside the interpret loop." -] - -{ #category : #'primitive support' } -StackInterpreter >> failUnbalancedPrimitive [ - "not inlined for breakpoint value..." - - self primitiveFailFor: PrimErrBadNumArgs -] - -{ #category : #utilities } -StackInterpreter >> fetchArray: fieldIndex ofObject: objectPointer [ - "Fetch the instance variable at the given index of the given object. Return the address of first indexable field of resulting array object, or fail if the instance variable does not contain an indexable bytes or words object." - "Note: May be called by translated primitive code." - - | arrayOop | - - arrayOop := objectMemory fetchPointer: fieldIndex ofObject: objectPointer. - ^ self arrayValueOf: arrayOop - -] - -{ #category : #'interpreter shell' } -StackInterpreter >> fetchByte [ - "This method uses the preIncrement builtin function which has no Smalltalk equivalent. Thus, it must be overridden in the simulator." - - ^objectMemory byteAtPointer: instructionPointer preIncrement -] - -{ #category : #utilities } -StackInterpreter >> fetchFloat: fieldIndex ofObject: objectPointer [ - "Fetch the instance variable at the given index of the given object. Return the C double precision floating point value of that instance variable, or fail if it is not a Float." - "Note: May be called by translated primitive code." - - | floatOop | - - floatOop := objectMemory fetchPointer: fieldIndex ofObject: objectPointer. - ^objectMemory floatValueOf: floatOop -] - -{ #category : #utilities } -StackInterpreter >> fetchInteger: fieldIndex ofObject: objectPointer [ - "Note: May be called by translated primitive code." - - | intOop | +{ #category : #utilities } +StackInterpreter >> fetchFloat: fieldIndex ofObject: objectPointer [ + "Fetch the instance variable at the given index of the given object. Return the C double precision floating point value of that instance variable, or fail if it is not a Float." + "Note: May be called by translated primitive code." + + | floatOop | + + floatOop := objectMemory fetchPointer: fieldIndex ofObject: objectPointer. + ^objectMemory floatValueOf: floatOop +] + +{ #category : #utilities } +StackInterpreter >> fetchInteger: fieldIndex ofObject: objectPointer [ + "Note: May be called by translated primitive code." + + | intOop | intOop := objectMemory fetchPointer: fieldIndex ofObject: objectPointer. ^self checkedIntegerValueOf: intOop @@ -6152,26 +6036,59 @@ StackInterpreter >> findMethodWithPrimitive: primitive FromFP: startFP UpToConte { #category : #'message sending' } StackInterpreter >> findNewMethodInClassTag: classTagArg [ - "Find the compiled method to be run when the current - messageSelector is sent to the given class, setting the values - of 'newMethod' and 'primitiveIndex'." - | ok classTag | + "Find the compiled method to be run when the current messageSelector is + sent to the given classTag, setting the values of newMethod and primitiveIndex." + - ok := self lookupInMethodCacheSel: messageSelector classTag: classTagArg. - ok ifFalse: "entry was not found in the cache; look it up the hard way " - [classTag := classTagArg. - ((objectMemory isOopForwarded: messageSelector) - or: [objectMemory isForwardedClassTag: classTag]) ifTrue: - [(objectMemory isOopForwarded: messageSelector) ifTrue: - [messageSelector := self handleForwardedSelectorFaultFor: messageSelector]. - (objectMemory isForwardedClassTag: classTag) ifTrue: - [classTag := self handleForwardedSendFaultForTag: classTag]. - ok := self lookupInMethodCacheSel: messageSelector classTag: classTag. - ok ifTrue: - [^nil]]. - lkupClass := objectMemory classForClassTag: classTag. - self lookupMethodInClass: lkupClass. - self addNewMethodToCache: lkupClass] + self findNewMethodInClassTag: classTagArg ifFound: [ nil ] +] + +{ #category : #'message sending' } +StackInterpreter >> findNewMethodInClassTag: classTagArg ifFound: aBlock [ + "Find the compiled method to be run when the current messageSelector is + sent to the given classTag, setting the values of newMethod and primitiveIndex." + + + | classTag | + classTag := classTagArg. + (self inlineLookupInMethodCacheSel: messageSelector classTag: classTag) + ifFalse: [ + "Entry was not found in the cache; perhaps something was forwarded. + Resolve forwarders and retry" + ((objectMemory isOopForwarded: messageSelector) or: [ + objectMemory isForwardedClassTag: classTag ]) ifTrue: [ + (objectMemory isOopForwarded: messageSelector) ifTrue: [ + messageSelector := self handleForwardedSelectorFaultFor: + messageSelector ]. + (objectMemory isForwardedClassTag: classTag) ifTrue: [ + classTag := self handleForwardedSendFaultForTag: classTag ]. + (self lookupInMethodCacheSel: messageSelector classTag: classTag) + ifTrue: [ ^ aBlock value ] ]. + + "Entry was not found in the cache; look it up the hard way " + lkupClass := objectMemory classForClassTag: classTag. + (objectMemory isOopForwarded: lkupClass) ifTrue: [ + lkupClass := objectMemory followForwarded: lkupClass ]. + self lookupMethodInClass: lkupClass. + self addNewMethodToCache: lkupClass ] + ifTrue: [ aBlock value ] +] + +{ #category : #'message sending' } +StackInterpreter >> findNewMethodOrdinary [ + "Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'." + + + ^ self findNewMethodOrdinaryIfFound: [ nil ] +] + +{ #category : #'message sending' } +StackInterpreter >> findNewMethodOrdinaryIfFound: aBlock [ + "Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'." + + | classTag | + classTag := lkupClassTag. + ^ self findNewMethodInClassTag: lkupClassTag ifFound: aBlock ] { #category : #'frame access' } @@ -6646,7 +6563,7 @@ StackInterpreter >> followForwardingPointersInStackZone: theBecomeEffectsFlags [ self cCode: [] inSmalltalk: [stackPages allPagesFree]. ^self]. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue: [(objectMemory isForwarded: method) ifTrue: @@ -6677,12 +6594,12 @@ StackInterpreter >> followForwardingPointersInStackZone: theBecomeEffectsFlags [ [stackPages unsignedLongAt: theFP + FoxThisContext put: (objectMemory followForwarded: (self frameContext: theFP))]. - oop := self frameMethod: theFP. + oop := self iframeMethod: theFP. (objectMemory isForwarded: oop) ifTrue: [| newOop delta | newOop := objectMemory followForwarded: oop. theIPPtr ~= 0 ifTrue: - [self assert: (stackPages unsignedLongAt: theIPPtr) > (self frameMethod: theFP). + [self assert: (stackPages unsignedLongAt: theIPPtr) > (self iframeMethod: theFP). delta := newOop - oop. stackPages unsignedLongAt: theIPPtr @@ -6724,6 +6641,17 @@ StackInterpreter >> followSemaphoreIn: anArray at: index [ objectMemory storePointer: index ofObject: anArray withValue: obj] ] +{ #category : #'process primitive support' } +StackInterpreter >> forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter [ + "Do a returnToExecutive: inInterpreter postContextSwitch: true for a process primtive + being sure to sample the profile clock before making the switch." + + "If we are profiling, take accurate primitive measures" + nextProfileTick > 0 ifTrue: + [self checkProfileTick: newMethod]. + ^self returnToExecutive: inInterpreter postContextSwitch: true +] + { #category : #'process primitive support' } StackInterpreter >> forceInterruptCheck [ "Force an interrupt check ASAP. @@ -6839,9 +6767,10 @@ StackInterpreter >> frameLastArgumentOffset [ ] { #category : #'frame access' } -StackInterpreter >> frameMethod: theFP [ +StackInterpreter >> frameMethodField: theFP [ + ^stackPages unsignedLongAt: theFP + FoxMethod ] @@ -7399,12 +7328,10 @@ StackInterpreter >> ifAppropriateCompileToNativeCode: aMethodObj selector: selec { #category : #'jump bytecodes' } StackInterpreter >> ifBackwardsCheckForEvents: offset [ "Backward jump means we're in a loop; check for possible interrupts." + - (offset < 0 - and: [stackPointer < stackLimit]) ifTrue: - [self externalizeIPandSP. - self checkForEventsMayContextSwitch: true. - self internalizeIPandSP] + (offset < 0 and: [ stackPointer < stackLimit ]) ifTrue: [ + self checkForEventsMayContextSwitch: true ] ] { #category : #'stack pages' } @@ -7472,6 +7399,21 @@ StackInterpreter >> iframeMethod: theFP [ ^stackPages unsignedLongAt: theFP + FoxMethod ] +{ #category : #'frame access' } +StackInterpreter >> iframeNumArgs: theFP [ + "See encodeFrameFieldHasContext:numArgs:" + + + ^self frameNumArgs: theFP +] + +{ #category : #'internal interpreter access' } +StackInterpreter >> iframeReceiverLocation: theFP [ + + + ^theFP + FoxReceiver +] + { #category : #'image save/restore' } StackInterpreter >> imageFormatVersion [ @@ -7525,7 +7467,7 @@ StackInterpreter >> initStackPageGC [ "Need to write back the frame pointers unless all pages are free (as in snapshot)" stackPage ~= 0 ifTrue: - [self externalWriteBackHeadFramePointers]. + [self writeBackHeadFramePointers]. 0 to: numStackPages - 1 do: [:i| | thePage | @@ -7630,7 +7572,6 @@ StackInterpreter >> initialize [ statForceInterruptCheck := statStackOverflow := statCheckForEvents := statProcessSwitch := statStackPageDivorce := statIdleUsecs := 0. - messageCount := 0. imageVersionNumber := 0. ] @@ -7764,71 +7705,76 @@ StackInterpreter >> instVar: offset ofContext: aContext [ "Fetch an instance variable from a maybe married context. If the context is still married compute the value of the relevant inst var from the spouse frame's state." - | spouseFP | - - - self assert: offset < MethodIndex. - self assert: (objectMemory isContext: aContext). - (self isMarriedOrWidowedContext: aContext) ifFalse: - [^objectMemory fetchPointer: offset ofObject: aContext]. + "Fetch an instance variable from a maybe married context. + If the context is still married compute the value of the + relevant inst var from the spouse frame's state." + - self writeBackHeadFramePointers. - (self isWidowedContext: aContext) ifTrue: - [^objectMemory fetchPointer: offset ofObject: aContext]. + self assert: (objectMemory isContext: aContext). + self assert: offset <= (ReceiverIndex + (self checkStackPointerForMaybeMarriedContext: aContext)). - spouseFP := self frameOfMarriedContext: aContext. - offset = SenderIndex ifTrue: - [^self ensureCallerContext: spouseFP]. - offset = StackPointerIndex ifTrue: - [self assert: ReceiverIndex + (self stackPointerIndexForFrame: spouseFP) < (objectMemory lengthOf: aContext). - ^objectMemory integerObjectOf: (self stackPointerIndexForFrame: spouseFP)]. - offset = InstructionPointerIndex ifTrue: - [^self instructionPointerForFrame: spouseFP currentFP: framePointer currentIP: (self oopForPointer: instructionPointer)]. - self error: 'bad index'. - ^0 + "method, closureOrNil & receiver need no special handling; only + sender, pc & stackp have to be computed for married contexts." + (self isReadMediatedContextInstVarIndex: offset) ifTrue: + [self writeBackHeadFramePointers. + (self isStillMarriedContext: aContext) ifTrue: + [^self fetchPointer: offset ofMarriedContext: aContext]]. + + ^objectMemory fetchPointer: offset ofObject: aContext ] { #category : #'frame access' } StackInterpreter >> instVar: index ofContext: aMarriedContext put: anOop [ + + | theFP | "Assign the field of a married context. The important case to optimize is assigning the sender. We could also consider optimizing assigning the IP but typically that is followed by an assignment to the stack pointer and we can't efficiently assign the stack pointer because it involves moving frames around." - self assert: (self isMarriedOrWidowedContext: aMarriedContext). self deny: (objectMemory isObjImmutable: aMarriedContext). self writeBackHeadFramePointers. - (self isStillMarriedContext: aMarriedContext) ifFalse: - [objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop. - index = StackPointerIndex ifTrue: - [self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext]. - ^nil]. + (self isStillMarriedContext: aMarriedContext) ifFalse: [ + objectMemory + storePointer: index + ofObject: aMarriedContext + withValue: anOop. + index = StackPointerIndex ifTrue: [ + self ensureContextIsExecutionSafeAfterAssignToStackPointer: + aMarriedContext ]. + ^ nil ]. theFP := self frameOfMarriedContext: aMarriedContext. - index = SenderIndex ifTrue: - [| thePage onCurrentPage | - thePage := stackPages stackPageFor: theFP. - self assert: stackPage = stackPages mostRecentlyUsedPage. - onCurrentPage := thePage = stackPage. - self storeSenderOfFrame: theFP withValue: anOop. - onCurrentPage - ifTrue: - [framePointer := stackPage headFP. - stackPointer := stackPage headSP] - ifFalse: - [stackPages markStackPageMostRecentlyUsed: stackPage]. - ^nil]. - self externalizeIPandSP. - self externalDivorceFrame: theFP andContext: aMarriedContext. - (self is: index methodAssignmentToContextWithMachineCodePC: aMarriedContext) ifTrue: - [self ensureContextHasBytecodePC: aMarriedContext]. - objectMemory storePointer: index ofObject: aMarriedContext withValue: anOop. - index = StackPointerIndex ifTrue: - [self ensureContextIsExecutionSafeAfterAssignToStackPointer: aMarriedContext]. - self internalizeIPandSP. + index = SenderIndex ifTrue: [ + | thePage onCurrentPage | + thePage := stackPages stackPageFor: theFP. + self assert: stackPage = stackPages mostRecentlyUsedPage. + onCurrentPage := thePage = stackPage. + self storeSenderOfFrame: theFP withValue: anOop. + onCurrentPage + ifTrue: [ self setStackPointersFromPage: stackPage ] + ifFalse: [ stackPages markStackPageMostRecentlyUsed: stackPage ]. + ^ nil ]. + self divorceFrame: theFP andContext: aMarriedContext. + (self + is: index + methodAssignmentToContextWithMachineCodePC: aMarriedContext) + ifTrue: [ self ensureContextHasBytecodePC: aMarriedContext ]. + objectMemory + storePointer: index + ofObject: aMarriedContext + withValue: anOop. + index = StackPointerIndex ifTrue: [ + self ensureContextIsExecutionSafeAfterAssignToStackPointer: + aMarriedContext ]. "Assigning various fields can force a divorce which can change the stackPage." stackPages markStackPageMostRecentlyUsed: stackPage. - self assertValidExecutionPointe: instructionPointer asUnsignedInteger r: framePointer s: stackPointer imbar: true line: #'__LINE__' + self + assertValidExecutionPointe: instructionPointer asUnsignedInteger + r: framePointer + s: stackPointer + imbar: true + line: #__LINE__ ] { #category : #'indexing primitive support' } @@ -7924,112 +7870,6 @@ StackInterpreter >> internalAboutToReturn: resultOop through: aContext [ ^self normalSend ] -{ #category : #'message sending' } -StackInterpreter >> internalActivateNewMethod [ - - - | methodHeader numTemps rcvr | - methodHeader := objectMemory methodHeaderOf: newMethod. - numTemps := self temporaryCountOfMethodHeader: methodHeader. - self assert: - argumentCount = (self argumentCountOfMethodHeader: methodHeader). - rcvr := self stackValue: argumentCount. "could new rcvr be set at point of send?" - self assert: (objectMemory isOopForwarded: rcvr) not. - - self push: instructionPointer. - self push: framePointer. - framePointer := stackPointer. - self push: newMethod. - self setMethod: newMethod methodHeader: methodHeader. - self push: objectMemory nilObject. "FxThisContext field" - self push: (self - encodeFrameFieldHasContext: false - isBlock: false - numArgs: (self argumentCountOfMethodHeader: methodHeader)). - self push: rcvr. - - "Initialize temps..." - argumentCount + 1 to: numTemps do: [ :i | - self push: objectMemory nilObject ]. - - "-1 to account for pre-increment in fetchNextBytecode" - instructionPointer := self pointerForOop: - (self initialIPForHeader: methodHeader method: newMethod) - - 1. - - (self methodHeaderHasPrimitive: methodHeader) ifTrue: [ "Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts - with a long store temp. Strictly no need to skip the store because it's effectively a noop." - instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader). - primFailCode ~= 0 ifTrue: [ | shouldSkipStoreBytecode | - shouldSkipStoreBytecode := self reapAndResetErrorCodeTo: framePointer header: methodHeader. - shouldSkipStoreBytecode ifTrue: [ - instructionPointer := instructionPointer + (self sizeOfLongStoreTempBytecode: methodHeader) ] ] ]. - - self assert: (self frameNumArgs: framePointer) = argumentCount. - self assert: (self frameIsBlockActivation: framePointer) not. - self assert: (self frameHasContext: framePointer) not. - - "Now check for stack overflow or an event (interrupt, must scavenge, etc)." - stackPointer < stackLimit ifTrue: [ - self externalizeIPandSP. - self handleStackOverflowOrEventAllowContextSwitch: - (self canContextSwitchIfActivating: newMethod header: methodHeader). - self internalizeIPandSP ] -] - -{ #category : #'return bytecodes' } -StackInterpreter >> internalCannotReturn: resultOop [ - | ourContext | - - ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer. - self push: ourContext. - self push: resultOop. - messageSelector := objectMemory splObj: SelectorCannotReturn. - argumentCount := 1. - ^self normalSend -] - -{ #category : #'message sending' } -StackInterpreter >> internalExecuteNewMethod [ - - - | succeeded | - primitiveFunctionPointer ~= 0 ifTrue: [ - self isPrimitiveFunctionPointerAnIndex ifTrue: [ - self internalQuickPrimitiveResponse. - ^ self "keep slang happy" ]. - self externalizeIPandSP. - succeeded := self slowPrimitiveResponse. - self internalizeIPandSP. - succeeded ifTrue: [ ^ self ] ]. - "if not primitive, or primitive failed, activate the method" - ^ self internalActivateNewMethod -] - -{ #category : #'message sending' } -StackInterpreter >> internalFindNewMethodOrdinary [ - "Find the compiled method to be run when the current messageSelector is sent to the class 'lkupClass', setting the values of 'newMethod' and 'primitiveIndex'." - - (self inlineLookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifFalse: - ["entry was not found in the cache; look it up the hard way" - self externalizeIPandSP. - ((objectMemory isOopForwarded: messageSelector) - or: [objectMemory isForwardedClassTag: lkupClassTag]) ifTrue: - [(objectMemory isOopForwarded: messageSelector) ifTrue: - [messageSelector := self handleForwardedSelectorFaultFor: messageSelector]. - (objectMemory isForwardedClassTag: lkupClassTag) ifTrue: - [lkupClassTag := self handleForwardedSendFaultForTag: lkupClassTag]. - (self lookupInMethodCacheSel: messageSelector classTag: lkupClassTag) ifTrue: - [^nil]]. - lkupClass := objectMemory classForClassTag: lkupClassTag. - (objectMemory isOopForwarded: lkupClass) ifTrue: - [lkupClass := objectMemory followForwarded: lkupClass]. - self lookupMethodInClass: lkupClass. - self internalizeIPandSP. - self addNewMethodToCache: lkupClass]. - -] - { #category : #'return bytecodes' } StackInterpreter >> internalMustBeBoolean [ @@ -8038,46 +7878,6 @@ StackInterpreter >> internalMustBeBoolean [ self normalSend ] -{ #category : #'primitive support' } -StackInterpreter >> internalQuickPrimitiveResponse [ - - "Invoke a quick primitive. - Called under the assumption that primFunctionPtr has been preloaded" - - | localPrimIndex | - self assert: self isPrimitiveFunctionPointerAnIndex. - localPrimIndex := self - cCoerceSimple: primitiveFunctionPointer - to: #sqInt. - self assert: (localPrimIndex > 255 and: [ localPrimIndex < 520 ]). - "Quick return inst vars" - localPrimIndex >= 264 ifTrue: [ - self stackTopPut: (objectMemory - fetchPointer: localPrimIndex - 264 - ofObject: self stackTop). - ^ true ]. - "Quick return constants" - localPrimIndex = 256 ifTrue: [ ^ true "return self" ]. - localPrimIndex = 257 ifTrue: [ - self stackTopPut: objectMemory trueObject. - ^ true ]. - localPrimIndex = 258 ifTrue: [ - self stackTopPut: objectMemory falseObject. - ^ true ]. - localPrimIndex = 259 ifTrue: [ - self stackTopPut: objectMemory nilObject. - ^ true ]. - self stackTopPut: - (objectMemory integerObjectOf: localPrimIndex - 261). - ^ true -] - -{ #category : #utilities } -StackInterpreter >> internalizeIPandSP [ - "Copy the instruction, stack and frame pointers to local variables for rapid access within the interpret loop." - stackPointer := self pointerForOop: stackPointer -] - { #category : #'interpreter shell' } StackInterpreter >> interpret [ "This is the main interpreter loop. It normally loops forever, fetching and executing bytecodes. When running in the context of a browser plugin VM, however, it must return control to the browser periodically. This should done only when the state of the currently running Squeak thread is safely stored in the object heap. Since this is the case at the moment that a check for interrupts is performed, that is when we return to the browser if it is time to do so. Interrupt checks happen quite frequently." @@ -8090,12 +7890,10 @@ StackInterpreter >> interpret [ stackLimit = 0 ifTrue: [^self initStackPagesAndInterpret]. - self internalizeIPandSP. self initExtensions. self fetchNextBytecode. [true] whileTrue: [self dispatchOn: currentBytecode in: BytecodeTable]. instructionPointer := instructionPointer - 1. "undo the pre-increment of IP before returning" - self externalizeIPandSP. ^nil ] @@ -8110,14 +7908,13 @@ StackInterpreter >> interpretUntilReturn [ StackInterpreter >> interpretWhile: aFullBlockClosure [ - self internalizeIPandSP. self fetchNextBytecode. [aFullBlockClosure value] whileTrue: [self dispatchCurrentBytecode. self incrementByteCount]. - instructionPointer := instructionPointer - 1. "undo the pre-increment of IP before returning" - self externalizeIPandSP + instructionPointer := instructionPointer - 1. + ] { #category : #'stack pages' } @@ -8338,6 +8135,12 @@ StackInterpreter >> isFrame: aFrame onPage: aPage [ ^false ] +{ #category : #'message sending' } +StackInterpreter >> isInstructionPointerInInterpreter: anInstructionPointer [ + + ^ true +] + { #category : #'internal interpreter access' } StackInterpreter >> isKindOfInteger: oop [ "Answer true if the oop is kind of Integer (Small or Large)." @@ -8580,6 +8383,33 @@ StackInterpreter >> isWriteMediatedContextInstVarIndex: index [ ^index <= ReceiverIndex ] +{ #category : #'internal interpreter access' } +StackInterpreter >> itemporary: offset in: theFP [ + + + + | frameNumArgs | + ^ offset < (frameNumArgs := self iframeNumArgs: theFP) + ifTrue: [ + stackPages unsignedLongAt: theFP + FoxCallerSavedIP + + (frameNumArgs - offset * objectMemory wordSize) ] + ifFalse: [ + stackPages unsignedLongAt: + (self iframeReceiverLocation: theFP) - objectMemory wordSize + + (frameNumArgs - offset * objectMemory wordSize) ] +] + +{ #category : #'internal interpreter access' } +StackInterpreter >> itemporary: offset in: theFP put: valueOop [ + "See StackInterpreter class>>initializeFrameIndices" + | frameNumArgs | + + + ^offset < (frameNumArgs := self iframeNumArgs: theFP) + ifTrue: [stackPages unsignedLongAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory wordSize) put: valueOop] + ifFalse: [stackPages unsignedLongAt: (self iframeReceiverLocation: theFP) - objectMemory wordSize + ((frameNumArgs - offset) * objectMemory wordSize) put: valueOop] +] + { #category : #'jump bytecodes' } StackInterpreter >> jump: offset [ @@ -8732,10 +8562,11 @@ StackInterpreter >> jumplfTrueBy: offset [ { #category : #'message sending' } StackInterpreter >> justActivateNewMethod: mustBeInterpreterFrame [ - | methodHeader numArgs numTemps rcvr | + - "Create the frame for the method activation" + | methodHeader numArgs numTemps rcvr | methodHeader := objectMemory methodHeaderOf: newMethod. + "Create the frame for the method activation" numTemps := self temporaryCountOfMethodHeader: methodHeader. numArgs := self argumentCountOfMethodHeader: methodHeader. @@ -8748,25 +8579,44 @@ StackInterpreter >> justActivateNewMethod: mustBeInterpreterFrame [ self push: newMethod. self setMethod: newMethod methodHeader: methodHeader. self push: objectMemory nilObject. "FxThisContext field" - self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs). + self push: (self + encodeFrameFieldHasContext: false + isBlock: false + numArgs: numArgs). self push: rcvr. - "clear remaining temps to nil" - numArgs+1 to: numTemps do: - [:i | self push: objectMemory nilObject]. + "Initialize temps to nil" + numArgs + 1 to: numTemps do: [ :i | + self push: objectMemory nilObject ]. - instructionPointer := (self initialIPForHeader: methodHeader method: newMethod) - 1. + "-1 to account for pre-increment in fetchNextBytecode" + instructionPointer := self pointerForOop: + (self + initialIPForHeader: methodHeader + method: newMethod) - 1. - (self methodHeaderHasPrimitive: methodHeader) ifTrue: - ["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts + (self methodHeaderHasPrimitive: methodHeader) ifTrue: [ "Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts with a long store temp. Strictly no need to skip the store because it's effectively a noop." - instructionPointer := instructionPointer + (self sizeOfCallPrimitiveBytecode: methodHeader). - primFailCode ~= 0 ifTrue: [ | shouldSkipStoreBytecode | - shouldSkipStoreBytecode := self reapAndResetErrorCodeTo: framePointer header: methodHeader. - shouldSkipStoreBytecode ifTrue: [ - instructionPointer := instructionPointer + (self sizeOfLongStoreTempBytecode: methodHeader) ] ] ]. + instructionPointer := instructionPointer + + + (self sizeOfCallPrimitiveBytecode: + methodHeader). + primFailCode ~= 0 ifTrue: [ + | shouldSkipStoreBytecode | + shouldSkipStoreBytecode := self + reapAndResetErrorCodeTo: framePointer + header: methodHeader. + shouldSkipStoreBytecode ifTrue: [ + instructionPointer := instructionPointer + + + (self sizeOfLongStoreTempBytecode: + methodHeader) ] ] ]. + + self assert: (self frameNumArgs: framePointer) = argumentCount. + self assert: (self frameIsBlockActivation: framePointer) not. + self assert: (self frameHasContext: framePointer) not. - ^methodHeader + ^ methodHeader ] { #category : #'debug printing' } @@ -8989,7 +8839,7 @@ StackInterpreter >> longPushTemporaryVariableBytecode [ | index | index := self fetchByte. self fetchNextBytecode. - self push: (self temporary: index in: framePointer) + self push: (self itemporary: index in: framePointer) ] { #category : #'stack bytecodes' } @@ -9019,7 +8869,7 @@ StackInterpreter >> longStoreTemporaryVariableBytecode [ | index | index := self fetchByte. self fetchNextBytecode. - self temporary: index in: framePointer put: self stackTop + self itemporary: index in: framePointer put: self stackTop ] { #category : #'jump bytecodes' } @@ -9297,7 +9147,7 @@ StackInterpreter >> makeBaseFrameFor: aContext [ "" numArgs + 1 to: stackPtrIndex do: [:i| stackPages - unsignedLongAt: (pointer := pointer - objectMemory wordSize) + longAt: (pointer := pointer - objectMemory wordSize) put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)]. "top of stack is the instruction pointer" theIP := self iframeInstructionPointerForIndex: theIP method: theMethod. @@ -9406,63 +9256,81 @@ StackInterpreter >> mapProfileState [ { #category : #'object memory support' } StackInterpreter >> mapStackPages [ + + | numLivePages | numLivePages := 0. - 0 to: numStackPages - 1 do: - [:i| | thePage theSP theFP callerFP theIPPtr theIP oop | + 0 to: numStackPages - 1 do: [ :i | + | thePage theSP theFP frameRcvrOffset callerFP theIPPtr theIP oop | thePage := stackPages stackPageAt: i. - thePage isFree ifFalse: - [self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage). - numLivePages := numLivePages + 1. - theSP := thePage headSP. - theFP := thePage headFP. - "Skip the instruction pointer on top of stack of inactive pages." - thePage = stackPage - ifTrue: [theIPPtr := 0] - ifFalse: - [theIPPtr := theSP. - theSP := theSP + objectMemory wordSize]. - [self assert: (thePage addressIsInPage: theFP). - self assert: (thePage addressIsInPage: theSP). - self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]). - [theSP <= (theFP + FoxReceiver)] whileTrue: - [oop := stackPages unsignedLongAt: theSP. - (objectMemory shouldRemapOop: oop) ifTrue: - [stackPages unsignedLongAt: theSP put: (objectMemory remapObj: oop)]. - theSP := theSP + objectMemory wordSize]. - (self frameHasContext: theFP) ifTrue: - [(objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue: - [stackPages + thePage isFree ifFalse: [ + self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage). + numLivePages := numLivePages + 1. + theSP := thePage headSP. + theFP := thePage headFP. + "Skip the instruction pointer on top of stack of inactive pages." + thePage = stackPage + ifTrue: [ theIPPtr := 0 ] + ifFalse: [ + theIPPtr := theSP. + theSP := theSP + objectMemory wordSize ]. + [ + self assert: (thePage addressIsInPage: theFP). + self assert: (thePage addressIsInPage: theSP). + self assert: + (theIPPtr = 0 or: [ thePage addressIsInPage: theIPPtr ]). + frameRcvrOffset := self frameReceiverLocation: theFP. + [ theSP <= frameRcvrOffset ] whileTrue: [ + oop := stackPages unsignedLongAt: theSP. + (objectMemory shouldRemapOop: oop) ifTrue: [ + stackPages + unsignedLongAt: theSP + put: (objectMemory remapObj: oop) ]. + theSP := theSP + objectMemory wordSize ]. + (self frameHasContext: theFP) ifTrue: [ + (objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue: [ + stackPages unsignedLongAt: theFP + FoxThisContext - put: (objectMemory remapObj: (self frameContext: theFP))]. - "With SpurPlanningCompactor can't assert since object body is yet to move." - (objectMemory slidingCompactionInProgress not) ifTrue: - [self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP)) - and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]]. - (objectMemory shouldRemapObj: (self frameMethod: theFP)) ifTrue: - [theIPPtr ~= 0 ifTrue: - [self assert: (stackPages unsignedLongAt: theIPPtr) > (self frameMethod: theFP). - theIP := (stackPages unsignedLongAt: theIPPtr) - (self frameMethod: theFP)]. - stackPages + put: (objectMemory remapObj: (self frameContext: theFP)) ]. + "With SpurPlanningCompactor can't assert since object body is yet to move." + objectMemory slidingCompactionInProgress not ifTrue: [ + self assert: + ((self isMarriedOrWidowedContext: (self frameContext: theFP)) + and: [ + (self frameOfMarriedContext: (self frameContext: theFP)) + = theFP ]) ] ]. + (objectMemory shouldRemapObj: (self iframeMethod: theFP)) ifTrue: [ + theIPPtr ~= 0 ifTrue: [ + self assert: + (stackPages unsignedLongAt: theIPPtr) + > (self iframeMethod: theFP). + theIP := (stackPages unsignedLongAt: theIPPtr) + - (self iframeMethod: theFP) ]. + stackPages unsignedLongAt: theFP + FoxMethod - put: (objectMemory remapObj: (self frameMethod: theFP)). - theIPPtr ~= 0 ifTrue: - [stackPages unsignedLongAt: theIPPtr put: theIP + (self frameMethod: theFP)]]. - (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: - [theSP := (theIPPtr := theFP + FoxCallerSavedIP) + objectMemory wordSize. - theFP := callerFP]. - theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP" - [theSP <= thePage baseAddress] whileTrue: - [oop := stackPages unsignedLongAt: theSP. - (objectMemory shouldRemapOop: oop) ifTrue: - [stackPages unsignedLongAt: theSP put: (objectMemory remapObj: oop)]. - theSP := theSP + objectMemory wordSize]]]. + put: (objectMemory remapObj: (self iframeMethod: theFP)). + theIPPtr ~= 0 ifTrue: [ + stackPages + unsignedLongAt: theIPPtr + put: theIP + (self iframeMethod: theFP) ] ]. + (callerFP := self frameCallerFP: theFP) ~= 0 ] whileTrue: [ + theSP := (theIPPtr := theFP + FoxCallerSavedIP) + + objectMemory wordSize. + theFP := callerFP ]. + theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP" + [ theSP <= thePage baseAddress ] whileTrue: [ + oop := stackPages unsignedLongAt: theSP. + (objectMemory shouldRemapOop: oop) ifTrue: [ + stackPages + unsignedLongAt: theSP + put: (objectMemory remapObj: oop) ]. + theSP := theSP + objectMemory wordSize ] ] ]. stackPages recordLivePagesOnMapping: numLivePages ] @@ -9515,12 +9383,11 @@ StackInterpreter >> mappedDirectCall [ argumentCount := self argumentCountOfMethodHeader: methodHeader. "The primitive function pointer is not cached in the interpreter, but it's called quickly in the JIT" primitiveFunctionPointer := self functionPointerFor: localPrimIndex inClass: objectMemory nilObject.. - self internalActivateNewMethod + self activateNewMethod ] { #category : #'sista bytecodes' } StackInterpreter >> mappedEnsureEnoughWords [ - "50 EnsureEnoughWords literal which is a Smi => ret value is receiver" @@ -9530,10 +9397,7 @@ StackInterpreter >> mappedEnsureEnoughWords [ slots := objectMemory integerValueOf: top. self assert: slots >= 0. ok := objectMemory checkForAvailableSlots: slots. - ok ifFalse: [ - self externalizeIPandSP. - self checkForEventsMayContextSwitch: true. - self internalizeIPandSP ] + ok ifFalse: [ self checkForEventsMayContextSwitch: true ] ] { #category : #'sista bytecodes' } @@ -9599,7 +9463,6 @@ StackInterpreter >> mappedImmcheckDataAtPut: primIndex [ { #category : #'sista bytecodes' } StackInterpreter >> mappedImmcheckMaybeContextStoreCheckPointerAtPut [ - "153 immCheckMaybeContextStoreCheckPointerAt:put: pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)" @@ -9612,15 +9475,13 @@ StackInterpreter >> mappedImmcheckMaybeContextStoreCheckPointerAtPut [ self pop: 3. self push: result. (self isWriteMediatedContextInstVarIndex: argIntAdjusted) - ifFalse: [ + ifFalse: [ objectMemory storePointerImmutabilityCheck: argIntAdjusted ofObject: rec withValue: result ] - ifTrue: [ - self externalizeIPandSP. - self externalInstVar: argIntAdjusted ofContext: rec put: result. - self internalizeIPandSP ] + ifTrue: [ + self instVar: argIntAdjusted ofContext: rec put: result ] ] { #category : #'sista bytecodes' } @@ -9879,7 +9740,7 @@ StackInterpreter >> marriedContext: spouseContext pointsTo: anOop stackDeltaForC (objectMemory isIntegerObject: anOop) ifTrue: "Check stack and instruction pointer fields." [(anOop = (objectMemory integerObjectOf: (self stackPointerIndexForFrame: theFP WithSP: theSP)) - or: [anOop = (self externalInstVar: InstructionPointerIndex ofContext: spouseContext)]) ifTrue: + or: [anOop = (self instVar: InstructionPointerIndex ofContext: spouseContext)]) ifTrue: [^true]] ifFalse: "Check method and sender fields, avoiding unnecessarily reifying sender context." [anOop = (self frameMethodObject: theFP) ifTrue: @@ -9935,20 +9796,34 @@ StackInterpreter >> marryFrame: theFP SP: theSP [ { #category : #'frame access' } StackInterpreter >> marryFrame: theFP SP: theSP copyTemps: copyTemps [ - "Marry an unmarried frame. This means creating a spouse context - initialized with a subset of the frame's state that references the frame. - For the default closure implementation we do not need to copy temps. - Different closure implementations may require temps to be copied." - | theContext methodHeader numSlots numArgs numStack closureOrNil numTemps | + "Marry an unmarried frame. This means creating a spouse context + initialized with a subset of the frame's state that references the frame. + For the default closure implementation we do not need to copy temps. + Different closure implementations may require temps to be copied. + + Set the ``has context'' flag appropriately for both machine code and interpreter frames" + + | theContext methodHeader closureOrNil numSlots numArgs numStack numTemps | + self assert: (self frameHasContext: theFP) not. + (self isMachineCodeFrame: theFP) + ifTrue: [ | methodFieldOrObj | + "base frames must aready be married for cannotReturn: processing" + self assert: (self isBaseFrame: theFP) not. + methodFieldOrObj := self frameMethodField: theFP. + stackPages + longAt: theFP + FoxMethod + put: methodFieldOrObj + MFMethodFlagHasContextFlag ] + ifFalse: [ self setIFrameHasContext: theFP ]. + "The SP is expected to be pointing at the last oop on the stack, not at the pc" - self assert: (objectMemory addressCouldBeOop: (stackPages unsignedLongAt: theSP)). + self assert: (objectMemory addressCouldBeOop: (objectMemory longAt: theSP)). - methodHeader := objectMemory methodHeaderOf: (self frameMethod: theFP). + methodHeader := objectMemory methodHeaderOf: (self frameMethodObject: theFP). "Decide how much of the stack to preserve in widowed contexts. Preserving too much state will potentially hold onto garbage. Holding onto too little may mean that a dead context isn't informative enough in a debugging situation. If copyTemps is false (as it @@ -9956,17 +9831,19 @@ StackInterpreter >> marryFrame: theFP SP: theSP copyTemps: copyTemps [ no temporaries. Note that we still set the stack pointer to its current value, but stack contents other than the arguments are nil." numArgs := self frameNumArgs: theFP. - numStack := self stackPointerIndexForFrame: theFP WithSP: theSP. closureOrNil := (self frameIsBlockActivation: theFP) - ifTrue: [self pushedReceiverOrClosureOfFrame: theFP] - ifFalse: [objectMemory nilObject]. + ifTrue: [ self pushedReceiverOrClosureOfFrame: theFP ] + ifFalse: [ objectMemory nilObject ]. numSlots := (self methodHeaderIndicatesLargeFrame: methodHeader) ifTrue: [LargeContextSlots] ifFalse: [SmallContextSlots]. + + numStack := self stackPointerIndexForFrame: theFP WithSP: theSP. theContext := objectMemory eeInstantiateMethodContextSlots: numSlots. - self assert: numStack + ReceiverIndex <= numSlots. + self setFrameContext: theFP to: theContext. + self assert: numStack + ReceiverIndex <= numSlots. "Mark context as married by setting its sender to the frame pointer plus SmallInteger tags and the InstructionPointer to the saved fp (which ensures correct alignment w.r.t. the frame when we check for validity)" @@ -9981,44 +9858,37 @@ StackInterpreter >> marryFrame: theFP SP: theSP copyTemps: copyTemps [ withValue: (objectMemory integerObjectOf: numStack). objectMemory storePointerUnchecked: MethodIndex ofObject: theContext - withValue: (self frameMethod: theFP). - objectMemory storePointerUnchecked: ClosureIndex ofObject: theContext withValue: closureOrNil. + withValue: (self frameMethodObject: theFP). + objectMemory storePointerUnchecked: ClosureIndex + ofObject: theContext + withValue: closureOrNil. objectMemory storePointerUnchecked: ReceiverIndex ofObject: theContext withValue: (self frameReceiver: theFP). "If copyTemps is false, store just the arguments. If the frame is divorced the context will have valid arguments but all temporaries will be nil." - 1 to: numArgs do: - [:i| + 1 to: numArgs do: [ :i | objectMemory storePointerUnchecked: ReceiverIndex + i - ofObject: theContext "inline self temporary: i - 1 in:theFP" - withValue: (stackPages unsignedLongAt: theFP - + FoxCallerSavedIP - + ((numArgs - i + 1) * objectMemory wordSize))]. - copyTemps ifTrue: - [numTemps := self frameNumTemps: theFP. - 1 to: numTemps do: - [:i| + ofObject: theContext + withValue: (self temporary: i - 1 in: theFP) ]. + copyTemps ifTrue: [ + numTemps := self frameNumTemps: theFP. + 1 to: numTemps do: [ :i | objectMemory storePointerUnchecked: ReceiverIndex + i + numArgs ofObject: theContext - withValue: (self temporary: i - 1 in: theFP)]. - numArgs := numArgs + numTemps]. + withValue: (self temporary: i - 1 in: theFP) ]. + numArgs := numArgs + numTemps ]. - numArgs + 1 to: numStack do: - [:i| + numArgs + 1 to: numStack do: [ :i | objectMemory storePointerUnchecked: ReceiverIndex + i ofObject: theContext - withValue: objectMemory nilObject]. - - self setFrameContext: theFP to: theContext. - self setFrameHasContext: theFP. + withValue: objectMemory nilObject ]. self assert: (self frameHasContext: theFP). self assert: (self frameOfMarriedContext: theContext) = theFP. self assert: numStack + ReceiverIndex < (objectMemory lengthOf: theContext). - ^theContext - + ^ theContext ] { #category : #'primitive support' } @@ -10033,7 +9903,6 @@ StackInterpreter >> maybeFailForLastObjectOverwrite [ { #category : #'cog jit support' } StackInterpreter >> maybeFixClonedCompiledMethod: objOop [ "This is a noop in the Stack VM" - ] { #category : #'compiled methods' } @@ -10158,6 +10027,12 @@ StackInterpreter >> maybeSelectorOfMethod: methodObj [ [maybeSelector] ] +{ #category : #'stack bytecodes' } +StackInterpreter >> maybeTraceBlockCreation: aBlock [ + + "Noop in the interpreter" +] + { #category : #'debug support' } StackInterpreter >> maybeTraceStackOverflow [ "nop in the stack interpreter" @@ -10320,11 +10195,6 @@ StackInterpreter >> methodUsesPrimitiveErrorCode: aMethodObj [ ofObject: aMethodObj)] ] -{ #category : #'frame access' } -StackInterpreter >> mframeCogMethod: theFP [ - self shouldNotImplement -] - { #category : #'primitive support' } StackInterpreter >> microsecondsToMilliseconds: microseconds [ @@ -10382,40 +10252,44 @@ StackInterpreter >> moveFramesIn: oldPage through: theFP toPage: newPage [ - + + "A base frame must have a context for cannotReturn: processing." + self assert: (self isBaseFrame: theFP) not. + self assert: self validStackPageBaseFrames. + callerFP := self frameCallerFP: theFP. + self assert: (self frameHasContext: callerFP). + self assert: (objectMemory isContext: (self frameContext: callerFP)). newSP := newPage baseAddress + objectMemory wordSize. stackedReceiverOffset := self frameStackedReceiverOffset: theFP. - "First move the data. We will fix up frame pointers later." + "First move the data, leaving room for the caller and base frame contexts. We will fix up frame pointers later." theFP + stackedReceiverOffset to: oldPage headSP by: objectMemory wordSize negated do: [:source| newSP := newSP - objectMemory wordSize. - stackPages unsignedLongAt: newSP put: (stackPages unsignedLongAt: source)]. + stackPages longAt: newSP put: (stackPages longAt: source)]. "newSP = oldSP + delta => delta = newSP - oldSP" delta := newSP - oldPage headSP. newFP := newPage baseAddress - stackedReceiverOffset. self setHeadFP: oldPage headFP + delta andSP: newSP inPage: newPage. newPage baseFP: newFP. - callerFP := self frameCallerFP: theFP. - self assert: (self isBaseFrame: theFP) not. - self assert: (self frameHasContext: callerFP). callerIP := self oopForPointer: (self frameCallerSavedIP: theFP). - stackPages unsignedLongAt: theFP + stackedReceiverOffset put: callerIP. + stackPages longAt: theFP + stackedReceiverOffset put: callerIP. self assert: (callerFP < oldPage baseAddress and: [callerFP > (oldPage realStackLimit - (LargeContextSlots * objectMemory bytesPerOop / 2))]). oldPage headFP: callerFP; headSP: theFP + stackedReceiverOffset. "Mark the new base frame in the new page (FoxCallerContext a.k.a. FoxCallerSavedIP)" - stackPages unsignedLongAt: newFP + FoxCallerContext put: (self frameContext: callerFP). - stackPages unsignedLongAt: newFP + FoxSavedFP put: 0. + self frameCallerContext: newFP put: (self frameContext: callerFP). + stackPages + longAt: newFP + FoxSavedFP put: 0. "Now relocate frame pointers, updating married contexts to refer to their moved spouse frames." fpInNewPage := newPage headFP. [offsetCallerFP := self frameCallerFP: fpInNewPage. offsetCallerFP ~= 0 ifTrue: [offsetCallerFP := offsetCallerFP + delta]. - stackPages unsignedLongAt: fpInNewPage + FoxSavedFP put: (self oopForPointer: offsetCallerFP). + stackPages longAt: fpInNewPage + FoxSavedFP put: (self oopForPointer: offsetCallerFP). (self frameHasContext: fpInNewPage) ifTrue: [theContext := self frameContext: fpInNewPage. objectMemory storePointerUnchecked: SenderIndex @@ -10426,6 +10300,7 @@ StackInterpreter >> moveFramesIn: oldPage through: theFP toPage: newPage [ withValue: (self withSmallIntegerTags: offsetCallerFP)]. fpInNewPage := offsetCallerFP. fpInNewPage ~= 0] whileTrue. + self assert: self validStackPageBaseFrames. ^newFP ] @@ -10872,6 +10747,7 @@ StackInterpreter >> positive32BitIntegerFor: integerValue [ "integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:. N.B. Returning in each arm separately enables Slang inlining. /Don't/ return the ifTrue:ifFalse: unless Slang inlining of conditionals is fixed." + objectMemory hasSixtyFourBitImmediates @@ -10969,7 +10845,7 @@ StackInterpreter >> postGCAction: gcModeArg [ StackInterpreter >> preBecomeAction [ "Need to write back the frame pointers unless all pages are free (as in snapshot)" stackPage ~= 0 ifTrue: - [self externalWriteBackHeadFramePointers] + [self writeBackHeadFramePointers] ] { #category : #'object memory support' } @@ -10977,7 +10853,7 @@ StackInterpreter >> preGCAction: gcModeArg [ "Need to write back the frame pointers unless all pages are free (as in snapshot)" - stackPage ~= 0 ifTrue: [ self externalWriteBackHeadFramePointers ]. + stackPage ~= 0 ifTrue: [ self writeBackHeadFramePointers ]. gcModeArg = GCModeFull ifTrue: [ self flushMethodCache ] ] @@ -11012,6 +10888,75 @@ StackInterpreter >> primitiveAccessorDepthForExternalPrimitiveMethod: methodObj ofObject: (self literal: 0 ofMethod: methodObj)) ] +{ #category : #'process primitives' } +StackInterpreter >> 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." + | criticalSection owningProcessIndex owningProcess activeProc inInterpreter | + argumentCount > 0 + ifTrue: + [criticalSection := self stackValue: 1. "rcvr" + 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 pop: argumentCount + 1 thenPush: objectMemory falseObject]. + owningProcess = activeProc ifTrue: + [^self pop: argumentCount + 1 thenPush: objectMemory trueObject]. + "Arrange to answer false (unowned) when the process is resumed." + self pop: argumentCount + 1 thenPush: objectMemory falseObject. + "We're going to switch process, either to an interpreted frame or a machine + code frame. To know whether to return or enter machine code we have to + know from whence we came. We could have come from the interpreter, + either directly or via a machine code primitive. We could have come from + machine code. The instructionPointer tells us where from:" + inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. + self addLastLink: activeProc toList: criticalSection. + self transferTo: self wakeHighestPriority from: CSEnterCriticalSection. + self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter +] + +{ #category : #'process primitives' } +StackInterpreter >> primitiveExitCriticalSection [ + "Exit the critical section. + This may change the active process as a result." + | criticalSection owningProcessIndex inInterpreter owningProcess | + criticalSection := self stackTop. "rcvr" + owningProcessIndex := ExcessSignalsIndex. "CriticalSections are laid out like Semaphores" + (self isEmptyList: criticalSection) + ifTrue: + [objectMemory storePointerUnchecked: owningProcessIndex + ofObject: criticalSection + withValue: objectMemory nilObject] + ifFalse: + ["We're going to switch process, either to an interpreted frame or a machine + code frame. To know whether to return or enter machine code we have to + know from whence we came. We could have come from the interpreter, + either directly or via a machine code primitive. We could have come from + machine code. The instructionPointer tells us where from:" + inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. + owningProcess := self removeFirstLinkOfList: criticalSection. + "store check unnecessary because aSemaphore referred to owningProcess + via its FirstLinkIndex slot before owningProcess was removed." + objectMemory storePointerUnchecked: owningProcessIndex + ofObject: criticalSection + withValue: owningProcess. + "Note that resume: isn't fair; it won't suspend the active process. + For fairness we must do the equivalent of a primitiveYield, but that + may break old code, so we stick with unfair resume:." + (self resume: owningProcess + preemptedYieldingIf: preemptionYields + from: CSExitCriticalSection) ifTrue: + [self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]] +] + { #category : #'simd primitives' } StackInterpreter >> primitiveFloat64ArrayAdd [ @@ -11258,22 +11203,64 @@ StackInterpreter >> primitiveObject: actualReceiver perform: selector withArgume ^nil ] -{ #category : #'primitives message counting' } -StackInterpreter >> primitiveStartProfiling [ - - self cppIf: FEATURE_MESSAGE_COUNT - ifTrue: [ messageCount := 0 ] - ifFalse: [ self primitiveFailFor: PrimErrUnsupported ] - -] - -{ #category : #'primitives message counting' } -StackInterpreter >> primitiveStopProfiling [ - - self cppIf: FEATURE_MESSAGE_COUNT - ifTrue: [ self pop: 1 thenPushInteger: messageCount ] - ifFalse: [ self primitiveFailFor: PrimErrUnsupported ] - +{ #category : #'process primitives' } +StackInterpreter >> 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 inInterpreter | + proc := self stackTop. "rcvr" + (objectMemory isContext: + (objectMemory followField: SuspendedContextIndex ofObject: proc)) + ifFalse: [ ^ self primitiveFail ]. + "We're about to switch process, either to an interpreted frame or a + machine code frame. To know whether to return or enter machine code + we have to know from whence we came. We could have come from the + interpreter, either directly or via a machine code primitive. We could have + come from machine code. The instructionPointer tells us where from:" + inInterpreter := self isInstructionPointerInInterpreter: + instructionPointer. + (self + resume: proc + preemptedYieldingIf: preemptionYields + from: CSResume) ifTrue: [ + self forProcessPrimitiveReturnToExecutivePostContextSwitch: + inInterpreter ] +] + +{ #category : #'process primitives' } +StackInterpreter >> 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: + [| inInterpreter | + "We're going to switch process, either to an interpreted frame or a machine + code frame. To know whether to return or enter machine code we have to + know from whence we came. We could have come from the interpreter, + either directly or via a machine code primitive. We could have come from + machine code. The instructionPointer tells us where from:" + self pop: 1 thenPush: objectMemory nilObject. + inInterpreter := self isInstructionPointerInInterpreter: instructionPointer. + self transferTo: self wakeHighestPriority from: CSSuspend. + ^self forProcessPrimitiveReturnToExecutivePostContextSwitch: inInterpreter]. + 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 storePointer: MyListIndex ofObject: process withValue: objectMemory nilObject. + self pop: 1 thenPush: myList] ] { #category : #'as yet unclassified' } @@ -11282,6 +11269,39 @@ StackInterpreter >> primitiveTable [ ^ primitiveTable ] +{ #category : #'process primitives' } +StackInterpreter >> primitiveYield [ + "primitively do the equivalent of Process>>yield" + + | scheduler activeProc priority processLists processList inInterpreter | + scheduler := self schedulerPointer. + activeProc := objectMemory + fetchPointer: ActiveProcessIndex + ofObject: scheduler. + priority := self + quickFetchInteger: PriorityIndex + ofObject: activeProc. + processLists := objectMemory + fetchPointer: ProcessListsIndex + ofObject: scheduler. + processList := objectMemory + fetchPointer: priority - 1 + ofObject: processLists. + + (self isEmptyList: processList) ifTrue: [ ^ nil ]. + "We're going to switch process, either to an interpreted frame or a machine + code frame. To know whether to return or enter machine code we have to + know from whence we came. We could have come from the interpreter, + either directly or via a machine code primitive. We could have come from + machine code. The instructionPointer tells us where from:" + inInterpreter := self isInstructionPointerInInterpreter: + instructionPointer. + self addLastLink: activeProc toList: processList. + self transferTo: self wakeHighestPriority from: CSYield. + self forProcessPrimitiveReturnToExecutivePostContextSwitch: + inInterpreter +] + { #category : #'debug printing' } StackInterpreter >> print: s [ "For testing in Smalltalk, this method should be overridden in a subclass." @@ -11660,7 +11680,7 @@ StackInterpreter >> printFrame: theFP WithSP: theSP [ (stackPages couldBeFramePointer: theFP) ifFalse: [self printHexPtr: theFP; print: ' is not in the stack zone?!'; cr. ^nil]. - theMethod := self frameMethod: theFP. + theMethod := self iframeMethod: theFP. numArgs := self frameNumArgs: theFP. self shortPrintFrame: theFP. self printFrameOop: 'rcvr/clsr' @@ -12370,7 +12390,7 @@ StackInterpreter >> printStackReferencesTo: oop [ (self frameHasContext: theFP) ifTrue: [oop = (self frameContext: theFP) ifTrue: [self print: 'FP: '; printHexnp: theFP; print: ' CTXT'; cr]]. - oop = (self frameMethod: theFP) ifTrue: + oop = (self iframeMethod: theFP) ifTrue: [self print: 'FP: '; printHexnp: theFP; print: ' MTHD'; cr]. (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: @@ -12443,7 +12463,7 @@ StackInterpreter >> processesInProcessListDo: aBlock [ Note: It is a fatal VM error if there is no runnable process." | schedLists p processList proc ctxt | - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer. @@ -12627,36 +12647,43 @@ StackInterpreter >> pushFullClosureNumArgs: numArgs copiedValues: numCopiedArg c "The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. Sets outerContext, compiledBlock, numArgs and receiver as specified.." + | numCopied newClosure context startIndex | "No need to record the pushed copied values in the outerContext." context := ignoreContext - ifTrue: [objectMemory nilObject ] - ifFalse: [self ensureFrameIsMarried: framePointer SP: stackPointer + (numCopiedArg * objectMemory bytesPerOop)]. + ifTrue: [ objectMemory nilObject ] + ifFalse: [ + self + ensureFrameIsMarried: framePointer + SP: + stackPointer + + (numCopiedArg * objectMemory bytesPerOop) ]. newClosure := self - fullClosureIn: context - numArgs: numArgs - numCopiedValues: numCopiedArg - compiledBlock: compiledBlock. + fullClosureIn: context + numArgs: numArgs + numCopiedValues: numCopiedArg + compiledBlock: compiledBlock. + self maybeTraceBlockCreation: newClosure. receiverIsOnStack - ifFalse: - [ startIndex := FullClosureFirstCopiedValueIndex. - objectMemory storePointerUnchecked: FullClosureReceiverIndex + ifFalse: [ + startIndex := FullClosureFirstCopiedValueIndex. + objectMemory + storePointerUnchecked: FullClosureReceiverIndex ofObject: newClosure withValue: self receiver. numCopied := numCopiedArg ] - ifTrue: - [ startIndex := FullClosureReceiverIndex. + ifTrue: [ + startIndex := FullClosureReceiverIndex. numCopied := numCopiedArg + 1 ]. - numCopied > 0 ifTrue: - [0 to: numCopied - 1 do: - [ :i | - "Assume: have just allocated a new BlockClosure; it must be young. + numCopied > 0 ifTrue: [ + 0 to: numCopied - 1 do: [ :i | "Assume: have just allocated a new BlockClosure; it must be young. Thus, can use unchecked stores." - objectMemory storePointerUnchecked: i + startIndex + objectMemory + storePointerUnchecked: i + startIndex ofObject: newClosure - withValue: (self stackValue: numCopied - i - 1)]. - self pop: numCopied]. + withValue: (self stackValue: numCopied - i - 1) ]. + self pop: numCopied ]. self fetchNextBytecode. self push: newClosure ] @@ -12756,27 +12783,30 @@ StackInterpreter >> pushMaybeContextReceiverVariable: fieldIndex [ { #category : #'stack bytecodes' } StackInterpreter >> pushNewArrayBytecode [ + | size popValues array | size := self fetchByte. popValues := size > 127. size := size bitAnd: 127. self fetchNextBytecode. - self externalizeIPandSP. "in case of abort" array := objectMemory - eeInstantiateSmallClassIndex: ClassArrayCompactIndex - format: objectMemory arrayFormat - numSlots: size. + eeInstantiateSmallClassIndex: ClassArrayCompactIndex + format: objectMemory arrayFormat + numSlots: size. popValues - ifTrue: - [0 to: size - 1 do: - [:i| - "Assume: have just allocated a new Array; it must be young. Thus, can use unchecked stores." - objectMemory storePointerUnchecked: i ofObject: array withValue: (self stackValue: size - i - 1)]. - self pop: size] - ifFalse: - [0 to: size - 1 do: - [:i| - objectMemory storePointerUnchecked: i ofObject: array withValue: objectMemory nilObject]]. + ifTrue: [ + 0 to: size - 1 do: [ :i | "Assume: have just allocated a new Array; it must be young. Thus, can use unchecked stores." + objectMemory + storePointerUnchecked: i + ofObject: array + withValue: (self stackValue: size - i - 1) ]. + self pop: size ] + ifFalse: [ + 0 to: size - 1 do: [ :i | + objectMemory + storePointerUnchecked: i + ofObject: array + withValue: objectMemory nilObject ] ]. self push: array ] @@ -12809,7 +12839,7 @@ StackInterpreter >> pushReceiverVariableBytecode [ { #category : #'stack bytecodes' } StackInterpreter >> pushRemoteTemp: index inVectorAt: tempVectorIndex [ | tempVector | - tempVector := self temporary: tempVectorIndex in: framePointer. + tempVector := self itemporary: tempVectorIndex in: framePointer. TempVectReadBarrier ifTrue: [(objectMemory isForwarded: tempVector) ifTrue: @@ -12829,7 +12859,7 @@ StackInterpreter >> pushRemoteTempLongBytecode [ { #category : #'stack bytecodes' } StackInterpreter >> pushTemporaryVariable: temporaryIndex [ - self push: (self temporary: temporaryIndex in: framePointer). + self push: (self itemporary: temporaryIndex in: framePointer). ] { #category : #'stack bytecodes' } @@ -12941,6 +12971,12 @@ StackInterpreter >> receiver [ ^stackPages unsignedLongAt: framePointer + FoxReceiver ] +{ #category : #'process primitive support' } +StackInterpreter >> recordContextSwitchFrom: oldProc in: sourceCode [ + + "Noop in pure interpreter" +] + { #category : #'callback support' } StackInterpreter >> reestablishContextPriorToCallback: callbackContext [ "callbackContext is an activation of invokeCallback:[stack:registers:jmpbuf:]. @@ -12953,12 +12989,12 @@ StackInterpreter >> reestablishContextPriorToCallback: callbackContext [ self flag: #obsolete. (self isLiveContext: callbackContext) ifFalse: [^false]. - calloutContext := self externalInstVar: SenderIndex ofContext: callbackContext. + calloutContext := self instVar: SenderIndex ofContext: callbackContext. (self isLiveContext: calloutContext) ifFalse: [^false]. "We're about to leave this stack page; must save the current frame's instructionPointer." self push: instructionPointer. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. "Mark callbackContext as dead; the common case is that it is the current frame. We go the extra mile for the debugger." (self isSingleContext: callbackContext) @@ -12975,7 +13011,7 @@ StackInterpreter >> reestablishContextPriorToCallback: callbackContext [ framePointer := self frameCallerFP: framePointer. ^true]] ifFalse: - [self externalDivorceFrame: theFP andContext: callbackContext. + [self divorceFrame: theFP andContext: callbackContext. self markContextAsDead: callbackContext]]. "Make the calloutContext the active frame. The case where calloutContext is immediately below callbackContext on the same page is handled above." @@ -13128,25 +13164,15 @@ StackInterpreter >> restoreStackLimit [ ] { #category : #'process primitive support' } -StackInterpreter >> resume: aProcess [ - "Replaced by resume:preemptedYieldingIf:" - "Make aProcess runnable and if its priority is higher than - that of the current process, preempt the current process. - Answer if the current process was preempted. Override - to add tracing info (see resume:from:)." - - self shouldNotImplement -] - -{ #category : #'process primitive support' } -StackInterpreter >> resume: aProcess preemptedYieldingIf: yieldImplicitly [ +StackInterpreter >> resume: aProcess preemptedYieldingIf: yieldImplicitly from: sourceCode [ "Make aProcess runnable and if its priority is higher than that of the current process, preempt the current process. Answer if the current process was preempted. If the current process was preempted then if yieldImplicitly add the current process to the back of its run queue, - causing an implicit yiled to other processes on the run queue, otherwise + causing an implicit yeild to other processes on the run queue, otherwise add the current process to the front of its run queue, hence not yielding. - Blue book behaviour is to yield implicitly but is arguably incorrect." + Blue book behaviour is to yield implicitly but is arguably incorrect. + Override to add tracing info." | activeProc activePriority newPriority | activeProc := self activeProcess. @@ -13156,7 +13182,7 @@ StackInterpreter >> resume: aProcess preemptedYieldingIf: yieldImplicitly [ [self putToSleep: aProcess yieldingIf: true. ^false]. self putToSleep: activeProc yieldingIf: yieldImplicitly. - self transferTo: aProcess. + self transferTo: aProcess from: sourceCode. ^true ] @@ -13199,6 +13225,12 @@ StackInterpreter >> retryPrimitiveOnFailure [ ^retried ] +{ #category : #'message sending' } +StackInterpreter >> return: returnValue toExecutive: inInterpreter [ + + "Do nothing in the interpreter" +] + { #category : #'return bytecodes' } StackInterpreter >> returnFalse [ localReturnValue := objectMemory falseObject. @@ -13224,6 +13256,19 @@ StackInterpreter >> returnReceiver [ self commonReturn ] +{ #category : #'message sending' } +StackInterpreter >> returnToExecutive: inInterpreter [ + "Noop in the non jitted vm" + + ^ nil +] + +{ #category : #'message sending' } +StackInterpreter >> returnToExecutive: inInterpreter postContextSwitch: switchedContext [ + + "Noop in pure interpreter" +] + { #category : #'return bytecodes' } StackInterpreter >> returnTopFromBlock [ @@ -13278,16 +13323,8 @@ StackInterpreter >> roomToPushNArgs: n [ won't actually push the arguments in the current context if the primitive fails. With this assumption it is safe to answer based on the maximum argument count, /not/ the ammount of space in the current frame were it converted to a context.." - false - ifTrue: "old code that checked size of context..." - [| cntxSize | - self assert: method = (stackPages unsignedLongAt: framePointer + FoxMethod). - cntxSize := (self methodHeaderIndicatesLargeFrame: (objectMemory methodHeaderOf: method)) - ifTrue: [LargeContextSlots - CtxtTempFrameStart] - ifFalse: [SmallContextSlots - CtxtTempFrameStart]. - ^self stackPointerIndex + n <= cntxSize] - ifFalse: "simpler code that simply insists args are <= max arg count" - [^n <= (LargeContextSlots - CtxtTempFrameStart)] + + ^ n <= (LargeContextSlots - CtxtTempFrameStart) ] { #category : #simulation } @@ -13415,6 +13452,18 @@ StackInterpreter >> sendBreakpoint: selector receiver: rcvr [ receiver: rcvr ] +{ #category : #'return bytecodes' } +StackInterpreter >> sendCannotReturn: resultOop [ + | ourContext | + + ourContext := self ensureFrameIsMarried: framePointer SP: stackPointer. + self push: ourContext. + self push: resultOop. + messageSelector := objectMemory splObj: SelectorCannotReturn. + argumentCount := 1. + ^self normalSend +] + { #category : #'send bytecodes' } StackInterpreter >> sendLiteralSelector0ArgsBytecode [ "Can use any of the first 16 literals for the selector." @@ -13518,14 +13567,6 @@ StackInterpreter >> setFrameContext: theFP to: aContext [ stackPages unsignedLongAt: theFP + FoxThisContext put: aContext ] -{ #category : #'frame access' } -StackInterpreter >> setFrameHasContext: theFP [ - "See encodeFrameFieldHasContext:numArgs:" - - - stackPages byteAt: theFP + FoxFrameFlags + 2 put: 1 -] - { #category : #'object memory support' } StackInterpreter >> setGCMode: mode [ "This is a no-op in the StackVM" @@ -13546,6 +13587,13 @@ StackInterpreter >> setHeadFP: theFP andSP: theSP inPage: thePage [ thePage headFP: theFP; headSP: theSP ] +{ #category : #'frame access' } +StackInterpreter >> setIFrameHasContext: theFP [ + + + stackPages byteAt: theFP + FoxFrameFlags + 2 put: 1 +] + { #category : #'image save/restore' } StackInterpreter >> setImageHeaderFlagsFrom: headerFlags [ "Set the flags that are contained in the 7th long of the image header." @@ -13674,6 +13722,48 @@ StackInterpreter >> setStackPageAndLimit: thePage [ stackPages markStackPageMostRecentlyUsed: thePage ] +{ #category : #'frame access' } +StackInterpreter >> setStackPageAndPointersForSuspendedContextOfProcess: aProcess [ + "Set stackPage, instructionPointer, framePointer and stackPointer for the suspendedContext of + aProcess, marrying the context if necessary, and niling the suspendedContext slot. This is used + on process switch to ensure a context has a stack frame and so can continue execution." + | newContext theFrame thePage newPage | + + + + + + newContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: aProcess. + self assert: (objectMemory isContext: newContext). + (self isMarriedOrWidowedContext: newContext) ifTrue: + [self assert: (self checkIsStillMarriedContext: newContext currentFP: framePointer)]. + objectMemory + storePointerUnchecked: SuspendedContextIndex + ofObject: aProcess + withValue: objectMemory nilObject. + (self isStillMarriedContext: newContext) + ifTrue: + [theFrame := self frameOfMarriedContext: newContext. + thePage := stackPages stackPageFor: theFrame. + theFrame ~= thePage headFP ifTrue: + ["explicit assignment of suspendedContext can cause switch to interior frame." + newPage := stackPages newStackPage. + self moveFramesIn: thePage + through: (self findFrameAbove: theFrame inPage: thePage) + toPage: newPage. + stackPages markStackPageLeastMostRecentlyUsed: newPage]. + self assert: thePage headFP = theFrame] + ifFalse: + [thePage := self makeBaseFrameFor: newContext. + theFrame := thePage baseFP]. + self setStackPageAndLimit: thePage. + self setStackPointersFromPage: thePage. + (self isMachineCodeFrame: framePointer) ifFalse: + [self setMethod: (self iframeMethod: framePointer)]. + instructionPointer := self popStack. + self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer +] + { #category : #'stack pages' } StackInterpreter >> setStackPointersFromPage: thePage [ @@ -13851,7 +13941,7 @@ StackInterpreter >> shortPrintFrame: theFP [ rcvr := self frameReceiver: theFP. self printHexPtr: theFP. self space. - self printActivationNameFor: (self frameMethod: theFP) + self printActivationNameFor: (self iframeMethod: theFP) receiver: rcvr isBlock: (self frameIsBlockActivation: theFP) firstTemporary: (self temporary: 0 in: theFP). @@ -14022,6 +14112,7 @@ StackInterpreter >> signed32BitIntegerFor: integerValue [ "Answer a full 32 bit integer object for the given integer value. N.B. Returning in each arm separately enables Slang inlining. /Don't/ return the ifTrue:ifFalse: unless Slang inlining of conditionals is fixed." + objectMemory hasSixtyFourBitImmediates ifTrue: @@ -14041,7 +14132,7 @@ StackInterpreter >> signed32BitIntegerFor: integerValue [ StackInterpreter >> signed64BitIntegerFor: integerValue [ "Answer a Large Integer object for the given integer value. N.B. will *not* cause a GC." - + @@ -14337,7 +14428,11 @@ StackInterpreter >> specialSelectorArray: anOop [ { #category : #'message sending' } StackInterpreter >> specialSelectorNumArgs: index [ - ^objectMemory integerValueOf: (objectMemory fetchPointer: (index * 2) + 1 ofObject: (objectMemory splObj: SpecialSelectors)) + + + ^ objectMemory integerValueOf: (objectMemory + fetchPointer: index * 2 + 1 + ofObject: (objectMemory splObj: SpecialSelectors)) ] { #category : #'indexing primitive support' } @@ -14542,6 +14637,7 @@ StackInterpreter >> stackPointer: theSP [ StackInterpreter >> stackPointerForMaybeMarriedContext: aContext [ "Return the stackPointer of a Context or BlockContext." | sp | + (self isStillMarriedContext: aContext) ifTrue: [sp := self stackPointerIndexForFrame: (self frameOfMarriedContext: aContext). @@ -14575,8 +14671,11 @@ StackInterpreter >> stackPointerIndexForFrame: theFP [ { #category : #'frame access' } StackInterpreter >> stackPointerIndexForFrame: theFP WithSP: theSP [ "Return the 1-based index rel to the given frame" + "In the StackInterpreter stacks grow down." - ^(((theFP + FoxReceiver) - theSP) >> objectMemory shiftForWord) + (self frameNumArgs: theFP) + + ^ (self frameReceiverLocation: theFP) - theSP + >> objectMemory shiftForWord + (self frameNumArgs: theFP) ] { #category : #'stack access' } @@ -14643,6 +14742,7 @@ StackInterpreter >> startPCOfMethod: aCompiledMethod [ StackInterpreter >> startPCOfMethodHeader: methodHeader [ "Answer the zero-relative index to the initial byte for a method. Zero-relative version of CompiledMethod>>startpc." + ^(objectMemory literalCountOfMethodHeader: methodHeader) + LiteralStart * objectMemory bytesPerOop ] @@ -14675,13 +14775,13 @@ StackInterpreter >> storeAndPopTemporaryVariableBytecode [ cCode: [ "this bytecode will be expanded so that refs to currentBytecode below will be constant" self fetchNextBytecode. self - temporary: (currentBytecode bitAnd: 7) + itemporary: (currentBytecode bitAnd: 7) in: framePointer put: self stackTop. self pop: 1 ] inSmalltalk: [ "Interpreter version has fetchNextBytecode out of order" self - temporary: (currentBytecode bitAnd: 7) + itemporary: (currentBytecode bitAnd: 7) in: framePointer put: self stackTop. self fetchNextBytecode. @@ -14768,7 +14868,7 @@ StackInterpreter >> storeMaybeContextReceiverVariable: fieldIndex withValue: anO StackInterpreter >> storeRemoteTemp: index inVectorAt: tempVectorIndex [ | tempVector | - tempVector := self temporary: tempVectorIndex in: framePointer. + tempVector := self itemporary: tempVectorIndex in: framePointer. TempVectReadBarrier ifTrue: [ (objectMemory isForwarded: tempVector) ifTrue: [ tempVector := self @@ -14937,7 +15037,7 @@ StackInterpreter >> supendActiveProcess [ | activeProc | activeProc := self activeProcess. - self transferTo: self wakeHighestPriority. + self transferTo: self wakeHighestPriority from: CSCallbackEnter. ^ activeProc ] @@ -14997,7 +15097,8 @@ StackInterpreter >> symbolicMethod: aMethod [ { #category : #'process primitive support' } StackInterpreter >> synchronousSignal: aSemaphore [ "Signal the given semaphore from within the interpreter. - Answer if the current process was preempted." + Answer if the current process was preempted. + Override to add tracing info." | excessSignals | (self isEmptyList: aSemaphore) ifTrue: @@ -15012,6 +15113,7 @@ StackInterpreter >> synchronousSignal: aSemaphore [ ^self resume: (self removeFirstLinkOfList: aSemaphore) preemptedYieldingIf: preemptionYields + from: CSSignal ] { #category : #'debug printing' } @@ -15028,24 +15130,16 @@ StackInterpreter >> tempCountOf: methodPointer [ { #category : #'internal interpreter access' } StackInterpreter >> temporary: offset in: theFP [ - "See StackInterpreter class>>initializeFrameIndices" - | frameNumArgs | + - ^offset < (frameNumArgs := self frameNumArgs: theFP) - ifTrue: [stackPages unsignedLongAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory wordSize)] - ifFalse: [stackPages unsignedLongAt: theFP + FoxReceiver - objectMemory wordSize + ((frameNumArgs - offset) * objectMemory wordSize)] + ^ self itemporary: offset in: theFP ] { #category : #'internal interpreter access' } StackInterpreter >> temporary: offset in: theFP put: valueOop [ - "See StackInterpreter class>>initializeFrameIndices" - | frameNumArgs | - - - ^offset < (frameNumArgs := self frameNumArgs: theFP) - ifTrue: [stackPages unsignedLongAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * objectMemory wordSize) put: valueOop] - ifFalse: [stackPages unsignedLongAt: theFP + FoxReceiver - objectMemory wordSize + ((frameNumArgs - offset) * objectMemory wordSize) put: valueOop] + + ^ self itemporary: offset in: theFP put: valueOop ] { #category : #'compiled methods' } @@ -15062,7 +15156,9 @@ StackInterpreter >> temporaryLocation: offset in: theFP numArgs: numArgs [ ^offset < numArgs ifTrue: [theFP + FoxCallerSavedIP + ((numArgs - offset) * objectMemory wordSize)] - ifFalse: [theFP + FoxReceiver - objectMemory wordSize + ((numArgs - offset) * objectMemory wordSize)] + ifFalse: [ + (self frameReceiverLocation: theFP) - objectMemory wordSize + + ((numArgs - offset) * objectMemory wordSize)] ] { #category : #simulation } @@ -15101,21 +15197,28 @@ StackInterpreter >> traceProfileState [ ] { #category : #'process primitive support' } -StackInterpreter >> transferTo: newProc [ +StackInterpreter >> transferTo: newProc from: sourceCode [ "Record a process to be awoken on the next interpreter cycle." | activeContext sched oldProc | statProcessSwitch := statProcessSwitch + 1. self push: instructionPointer. - self externalWriteBackHeadFramePointers. - self assertValidExecutionPointe: instructionPointer + 1 r: framePointer s: stackPointer. + self writeBackHeadFramePointers. + self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'. + + "ensureMethodIsCogged: in makeBaseFrameFor: in + externalSetStackPageAndPointersForSuspendedContextOfProcess: + below may do a code compaction. Nil instructionPointer to avoid it getting pushed twice." + instructionPointer := 0. sched := self schedulerPointer. oldProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched. + self recordContextSwitchFrom: oldProc in: sourceCode. + activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer + objectMemory wordSize. objectMemory storePointer: SuspendedContextIndex ofObject: oldProc withValue: activeContext. objectMemory storePointer: ActiveProcessIndex ofObject: sched withValue: newProc. objectMemory storePointerUnchecked: MyListIndex ofObject: newProc withValue: objectMemory nilObject. - self externalSetStackPageAndPointersForSuspendedContextOfProcess: newProc + self setStackPageAndPointersForSuspendedContextOfProcess: newProc ] { #category : #'sista bytecodes' } @@ -15125,15 +15228,15 @@ StackInterpreter >> trinaryAtPutInlinePrimitive: primIndex [ | result rec argIntAdjusted arg1 | arg1 := self stackValue: 1. rec := self stackValue: 2. - self deny: ((objectMemory isOopForwarded: rec) or: [ + self deny: ((objectMemory isOopForwarded: rec) or: [ objectMemory isImmediate: rec ]). self assert: (objectMemory isIntegerObject: arg1). argIntAdjusted := (objectMemory integerValueOf: arg1) - 1. self assert: argIntAdjusted >= 0. result := self stackTop. - primIndex caseOf: { - ([ 0 ] -> [ + primIndex caseOf: { + ([ 0 ] -> [ self assert: (objectMemory isPointers: rec). self assert: argIntAdjusted < (objectMemory numSlotsOfAny: rec). objectMemory @@ -15142,7 +15245,7 @@ StackInterpreter >> trinaryAtPutInlinePrimitive: primIndex [ withValue: result ]). "3001 storeCheckPointerAt:put: Mutable pointer object (Fixed sized or not) and not a context, Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)" - ([ 1 ] -> [ + ([ 1 ] -> [ self assert: (objectMemory isPointers: rec). self assert: argIntAdjusted < (objectMemory numSlotsOfAny: rec). objectMemory @@ -15151,35 +15254,31 @@ StackInterpreter >> trinaryAtPutInlinePrimitive: primIndex [ withValue: result ]). "3002 maybeContextPointerAt:put: Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)" - ([ 2 ] -> [ - ((objectMemory isContextNonImm: rec) and: [ + ([ 2 ] -> [ + ((objectMemory isContextNonImm: rec) and: [ self isMarriedOrWidowedContext: rec ]) - ifTrue: [ - self externalizeIPandSP. - self externalInstVar: argIntAdjusted ofContext: rec put: result. - self internalizeIPandSP ] - ifFalse: [ + ifTrue: [ + self instVar: argIntAdjusted ofContext: rec put: result ] + ifFalse: [ objectMemory storePointer: argIntAdjusted ofObject: rec withValue: result ] ]). "3003 maybeContextStoreCheckPointerAt:put: Mutable pointer object (Fixed sized or not), Smi, Anything => arg2 (1-based, optimised if arg1 is a constant)" - ([ 3 ] -> [ - ((objectMemory isContextNonImm: rec) and: [ + ([ 3 ] -> [ + ((objectMemory isContextNonImm: rec) and: [ self isMarriedOrWidowedContext: rec ]) - ifTrue: [ - self externalizeIPandSP. - self externalInstVar: argIntAdjusted ofContext: rec put: result. - self internalizeIPandSP ] - ifFalse: [ + ifTrue: [ + self instVar: argIntAdjusted ofContext: rec put: result ] + ifFalse: [ objectMemory storePointer: argIntAdjusted ofObject: rec withValue: result ] ]). "3004 byteAt:put: Mutable byte object, Smi, 8 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)" - ([ 4 ] -> [ + ([ 4 ] -> [ self assert: (objectMemory isBytes: rec). self assert: argIntAdjusted < (objectMemory numBytesOf: rec). self assert: (objectMemory isIntegerObject: result). @@ -15189,7 +15288,7 @@ StackInterpreter >> trinaryAtPutInlinePrimitive: primIndex [ withValue: (objectMemory integerValueOf: result) ]). "3005 shortAt:put: Mutable short object, Smi, 16 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)" - ([ 5 ] -> [ + ([ 5 ] -> [ self assert: (objectMemory isShorts: rec). self assert: argIntAdjusted < (objectMemory num16BitUnitsOf: rec). self assert: (objectMemory isIntegerObject: result). @@ -15199,7 +15298,7 @@ StackInterpreter >> trinaryAtPutInlinePrimitive: primIndex [ withValue: (objectMemory integerValueOf: result) ]). "3006 wordAt:put: Mutable word object, Smi, 32 bits unsigned Smi => arg2 (1-based, optimised if arg1 is a constant)" - ([ 6 ] -> [ + ([ 6 ] -> [ self assert: (objectMemory isWords: rec). self assert: argIntAdjusted < (objectMemory num32BitUnitsOf: rec). objectMemory @@ -15208,7 +15307,7 @@ StackInterpreter >> trinaryAtPutInlinePrimitive: primIndex [ withValue: (objectMemory positive32BitValueOf: result) ]). "3007 doubleWordAt:put: Mutable double word object, Smi, 64 bits unsigned Smi or LargePositiveInteger => arg2 (1-based, optimised if arg1 is a constant)" - ([ 7 ] -> [ + ([ 7 ] -> [ self assert: (objectMemory isLong64s: rec). self assert: argIntAdjusted < (objectMemory num64BitUnitsOf: rec). objectMemory @@ -15631,7 +15730,7 @@ StackInterpreter >> unfollowTempVector: tempVector atIndex: tempVectorIndex in: "So rare it mustn't bulk up the common path" | followed | followed := objectMemory followForwarded: tempVector. - self temporary: tempVectorIndex in: theFP put: followed. + self itemporary: tempVectorIndex in: theFP put: followed. ^followed ] @@ -15722,15 +15821,17 @@ StackInterpreter >> updateObjectsPostByteSwap [ StackInterpreter >> updateStateOfSpouseContextForFrame: theFP WithSP: theSP [ "Update the frame's spouse context with the frame's current state except for the sender and instruction pointer, which are used to mark the context as married." - | theContext tempIndex pointer | + | theContext tempIndex pointer argsPointer | + self assert: (self frameHasContext: theFP). theContext := self frameContext: theFP. + self assert: (objectMemory isContext: theContext). self assert: (self frameReceiver: theFP) - = (objectMemory fetchPointer: ReceiverIndex ofObject: theContext). + = (objectMemory noFixupFollowField: ReceiverIndex ofObject: theContext). tempIndex := self frameNumArgs: theFP. "update the arguments. this would appear not to be strictly necessary, but is for two reasons. First, the fact that arguments are read-only is only as convention in the Smalltalk compiler; @@ -15738,22 +15839,23 @@ StackInterpreter >> updateStateOfSpouseContextForFrame: theFP WithSP: theSP [ Second, the Squeak runUntilErrorOrReturnFrom: nightmare pops the stack top, which may, in certain circumstances, be the last argument, and hence the last argument may not have been stored into the context." - pointer := theFP + (self frameStackedReceiverOffsetNumArgs: tempIndex). + argsPointer := theFP + (self frameStackedReceiverOffsetNumArgs: tempIndex). 1 to: tempIndex do: [:i| - pointer := pointer - objectMemory wordSize. - self assert: (objectMemory addressCouldBeOop: (stackPages unsignedLongAt: pointer)). + argsPointer := argsPointer - objectMemory wordSize. + self assert: (objectMemory addressCouldBeOop: (stackPages longAt: argsPointer)). objectMemory storePointer: ReceiverIndex + i ofObject: theContext - withValue: (stackPages unsignedLongAt: pointer)]. + withValue: (stackPages longAt: argsPointer)]. + "now update the non-argument stack contents." - pointer := theFP + FoxReceiver - objectMemory wordSize. + pointer := (self frameReceiverLocation: theFP) - objectMemory wordSize. [pointer >= theSP] whileTrue: - [self assert: (objectMemory addressCouldBeOop: (stackPages unsignedLongAt: pointer)). + [self assert: (objectMemory addressCouldBeOop: (stackPages longAt: pointer)). tempIndex := tempIndex + 1. objectMemory storePointer: ReceiverIndex + tempIndex ofObject: theContext - withValue: (stackPages unsignedLongAt: pointer). + withValue: (stackPages longAt: pointer). pointer := pointer - objectMemory wordSize]. self assert: ReceiverIndex + tempIndex < (objectMemory lengthOf: theContext). objectMemory storePointerUnchecked: StackPointerIndex @@ -15862,7 +15964,7 @@ StackInterpreter >> wakeHighestPriority [ Note: It is a fatal VM error if there is no runnable process." | schedLists p processList proc ctxt | - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. schedLists := objectMemory fetchPointer: ProcessListsIndex ofObject: self schedulerPointer. @@ -15935,7 +16037,9 @@ StackInterpreter >> wordSwapped: w [ { #category : #'stack pages' } StackInterpreter >> writeBackHeadFramePointers [ + self assert: (framePointer - stackPointer) < (LargeContextSlots * objectMemory bytesPerOop). self assert: stackPage = stackPages mostRecentlyUsedPage. + self deny: stackPage isFree. self setHeadFP: framePointer andSP: stackPointer inPage: stackPage. self assert: stackPages pageListIsWellFormed ] diff --git a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st index 129e6ff6c7..4a83d10f2c 100644 --- a/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterPrimitives.class.st @@ -23,6 +23,7 @@ StackInterpreterPrimitives >> allocateParameters: anInteger using: allocationBlo StackInterpreterPrimitives >> cloneContext: aContext [ | sz cloned spouseFP sp | + sz := objectMemory numSlotsOf: aContext. cloned := objectMemory eeInstantiateMethodContextSlots: sz. cloned ~= 0 ifTrue: @@ -31,7 +32,7 @@ StackInterpreterPrimitives >> cloneContext: aContext [ objectMemory storePointerUnchecked: i ofObject: cloned - withValue: (self externalInstVar: i ofContext: aContext)]. + withValue: (self instVar: i ofContext: aContext)]. MethodIndex to: ReceiverIndex do: [:i| objectMemory @@ -900,7 +901,7 @@ StackInterpreterPrimitives >> primitiveContextAt [ self successful ifTrue: [self pop: argumentCount + 1 thenPush: value]. ^self]. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. (self isStillMarriedContext: aContext) ifFalse: [fmt := objectMemory formatOfHeader: hdr. totalLength := objectMemory lengthOf: aContext format: fmt. @@ -938,7 +939,7 @@ StackInterpreterPrimitives >> primitiveContextAtPut [ index := objectMemory integerValueOf: index. (objectMemory isContextHeader: hdr) ifFalse: "might be an instance of a subclass" [^self primitiveFailFor: PrimErrBadReceiver ]. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. (self isStillMarriedContext: aContext) ifFalse: [fmt := objectMemory formatOfHeader: hdr. totalLength := objectMemory lengthOf: aContext format: fmt. @@ -971,7 +972,7 @@ StackInterpreterPrimitives >> primitiveContextSize [ fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength. (objectMemory isContextHeader: hdr) ifTrue: - [self externalWriteBackHeadFramePointers. + [self writeBackHeadFramePointers. sz := self stackPointerForMaybeMarriedContext: rcvr] ifFalse: [sz := totalLength - fixedFields]. self pop: argumentCount + 1 thenPush: (objectMemory integerObjectOf: sz) @@ -1137,7 +1138,7 @@ StackInterpreterPrimitives >> primitiveDoPrimitiveWithArgs [ index := index + 1]. self isPrimitiveFunctionPointerAnIndex ifTrue: - [self externalQuickPrimitiveResponse. + [self executeQuickPrimitive. tempOop2 := 0. ^nil]. "We use tempOop instead of pushRemappableOop:/popRemappableOop here because in @@ -1500,7 +1501,7 @@ StackInterpreterPrimitives >> primitiveFindHandlerContext [ "Primitive. Search up the context stack for the next method context marked for exception handling starting at the receiver. Return nil if none found" | handlerOrNilOrZero | - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. handlerOrNilOrZero := self findMethodWithPrimitive: 199 FromContext: self stackTop @@ -1523,7 +1524,7 @@ StackInterpreterPrimitives >> primitiveFindNextUnwindContext [ "The following should never be true, but developing full blocks, early in September 2016 we were seeing invalid invocations of this primitive.. Hence the assert:" self assert: stopContext ~= calleeContext. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. (self isStillMarriedContext: calleeContext) ifTrue: [| theFP | @@ -1580,7 +1581,7 @@ StackInterpreterPrimitives >> primitiveFullGC [ of bytes available (including swap space if dynamic memory management is supported). In Spur, answer the size of the largest free chunk." - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. super primitiveFullGC ] @@ -1691,7 +1692,7 @@ StackInterpreterPrimitives >> primitiveIncrementalGC [ "Do a quick, incremental garbage collection and return the number of bytes immediately available. (Note: more space may be made available by doing a full garbage collection." - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. super primitiveIncrementalGC ] @@ -1714,7 +1715,7 @@ StackInterpreterPrimitives >> primitiveInstVarAt [ [^self primitiveFailFor: PrimErrBadIndex]. (fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: hdr]) - ifTrue: [value := self externalInstVar: index - 1 ofContext: rcvr] + ifTrue: [value := self instVar: index - 1 ofContext: rcvr] ifFalse: [value := self subscript: rcvr with: index format: fmt]. self pop: argumentCount + 1 thenPush: value ] @@ -1742,7 +1743,7 @@ StackInterpreterPrimitives >> primitiveInstVarAtPut [ [^self primitiveFailFor: PrimErrBadIndex]. (fmt = objectMemory indexablePointersFormat and: [objectMemory isContextHeader: hdr]) - ifTrue: [self externalInstVar: index - 1 ofContext: rcvr put: newValue] + ifTrue: [self instVar: index - 1 ofContext: rcvr put: newValue] ifFalse: [self subscript: rcvr with: index storing: newValue format: fmt]. self pop: argumentCount + 1 thenPush: newValue ] @@ -2543,7 +2544,7 @@ StackInterpreterPrimitives >> primitiveObjectPointsTo [ and: [objectMemory isContextHeader: header]) ifTrue: [(self isMarriedOrWidowedContext: rcvr) ifTrue: - [self externalWriteBackHeadFramePointers. + [self writeBackHeadFramePointers. (self isStillMarriedContext: rcvr) ifTrue: [^self pop: 2 thenPushBool: (self marriedContext: rcvr @@ -2857,10 +2858,10 @@ StackInterpreterPrimitives >> primitiveSlotAt [ [| value numLiveSlots | (objectMemory isContextNonImm: rcvr) ifTrue: - [self externalWriteBackHeadFramePointers. + [self writeBackHeadFramePointers. numLiveSlots := (self stackPointerForMaybeMarriedContext: rcvr) + CtxtTempFrameStart. value := (self asUnsigned: index) < numLiveSlots - ifTrue: [self externalInstVar: index ofContext: rcvr] + ifTrue: [self instVar: index ofContext: rcvr] ifFalse: [objectMemory nilObject]] ifFalse: [value := objectMemory fetchPointer: index ofObject: rcvr]. @@ -2930,7 +2931,7 @@ StackInterpreterPrimitives >> primitiveSlotAtPut [ (self asUnsigned: index) < numSlots ifTrue: [ (objectMemory isContextNonImm: rcvr) ifTrue: [ - self externalInstVar: index ofContext: rcvr put: newValue ] + self instVar: index ofContext: rcvr put: newValue ] ifFalse: [ objectMemory storePointer: index @@ -3558,14 +3559,14 @@ StackInterpreterPrimitives >> primitiveStoreStackp [ (self successful and: [newStackp between: 0 and: (objectMemory numSlotsOf: ctxt) - CtxtTempFrameStart]) ifFalse: [^self primitiveFail]. - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. (self isStillMarriedContext: ctxt) ifTrue: [theFP := self frameOfMarriedContext: ctxt. thePage := stackPages stackPageFor: theFP. ((onCurrentPage := thePage = stackPage) and: [theFP = framePointer]) ifTrue: [^self primitiveFail]. "Probably easy to do this right here right now (just move stackPointer). But fail for now." - self externalDivorceFrame: theFP andContext: ctxt. + self divorceFrame: theFP andContext: ctxt. onCurrentPage ifTrue: [self setStackPointersFromPage: stackPage] @@ -3815,7 +3816,7 @@ StackInterpreterPrimitives >> primitiveTerminateTo [ [^self primitiveFail]. "All stackPages need to have current head pointers to avoid confusion." - self externalWriteBackHeadFramePointers. + self writeBackHeadFramePointers. "If we're searching for aContextOrNil it might be on a stack page. Helps to know if we can free a whole page or not, or if we can short-cut the termination." @@ -3858,7 +3859,7 @@ StackInterpreterPrimitives >> primitiveTerminateTo [ self pop: 1. self assert: stackPage = stackPages mostRecentlyUsedPage. ^nil]. - theFP := self externalEnsureIsBaseFrame: theFP. "May cause a GC!!" + theFP := self ensureIsBaseFrame: theFP. "May cause a GC!!" currentCtx := self frameCallerContext: theFP. "May also reclaim aContextOrNil's page, hence..." (aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil]) @@ -3913,7 +3914,7 @@ StackInterpreterPrimitives >> primitiveTerminateTo [ ifTrue: [frameAbove := self findFrameAbove: theFP inPage: thePage. self assert: frameAbove ~= 0. - frameAbove := self externalEnsureIsBaseFrame: frameAbove. "May cause a GC!! May also reclaim aContextOrNil's page, hence..." + frameAbove := self ensureIsBaseFrame: frameAbove. "May cause a GC!! May also reclaim aContextOrNil's page, hence..." (aContextOrNil ~= objectMemory nilObject and: [self isStillMarriedContext: aContextOrNil]) ifTrue: [contextsFP := self frameOfMarriedContext: aContextOrNil. pageToStopOn := stackPages stackPageFor: contextsFP] @@ -4125,7 +4126,7 @@ StackInterpreterPrimitives >> ptExitInterpreterToCallback: aPointer [ suspendedProcess := self popSameThreadCalloutSuspendedProcess. self putToSleep: self activeProcess yieldingIf: preemptionYields. - self transferTo: suspendedProcess. + self transferTo: suspendedProcess from: CSCallbackLeave. newMethod := self popStack. diff --git a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st index 0e9199c12d..e6678af3d0 100644 --- a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st @@ -169,17 +169,6 @@ StackInterpreterSimulator >> atEachStepBlock: aBlock [ atEachStepBlock := aBlock ] -{ #category : #'return bytecodes' } -StackInterpreterSimulator >> baseFrameReturn [ - | contextToReturnTo | - contextToReturnTo := self frameCallerContext: framePointer. - ((objectMemory isContext: contextToReturnTo) - and: [self isMarriedOrWidowedContext: contextToReturnTo]) ifTrue: - [(self checkIsStillMarriedContext: contextToReturnTo currentFP: nil) ifFalse: - [self halt]]. - ^super baseFrameReturn -] - { #category : #initialization } StackInterpreterSimulator >> basicInitialize [ "Initialize the StackInterpreterSimulator when running the interpreter @@ -475,13 +464,10 @@ StackInterpreterSimulator >> dispatchOn: anInteger in: selectorArray [ ] { #category : #'debugging traps' } -StackInterpreterSimulator >> divorceFramesIn: aStackPage [ - "| thisPage | - (self checkIsStillMarriedContext: 22189568 currentFP: framePointer) ifTrue: - [thisPage := stackPages stackPageFor: (self frameOfMarriedContext: 22189568). - aStackPage == thisPage ifTrue: - [self halt]]." - ^super divorceFramesIn: aStackPage +StackInterpreterSimulator >> divorceFrame: theFP andContext: ctxt [ + "(theFP = -208 or: [ctxt = 22189568]) ifTrue: + [self halt]." + ^super divorceFrame: theFP andContext: ctxt ] { #category : #'process primitive support' } @@ -584,30 +570,6 @@ StackInterpreterSimulator >> endPCOf: aMethod [ ^end ] -{ #category : #'debugging traps' } -StackInterpreterSimulator >> externalDivorceFrame: theFP andContext: ctxt [ - "(theFP = -208 or: [ctxt = 22189568]) ifTrue: - [self halt]." - ^super externalDivorceFrame: theFP andContext: ctxt -] - -{ #category : #'frame access' } -StackInterpreterSimulator >> externalInstVar: index ofContext: aMarriedContext put: anOop [ - | imMarried shesMarried result | - index == SenderIndex ifTrue: - [imMarried := self checkIsStillMarriedContext: aMarriedContext currentFP: framePointer. - (objectMemory isContext: anOop) ifTrue: - [shesMarried := self checkIsStillMarriedContext: anOop currentFP: framePointer. - "self shortPrintContext: aMarriedContext. - self shortPrintContext: anOop"]]. - result := super externalInstVar: index ofContext: aMarriedContext put: anOop. - imMarried ifNotNil: - [self assert: imMarried == (self checkIsStillMarriedContext: aMarriedContext currentFP: nil). - shesMarried ifNotNil: - [self assert: shesMarried == (self checkIsStillMarriedContext: anOop currentFP: nil)]]. - ^result -] - { #category : #'interpreter shell' } StackInterpreterSimulator >> fetchByte [ ^objectMemory byteAt: (instructionPointer := instructionPointer + 1). @@ -755,43 +717,11 @@ StackInterpreterSimulator >> initializePluginEntries [ self loadNewPlugin: '' ] -{ #category : #'frame access' } -StackInterpreterSimulator >> instVar: index ofContext: aMarriedContext put: anOop [ - | imMarried shesMarried result | - index == SenderIndex ifTrue: - [imMarried := self checkIsStillMarriedContext: aMarriedContext currentFP: framePointer. - (objectMemory isContext: anOop) ifTrue: - [shesMarried := self checkIsStillMarriedContext: anOop currentFP: framePointer. - "self cr. - self shortPrintContext: aMarriedContext. - self shortPrintContext: anOop. - (#('yield:' 'nextPut:') includesAnyOf: {self stringOf: (self selectorOfContext: aMarriedContext). self stringOf: (self selectorOfContext: anOop)}) ifTrue: - [self halt]"]]. - result := super instVar: index ofContext: aMarriedContext put: anOop. - imMarried ifNotNil: - [self assert: imMarried == (self checkIsStillMarriedContext: aMarriedContext currentFP: nil). - shesMarried ifNotNil: - [self assert: shesMarried == (self checkIsStillMarriedContext: anOop currentFP: nil)]]. - ^result -] - { #category : #'interpreter shell' } StackInterpreterSimulator >> insufficientMemorySpecifiedError [ self error: 'Insufficient memory for this image' ] -{ #category : #'debugging traps' } -StackInterpreterSimulator >> internalCannotReturn: resultOop [ - self halt. - ^super internalCannotReturn: resultOop -] - -{ #category : #'debugging traps' } -StackInterpreterSimulator >> internalMustBeBoolean [ - self halt. - ^super internalMustBeBoolean -] - { #category : #'interpreter shell' } StackInterpreterSimulator >> interpret [ @@ -808,7 +738,6 @@ StackInterpreterSimulator >> interpret [ stackLimit = 0 ifTrue: [ ^ self initStackPagesAndInterpret ]. - self internalizeIPandSP. self initExtensions. self fetchNextBytecode. [ true ] whileTrue: [ @@ -817,7 +746,6 @@ StackInterpreterSimulator >> interpret [ self dispatchCurrentBytecode. self incrementByteCount ]. instructionPointer := instructionPointer - 1. "undo the pre-increment of IP before returning" - self externalizeIPandSP. ^ nil ] @@ -1076,12 +1004,6 @@ StackInterpreterSimulator >> longAt: byteAddress put: a32BitValue [ ^objectMemory longAt: byteAddress put: a32BitValue ] -{ #category : #'message sending' } -StackInterpreterSimulator >> lookupMethodInClass: class [ - lookupCount := lookupCount + 1. - ^super lookupMethodInClass: class -] - { #category : #'callback support' } StackInterpreterSimulator >> lookupOrdinaryNoMNUEtcInClass: class [ lookupCount := lookupCount + 1. @@ -1335,14 +1257,6 @@ StackInterpreterSimulator >> primitiveStoreStackp [ "self printContext: self stackTop" ] -{ #category : #'debugging traps' } -StackInterpreterSimulator >> primitiveSuspend [ - "Catch errors before we start the whole morphic error process" - - "byteCount > 1000000 ifTrue: [self halt]." "Ignore early process activity" - ^ super primitiveSuspend -] - { #category : #'system control primitives' } StackInterpreterSimulator >> primitiveVMParameter [ @@ -1578,35 +1492,22 @@ StackInterpreterSimulator >> reverseBytesInImage [ during: [super reverseBytesInImage] ] -{ #category : #'method lookup cache' } -StackInterpreterSimulator >> rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress [ - self assert: (localPrimAddress isSymbol - or: [localPrimAddress isInteger - and: [localPrimAddress = 0 - or: [(localPrimAddress between: 256 and: 519) - or: [localPrimAddress > 1000]]]]). - ^super rewriteMethodCacheEntryForExternalPrimitiveToFunction: localPrimAddress -] - { #category : #testing } StackInterpreterSimulator >> run [ - "Just run" quitBlock := [ ^ self close ]. self initStackPages. self loadInitialContext. self initialEnterSmalltalkExecutive. - instructionPointer := instructionPointer - 1. + instructionPointer := instructionPointer - 1 "undo the pre-increment of IP before returning" - self externalizeIPandSP ] { #category : #testing } StackInterpreterSimulator >> runAtEachStep: aBlock [ self initStackPages. self loadInitialContext. - self internalizeIPandSP. self fetchNextBytecode. [true] whileTrue: [self assertValidExecutionPointers. @@ -1615,44 +1516,40 @@ StackInterpreterSimulator >> runAtEachStep: aBlock [ self incrementByteCount]. instructionPointer := instructionPointer - 1. "undo the pre-increment of IP before returning" - self externalizeIPandSP ] { #category : #testing } StackInterpreterSimulator >> runAtEachStep: aBlock breakCount: aBreakCount [ + self initStackPages. self loadInitialContext. - self internalizeIPandSP. self fetchNextBytecode. - [true] whileTrue: - [self assertValidExecutionPointers. - aBlock value: currentBytecode. - self dispatchOn: currentBytecode in: BytecodeTable. - self incrementByteCount. - byteCount = aBreakCount ifTrue: - [self halt]]. - instructionPointer := instructionPointer - 1. + [ true ] whileTrue: [ + self assertValidExecutionPointers. + aBlock value: currentBytecode. + self dispatchOn: currentBytecode in: BytecodeTable. + self incrementByteCount. + byteCount = aBreakCount ifTrue: [ self halt ] ]. + instructionPointer := instructionPointer - 1 "undo the pre-increment of IP before returning" - self externalizeIPandSP ] { #category : #testing } -StackInterpreterSimulator >> runForNBytes: nBytecodes [ +StackInterpreterSimulator >> runForNBytes: nBytecodes [ "Do nByteCodes more bytecode dispatches. Keep byteCount up to date. This can be run repeatedly." + | endCount | self initStackPages. self loadInitialContext. endCount := byteCount + nBytecodes. - self internalizeIPandSP. self fetchNextBytecode. - [byteCount < endCount] whileTrue: - [self dispatchOn: currentBytecode in: BytecodeTable. - self incrementByteCount]. - instructionPointer := instructionPointer - 1. + [ byteCount < endCount ] whileTrue: [ + self dispatchOn: currentBytecode in: BytecodeTable. + self incrementByteCount ]. + instructionPointer := instructionPointer - 1 "undo the pre-increment of IP before returning" - self externalizeIPandSP ] { #category : #'I/O primitives' } @@ -1842,42 +1739,6 @@ StackInterpreterSimulator >> tab [ traceOn ifTrue: [ transcript tab ]. ] -{ #category : #testing } -StackInterpreterSimulator >> test1 [ - self initStackPages. - self loadInitialContext. - transcript clear. - byteCount := 0. - breakCount := -1. - self setBreakSelector: #blockCopy:. - quitBlock := [^self close]. - printSends := printReturns := true. - self internalizeIPandSP. - self fetchNextBytecode. - [true] whileTrue: - [self assertValidExecutionPointers. - "byteCount >= 22283 ifTrue: - [(self checkIsStillMarriedContext: 22186072 currentFP: localFP) ifFalse: - [self halt]]." - (printBytecodeAtEachStep - "and: [self isMarriedOrWidowedContext: 22189568]") ifTrue: - ["| thePage | - thePage := stackPages stackPageFor: (self frameOfMarriedContext: 22189568). - thePage == stackPage - ifTrue: [self shortPrintFrameAndCallers: localFP SP: localSP] - ifFalse: [self shortPrintFrameAndCallers: thePage headFrameFP SP: thePage headFrameSP]." - self printCurrentBytecodeOn: Transcript. - Transcript cr; flush]. - - self dispatchOn: currentBytecode in: BytecodeTable. - self incrementByteCount. - byteCount = breakCount ifTrue: - ["printFrameAtEachStep := true." - printSends := printBytecodeAtEachStep := true. - self halt: 'hit breakCount break-point']]. - self externalizeIPandSP -] - { #category : #testing } StackInterpreterSimulator >> testBecome [ "Become some young things. AA testBecome " @@ -1931,12 +1792,6 @@ StackInterpreterSimulator >> transcript: aTranscript [ transcript := aTranscript ] -{ #category : #'debugging traps' } -StackInterpreterSimulator >> transferTo: aProc [ - "self halt." - ^super transferTo: aProc -] - { #category : #accessing } StackInterpreterSimulator >> turnOnPrimTraceLog [ primTraceLog ifNil: @@ -1948,13 +1803,6 @@ StackInterpreterSimulator >> unableToReadImageError [ self error: 'Read failed or premature end of image file' ] -{ #category : #'debugging traps' } -StackInterpreterSimulator >> updateStateOfSpouseContextForFrame: theFP WithSP: theSP [ - "(self frameContext: theFP) = 22163268 ifTrue: - [self halt]." - ^super updateStateOfSpouseContextForFrame: theFP WithSP: theSP -] - { #category : #'debug support' } StackInterpreterSimulator >> veryDeepCopyWith: deepCopier [ diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index ab029414fe..7ce5a462e6 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -4015,7 +4015,7 @@ StackToRegisterMappingCogit >> profilingDataFor: cogMethod into: arrayObj [ introspectionDataIndex := counterIndex := 0. introspectionData := arrayObj. errCode := self - mapFor: (self cCoerceSimple: cogMethod to: #'CogBlockMethod *') + mapFor: (self cCoerceSimple: cogMethod to: #'CogMethod *') bcpc: (coInterpreter startPCOfMethod: cogMethod methodObject) performUntil: #profilingDataFor:Annotation:Mcpc:Bcpc:Method: arg: cogMethod asVoidPointer. diff --git a/smalltalksrc/VMMaker/VMClass.extension.st b/smalltalksrc/VMMaker/VMClass.extension.st index d7ecf7ce37..e6fa039d69 100644 --- a/smalltalksrc/VMMaker/VMClass.extension.st +++ b/smalltalksrc/VMMaker/VMClass.extension.st @@ -39,9 +39,6 @@ VMClass class >> initializeMiscConstants [ FEATURE_THREADED_FFI := InitializationOptions at: #FEATURE_THREADED_FFI ifAbsentPut: [ false ]. - FEATURE_MESSAGE_COUNT := InitializationOptions - at: #FEATURE_MESSAGE_COUNT - ifAbsentPut: [ false ]. SistaVM := InitializationOptions at: #SistaVM ifAbsentPut: [ false ]. TempVectReadBarrier := InitializationOptions diff --git a/smalltalksrc/VMMaker/VMStackPages.class.st b/smalltalksrc/VMMaker/VMStackPages.class.st index ff2a613f9f..6f1392fc5a 100644 --- a/smalltalksrc/VMMaker/VMStackPages.class.st +++ b/smalltalksrc/VMMaker/VMStackPages.class.st @@ -280,6 +280,23 @@ VMStackPages >> isFree: thePage [ ^thePage baseFP = 0 ] +{ #category : #'memory access' } +VMStackPages >> longAt: anInteger [ + + + "Note: Adjusted for Smalltalk's 1-based array indexing." + self assert: (anInteger >= minStackAddress and: [anInteger < maxStackAddress]). + ^objectMemory longAt: anInteger +] + +{ #category : #'memory access' } +VMStackPages >> longAt: byteAddress put: a32Or64BitValue [ + + + self assert: (byteAddress >= minStackAddress and: [byteAddress < maxStackAddress]). + ^objectMemory longAt: byteAddress put: a32Or64BitValue +] + { #category : #'page access' } VMStackPages >> markStackPageLeastMostRecentlyUsed: page [ "" "This method is used to move a page to the end of the used pages. diff --git a/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st b/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st index 96b77e33b7..2d6aadf04b 100644 --- a/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st +++ b/smalltalksrc/VMMakerCompatibilityForPharo6/PharoVMMaker.class.st @@ -29,7 +29,7 @@ PharoVMMaker class >> default64BitsMemoryManagerClass [ { #category : #defaults } PharoVMMaker class >> defaultImageFormatName [ - ^ 'SpurImage' + ^ 'SpurFormat' ] { #category : #defaults } diff --git a/smalltalksrc/VMMakerTests/VMBlockTest.class.st b/smalltalksrc/VMMakerTests/VMBlockTest.class.st index 931708eb7c..b257001c87 100644 --- a/smalltalksrc/VMMakerTests/VMBlockTest.class.st +++ b/smalltalksrc/VMMakerTests/VMBlockTest.class.st @@ -184,7 +184,7 @@ VMBlockTest >> testCreatingABlockClosureShouldHaveOuterContextObject [ "The current frame returned, the context is widowed, but the VM does not mark what are the alive frames all the time" self deny: (interpreter isWidowedContext: (memory outerContextOf: interpreter stackTop)). "From time to time, the VM will mark the frames that are alive, and then be able to recognize that a context is widowed" - interpreter externalWriteBackHeadFramePointers. + interpreter writeBackHeadFramePointers. self assert: (interpreter isWidowedContext: (memory outerContextOf: interpreter stackTop)) ] diff --git a/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st b/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st index 3bf797a63a..1fea546beb 100644 --- a/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st +++ b/smalltalksrc/VMMakerTests/VMByteCodesTest.class.st @@ -69,10 +69,8 @@ VMByteCodesTest >> firstStoreAndPopTemporaryVariableBytecode [ { #category : #'helper-interpret' } VMByteCodesTest >> interpret: aBlock [ - interpreter internalizeIPandSP. - aBlock value. - interpreter externalizeIPandSP. + aBlock value ] { #category : #'tests-simd' } @@ -596,7 +594,7 @@ VMByteCodesTest >> testReturnsMarriedFrameWidowsContext [ topFrameContext := interpreter stackTop. "The interpreter does not update the pages, they are updated on demand. Before checking a frame isWindowed we have to synchronize the interpreter variables with the stackPages" - interpreter externalWriteBackHeadFramePointers. + interpreter writeBackHeadFramePointers. self assert: (interpreter isWidowedContext: topFrameContext) ] diff --git a/smalltalksrc/VMMakerTests/VMContextAccessTest.class.st b/smalltalksrc/VMMakerTests/VMContextAccessTest.class.st index 6de7642a9d..a43fdf619d 100644 --- a/smalltalksrc/VMMakerTests/VMContextAccessTest.class.st +++ b/smalltalksrc/VMMakerTests/VMContextAccessTest.class.st @@ -11,8 +11,8 @@ VMContextAccessTest >> assertContext: newContext equals: contextOop onInstVar: a interpreter longPrintOop: contextOop. interpreter longPrintOop: newContext. - originalPC := interpreter externalInstVar: anIndex ofContext: contextOop. - copiedPC := interpreter externalInstVar: anIndex ofContext: newContext. + originalPC := interpreter instVar: anIndex ofContext: contextOop. + copiedPC := interpreter instVar: anIndex ofContext: newContext. self assert: copiedPC equals: originalPC ] @@ -20,12 +20,9 @@ VMContextAccessTest >> assertContext: newContext equals: contextOop onInstVar: a { #category : #tests } VMContextAccessTest >> pushActiveContext [ - interpreter internalizeIPandSP. interpreter pushActiveContextBytecode. - interpreter externalizeIPandSP. - - ^ interpreter stackTop. + ^ interpreter stackTop ] { #category : #running } diff --git a/smalltalksrc/VMMakerTests/VMJITPrimitiveCallingTest.class.st b/smalltalksrc/VMMakerTests/VMJITPrimitiveCallingTest.class.st index ae7986f7d8..cdfda82889 100644 --- a/smalltalksrc/VMMakerTests/VMJITPrimitiveCallingTest.class.st +++ b/smalltalksrc/VMMakerTests/VMJITPrimitiveCallingTest.class.st @@ -19,7 +19,7 @@ VMJITPrimitiveCallingTest >> initStack [ ] -{ #category : #'tests - without tracing' } +{ #category : #running } VMJITPrimitiveCallingTest >> setUp [ super setUp. diff --git a/smalltalksrc/VMMakerTests/VMLookUpTest.class.st b/smalltalksrc/VMMakerTests/VMLookUpTest.class.st index 7c86a62205..e82c935f91 100644 --- a/smalltalksrc/VMMakerTests/VMLookUpTest.class.st +++ b/smalltalksrc/VMMakerTests/VMLookUpTest.class.st @@ -492,7 +492,6 @@ VMLookUpTest >> testPrimitivePerformCreatesCorrectFrame [ interpreter argumentCount: 1. interpreter primitivePerform. - interpreter internalizeIPandSP. frame := VMStackFrame newFramePointer: (interpreter framePointer) withInterpreter: interpreter. self assert: frame receiver equals: receiverOop. self assert: frame method equals: methodOop. diff --git a/smalltalksrc/VMMakerTests/VMMASTTranslationTest.class.st b/smalltalksrc/VMMakerTests/VMMASTTranslationTest.class.st index 864f9253c3..245cbd43ed 100644 --- a/smalltalksrc/VMMakerTests/VMMASTTranslationTest.class.st +++ b/smalltalksrc/VMMakerTests/VMMASTTranslationTest.class.st @@ -437,7 +437,7 @@ VMMASTTranslationTest >> testMethodWithLoopDeclaresLoopIndexVariable [ VMMASTTranslationTest >> testMethodWithoutExplicitReturnInOtherMethodReturnsVoid [ | translation codeGenerator | - translation := (CoInterpreterPrimitives >> #doWaitSemaphore:reEnterInterpreter: ) asTranslationMethodOfClass: TMethod. + translation := (CoInterpreterPrimitives lookupSelector: #doWaitSemaphore:reEnterInterpreter: ) asTranslationMethodOfClass: TMethod. codeGenerator := CCodeGeneratorGlobalStructure new. codeGenerator vmMaker: VMMaker new. diff --git a/smalltalksrc/VMMakerTests/VMPrimitiveCallingTest.class.st b/smalltalksrc/VMMakerTests/VMPrimitiveCallingTest.class.st index 8f399670b4..384475fb9b 100644 --- a/smalltalksrc/VMMakerTests/VMPrimitiveCallingTest.class.st +++ b/smalltalksrc/VMMakerTests/VMPrimitiveCallingTest.class.st @@ -45,7 +45,6 @@ VMPrimitiveCallingTest >> testPrimitiveFailingDoesNotSkipSecondBytecodeIfNotLong interpreter activateNewMethod. - interpreter internalizeIPandSP. self assert: interpreter fetchByte equals: 16rF4 ] @@ -89,13 +88,10 @@ VMPrimitiveCallingTest >> testPrimitiveFailingSetsErrorCodeInCorrectTempWithInte interpreter primFailCode: -1. "Move the frame pointer to its caller but keep the correct one in the local FP". - interpreter internalizeIPandSP. interpreter framePointer: (interpreter frameCallerFP: interpreter framePointer). - "Use the internal version using the localFP" - interpreter internalActivateNewMethod. + interpreter activateNewMethod. "Then externalize and assert" - interpreter externalizeFPandSP. self assert: (interpreter temporary: 0 in: interpreter framePointer) equals: (memory integerObjectOf: -1) ] diff --git a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitBytecodeTest.class.st b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitBytecodeTest.class.st index ab98da08e0..da38e1895e 100644 --- a/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitBytecodeTest.class.st +++ b/smalltalksrc/VMMakerTests/VMSimpleStackBasedCogitBytecodeTest.class.st @@ -4,37 +4,6 @@ Class { #category : #'VMMakerTests-JitTests' } -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> doExtendedStoreStoresInstanceVariableIndex: instanceVariableToWrite [ - - "Create an object with at least `instanceVariableToWrite` instance variables. - In memory, instance variables are 0-indexed so substract 1" - obj := self newObjectWithSlots: instanceVariableToWrite. - - "The receiver should be in a receiver register based on Cog's calling convention" - machineSimulator receiverRegisterValue: obj. - - self doExtendedStoreStoresVariableType: 0 index: instanceVariableToWrite. -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> doExtendedStoreStoresVariableType: type index: index [ - - "Type = 0 is instance variable" - "Type = 1 is temp variable" - "Type = 2 is unused/invalid" - "Type = 3 is literal variable (~association)" - - "The object is filled with nils. - Push false into the stack and execute the store and pop bytecode." - self pushAddress: memory falseObject. - - "The first byte of the push receiver instance variable bytecode family is used to identify which variable (0-based again)" - cogit byte1: type << 6 + index - 1. - self compile: [ cogit extendedStoreBytecode ]. - self runGeneratedCode. -] - { #category : #'tests - single bytecode - pop into inst var' } VMSimpleStackBasedCogitBytecodeTest >> doPopIntoReceiverVariableBytecodeStoresVariableAt: instanceVariableToWrite [ @@ -167,67 +136,6 @@ VMSimpleStackBasedCogitBytecodeTest >> testExtendedPushPushesVariableType: type self assert: self popAddress equals: memory falseObject ] -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreInstanceVariableIndex1LeavesStackUnchanged [ - - "Check that we push a false that is not popped" - self assertPushed: memory falseObject after: [ self doExtendedStoreStoresInstanceVariableIndex: 1 ] -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreInstanceVariableIndex2LeavesStackUnchanged [ - - "Check that we push a false that is not popped" - self assertPushed: memory falseObject after: [ self doExtendedStoreStoresInstanceVariableIndex: 2 ] -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreInstanceVariableIndex32LeavesStackUnchanged [ - - "Check that we push a false that is not popped" - self assertPushed: memory falseObject after: [ self doExtendedStoreStoresInstanceVariableIndex: 32 ] -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreInstanceVariableIndex64LeavesStackUnchanged [ - - "Check that we push a false that is not popped" - self assertPushed: memory falseObject after: [ self doExtendedStoreStoresInstanceVariableIndex: 64 ] -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreStoresInstanceVariableIndex1 [ - - self testExtendedStoreStoresInstanceVariableIndex: 1 -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreStoresInstanceVariableIndex2 [ - - self testExtendedStoreStoresInstanceVariableIndex: 2 -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreStoresInstanceVariableIndex32 [ - - self testExtendedStoreStoresInstanceVariableIndex: 32 -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreStoresInstanceVariableIndex64 [ - - self testExtendedStoreStoresInstanceVariableIndex: 64 -] - -{ #category : #'tests - extended store bytecode - store inst var' } -VMSimpleStackBasedCogitBytecodeTest >> testExtendedStoreStoresInstanceVariableIndex: instanceVariableToWrite [ - - self doExtendedStoreStoresInstanceVariableIndex: instanceVariableToWrite. - - "After execution false should be popped from the stack and false should be stored in the object's variable (0-based)." - self assert: (memory fetchPointer: instanceVariableToWrite - 1 ofObject: obj) equals: memory falseObject -] - { #category : #'tests - jumps' } VMSimpleStackBasedCogitBytecodeTest >> testJumpForwardJumpsOverAnInstruction [ diff --git a/smalltalksrc/VMMakerTests/VMStackBuilder.class.st b/smalltalksrc/VMMakerTests/VMStackBuilder.class.st index 034acecd49..03868c02d3 100644 --- a/smalltalksrc/VMMakerTests/VMStackBuilder.class.st +++ b/smalltalksrc/VMMakerTests/VMStackBuilder.class.st @@ -194,7 +194,6 @@ VMStackBuilder >> setInterpreterVariables [ | lastFrame | interpreter setStackPageAndLimit: page. interpreter setStackPointersFromPage: page. - interpreter internalizeIPandSP. lastFrame := frames last. diff --git a/smalltalksrc/VMMakerTests/VMStackFrame.class.st b/smalltalksrc/VMMakerTests/VMStackFrame.class.st index 058f00b82d..ec06607f85 100644 --- a/smalltalksrc/VMMakerTests/VMStackFrame.class.st +++ b/smalltalksrc/VMMakerTests/VMStackFrame.class.st @@ -128,7 +128,7 @@ VMStackFrame >> machineCodeMethod [ { #category : #accessing } VMStackFrame >> method [ - ^ interpreter frameMethod: framePointer + ^ interpreter iframeMethod: framePointer ] { #category : #accessing } diff --git a/smalltalksrc/VMMakerTests/VMStackMappingTest.class.st b/smalltalksrc/VMMakerTests/VMStackMappingTest.class.st index 87ebd2d923..e36709438e 100644 --- a/smalltalksrc/VMMakerTests/VMStackMappingTest.class.st +++ b/smalltalksrc/VMMakerTests/VMStackMappingTest.class.st @@ -42,7 +42,7 @@ VMStackMappingTest >> testDivorceAMarriedContextShuoldMakeItSingle [ context := self newContext. interpreter marryContextInNewStackPageAndInitializeInterpreterRegisters: context. fp := interpreter frameOfMarriedContext: context. - interpreter externalDivorceFrame: fp andContext: context. + interpreter divorceFrame: fp andContext: context. self assert: (interpreter isSingleContext: context) ] @@ -84,7 +84,7 @@ VMStackMappingTest >> testMarryThenDivorceBaseFrameShouldFreeOldPage [ framePointerToMarry := interpreter stackPage baseFP. stackPointerToMarry := interpreter frameCallerSP: (interpreter frameCallerFP: interpreter framePointer). aContext := interpreter ensureFrameIsMarried: framePointerToMarry SP: stackPointerToMarry. - interpreter externalDivorceFrame: framePointerToMarry andContext: aContext. + interpreter divorceFrame: framePointerToMarry andContext: aContext. self assert: oldPage isFree ] @@ -97,7 +97,7 @@ VMStackMappingTest >> testMarryThenDivorceBaseFrameShouldSetDivorcedContextAsSen framePointerToMarry := interpreter stackPage baseFP. stackPointerToMarry := interpreter frameCallerSP: (interpreter frameCallerFP: interpreter framePointer). aContext := interpreter ensureFrameIsMarried: framePointerToMarry SP: stackPointerToMarry. - interpreter externalDivorceFrame: framePointerToMarry andContext: aContext. + interpreter divorceFrame: framePointerToMarry andContext: aContext. expectedDivorcedContext := interpreter frameCallerContext: interpreter stackPage baseFP. self assert: expectedDivorcedContext equals: aContext. @@ -112,7 +112,7 @@ VMStackMappingTest >> testMarryThenDivorceBaseFrameShouldSplitPage [ framePointerToMarry := interpreter stackPage baseFP. stackPointerToMarry := interpreter frameCallerSP: (interpreter frameCallerFP: interpreter framePointer). aContext := interpreter ensureFrameIsMarried: framePointerToMarry SP: stackPointerToMarry. - interpreter externalDivorceFrame: framePointerToMarry andContext: aContext. + interpreter divorceFrame: framePointerToMarry andContext: aContext. newPage := interpreter stackPage. self deny: oldPage equals: newPage ] @@ -125,7 +125,7 @@ VMStackMappingTest >> testMarryThenDivorceMiddleFrame [ framePointerToMarry := interpreter frameCallerFP: interpreter framePointer. stackPointerToMarry := interpreter frameCallerSP: interpreter framePointer. aContext := interpreter ensureFrameIsMarried: framePointerToMarry SP: stackPointerToMarry. - interpreter externalDivorceFrame: framePointerToMarry andContext: aContext. + interpreter divorceFrame: framePointerToMarry andContext: aContext. self assert: (interpreter isSingleContext: aContext). ] @@ -138,7 +138,7 @@ VMStackMappingTest >> testMarryThenDivorceMiddleFrameShouldSetDivorcedContextAsS stackPointerToMarry := interpreter frameCallerSP: interpreter framePointer. aContext := interpreter ensureFrameIsMarried: framePointerToMarry SP: stackPointerToMarry. oldBaseFramePointer := interpreter stackPage baseFP. - interpreter externalDivorceFrame: framePointerToMarry andContext: aContext. + interpreter divorceFrame: framePointerToMarry andContext: aContext. expectedDivorcedContext := interpreter frameCallerContext: interpreter stackPage baseFP. self assert: (interpreter frameHasContext: oldBaseFramePointer). @@ -158,7 +158,7 @@ VMStackMappingTest >> testMarryThenDivorceMiddleFrameShouldSplitPage [ framePointerToMarry := interpreter frameCallerFP: interpreter framePointer. stackPointerToMarry := interpreter frameCallerSP: interpreter framePointer. aContext := interpreter ensureFrameIsMarried: framePointerToMarry SP: stackPointerToMarry. - interpreter externalDivorceFrame: framePointerToMarry andContext: aContext. + interpreter divorceFrame: framePointerToMarry andContext: aContext. newNumberOfUsedPages := interpreter stackPages pages count:[ :aPage | aPage isFree not ]. self assert: initialiNumberOfusedPages + 1 equals: newNumberOfUsedPages ] @@ -171,7 +171,7 @@ VMStackMappingTest >> testMarryThenDivorceTopFrame [ framePointerToMarry := interpreter framePointer. stackPointerToMarry := interpreter stackPointer. aContext := interpreter ensureFrameIsMarried: framePointerToMarry SP: stackPointerToMarry. - interpreter externalDivorceFrame: framePointerToMarry andContext: aContext. + interpreter divorceFrame: framePointerToMarry andContext: aContext. self assert: (interpreter isSingleContext: aContext). ] @@ -182,7 +182,7 @@ VMStackMappingTest >> testMarryThenDivorceTopFrameShouldNotSplitPage [ initialiNumberOfusedPages := interpreter stackPages pages count:[ :aPage | aPage isFree not ]. aContext := interpreter ensureFrameIsMarried: interpreter framePointer SP: interpreter stackPointer. - interpreter externalDivorceFrame: interpreter framePointer andContext: aContext. + interpreter divorceFrame: interpreter framePointer andContext: aContext. newNumberOfUsedPages := interpreter stackPages pages count:[ :aPage | aPage isFree not ]. self assert: initialiNumberOfusedPages equals: newNumberOfUsedPages ]