From 18544530c545aba4df9e91f4f905f05e0190d842 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 31 Mar 2025 13:46:59 +0200 Subject: [PATCH 1/3] Remove dead code --- smalltalksrc/VMMaker/Cogit.class.st | 47 +++++++------------ .../VMMaker/StackInterpreter.class.st | 4 +- .../StackToRegisterMappingCogit.class.st | 7 ++- 3 files changed, 22 insertions(+), 36 deletions(-) diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index b3e90a5301..0e87d94f45 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -242,8 +242,6 @@ Class { 'cPICEndOfCodeLabel', 'ceMallocTrampoline', 'ceFreeTrampoline', - 'debugBytecodePointers', - 'debugOpcodeIndices', 'disassemblingMethod', 'cogConstituentIndex', 'directedSendUsesBinding', @@ -1193,20 +1191,18 @@ Cogit class >> mustBeGlobal: var [ only used outside of Cogit by the object representation). Include CFramePointer CStackPointer as a hack to get them declared at all." - ^ #( 'ceBaseFrameReturnTrampoline' #ceCaptureCStackPointers - 'ceCheckForInterruptTrampoline' ceEnterCogCodePopReceiverReg - realCEEnterCogCodePopReceiverReg - ceCallCogCodePopReceiverReg realCECallCogCodePopReceiverReg - ceCallCogCodePopReceiverAndClassRegs - realCECallCogCodePopReceiverAndClassRegs - 'ceReturnToInterpreterTrampoline' - 'ceCannotResumeTrampoline' ceTryLockVMOwner ceUnlockVMOwner - 'cmEntryOffset' 'cmNoCheckEntryOffset' 'cmDynSuperEntryOffset' - 'cmSelfSendEntryOffset' 'missOffset' 'cbEntryOffset' - 'cbNoSwitchEntryOffset' 'blockNoContextSwitchOffset' - CFramePointer CStackPointer 'cFramePointerInUse' - ceGetFP ceGetSP traceFlags 'traceStores' debugPrimCallStackOffset ) - includes: var + ^#( 'ceBaseFrameReturnTrampoline' #ceCaptureCStackPointers 'ceCheckForInterruptTrampoline' + ceEnterCogCodePopReceiverReg realCEEnterCogCodePopReceiverReg + ceCallCogCodePopReceiverReg realCECallCogCodePopReceiverReg + ceCallCogCodePopReceiverAndClassRegs realCECallCogCodePopReceiverAndClassRegs + 'ceReturnToInterpreterTrampoline' 'ceCannotResumeTrampoline' + ceTryLockVMOwner ceUnlockVMOwner + 'cmEntryOffset' 'cmNoCheckEntryOffset' 'cmDynSuperEntryOffset' 'cmSelfSendEntryOffset' + 'missOffset' 'cbEntryOffset' 'cbNoSwitchEntryOffset' 'blockNoContextSwitchOffset' + CFramePointer CStackPointer 'cFramePointerInUse' ceGetFP ceGetSP + traceFlags 'traceStores' debugPrimCallStackOffset) + includes: var + ] { #category : 'translation' } @@ -5203,6 +5199,7 @@ Cogit >> compileCogFullBlockMethod: numCopied [ inBlock := InFullBlock. postCompileHook := nil. maxLitIndex := -1. + initialPC := coInterpreter startPCOfMethod: methodObj. "initial estimate. Actual endPC is determined in scanMethod." endPC := objectMemory numBytesOf: methodObj. @@ -7631,8 +7628,8 @@ Cogit >> generateInstructionsAt: eventualAbsoluteAddress [ absoluteAddress := eventualAbsoluteAddress. pcDependentIndex := 0. - 0 to: opcodeIndex - 1 do: - [:i| + + 0 to: opcodeIndex - 1 do: [:i| abstractInstruction := self abstractInstructionAt: i. abstractInstruction isPCDependent ifTrue: @@ -7643,8 +7640,7 @@ Cogit >> generateInstructionsAt: eventualAbsoluteAddress [ absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize] ifFalse: [absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]]. - 0 to: pcDependentIndex - 1 do: - [:j| + 0 to: pcDependentIndex - 1 do: [:j| fixup := self fixupAtIndex: j. abstractInstruction := self abstractInstructionAt: fixup instructionIndex. abstractInstruction concretizeAt: abstractInstruction address]. @@ -11199,16 +11195,7 @@ Cogit >> setInterpreter: aCoInterpreter [ extA := numExtB := extB := 0. - compilationTrace ifNil: [ - compilationTrace := self class initializationOptions - at: #compilationTrace - ifAbsent: [ 0 ] ]. - debugOpcodeIndices := self class initializationOptions - at: #debugOpcodeIndices - ifAbsent: [ Set new ]. - debugBytecodePointers := self class initializationOptions - at: #debugBytecodePointers - ifAbsent: [ Set new ] + compilationTrace ifNil: [compilationTrace := self class initializationOptions at: #compilationTrace ifAbsent: [0]] ] { #category : 'jit - api' } diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index a87aa50119..ddc5c80f28 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -1081,8 +1081,8 @@ StackInterpreter class >> initializePrimitiveTable [ (63 primitiveStringAt) (64 primitiveStringAtPut) "The stream primitives no longer pay their way; normal Smalltalk code is faster." - (65 primitiveStartProfiling)"was primitiveNext" - (66 primitiveStopProfiling) "was primitiveNextPut" + (65 0) + (66 0) (67 0 "a.k.a. primitiveFail but faster because primitiveFail won't even be called") "was primitiveAtEnd" "StorageManagement Primitives (68-79)" diff --git a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st index ee23056292..97aa293c33 100644 --- a/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st +++ b/smalltalksrc/VMMaker/StackToRegisterMappingCogit.class.st @@ -3134,8 +3134,8 @@ StackToRegisterMappingCogit >> generateInstructionsAt: eventualAbsoluteAddress [ absoluteAddress := eventualAbsoluteAddress. pcDependentIndex := 0. - 0 to: opcodeIndex - 1 do: - [:i| + + 0 to: opcodeIndex - 1 do: [:i| abstractInstruction := self abstractInstructionAt: i. abstractInstruction isPCDependent ifTrue: @@ -3157,8 +3157,7 @@ StackToRegisterMappingCogit >> generateInstructionsAt: eventualAbsoluteAddress [ absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize] ifFalse: [absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]]. - 0 to: pcDependentIndex - 1 do: - [:j| + 0 to: pcDependentIndex - 1 do: [:j| fixup := self fixupAtIndex: j. abstractInstruction := self abstractInstructionAt: fixup instructionIndex. abstractInstruction concretizeAt: abstractInstruction address]. From cf30a2d1484bb5f1583a6374a2baa9e2694af06d Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 27 Jan 2025 15:47:55 +0100 Subject: [PATCH 2/3] Fix assertion when suspending a process in a list --- .../VMMaker/StackInterpreter.class.st | 26 +++++++++++++++---- 1 file changed, 21 insertions(+), 5 deletions(-) diff --git a/smalltalksrc/VMMaker/StackInterpreter.class.st b/smalltalksrc/VMMaker/StackInterpreter.class.st index ddc5c80f28..ca6d0b9fab 100644 --- a/smalltalksrc/VMMaker/StackInterpreter.class.st +++ b/smalltalksrc/VMMaker/StackInterpreter.class.st @@ -1955,16 +1955,32 @@ StackInterpreter >> addIdleUsecs: idleUsecs [ StackInterpreter >> addLastLink: proc toList: aList [ "Add the given process to the end of the given linked list and set the backpointer of process to its new list." - | lastLink | + | lastLink procList | + + lastLink := objectMemory + fetchPointer: LastLinkIndex + ofObject: aList. + + "If the process is already in a list two cases may arise" + procList := objectMemory followField: MyListIndex ofObject: proc. + procList ~= objectMemory nilObject ifTrue: [ + procList = aList ifTrue: [ + "It it is in the same list we want to put it, remove it so we make sure to install it at the end" + self removeProcess: proc fromList: aList. + ] ifFalse: [ + "Otherwise, we cannot ensure a correct behavior, fail. + If the process is already in a list, do not silently move it to another one" + self error: 'Process is already suspended in a different list' + ]]. + self deny: (objectMemory isForwarded: proc). self deny: (objectMemory isForwarded: aList). self assert: (objectMemory fetchPointer: NextLinkIndex ofObject: proc) = objectMemory nilObject. (self isEmptyList: aList) ifTrue: [objectMemory storePointer: FirstLinkIndex ofObject: aList withValue: proc] - ifFalse: - [lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList. - self assert: lastLink ~= proc. - objectMemory storePointer: NextLinkIndex ofObject: lastLink withValue: proc]. + ifFalse: [ + lastLink := objectMemory fetchPointer: LastLinkIndex ofObject: aList. + objectMemory storePointer: NextLinkIndex ofObject: lastLink withValue: proc]. objectMemory storePointer: LastLinkIndex ofObject: aList withValue: proc. objectMemory storePointer: MyListIndex ofObject: proc withValue: aList ] From bf05f20482bcf9554c348c64eb6a2e21feb655ff Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 27 Jan 2025 15:52:42 +0100 Subject: [PATCH 3/3] Log FFI info as INFO --- src/ffi/worker/worker.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ffi/worker/worker.c b/src/ffi/worker/worker.c index f3a53d4d14..22220d6f1b 100644 --- a/src/ffi/worker/worker.c +++ b/src/ffi/worker/worker.c @@ -195,7 +195,7 @@ void *worker_run(void *aWorker) { } - logWarn("Finishing Nested run: %d from %d\n", worker->nestedRuns, myRun); + logInfo("Finishing Nested run: %d from %d\n", worker->nestedRuns, myRun); worker->nestedRuns --;