diff --git a/smalltalksrc/VMMaker/CoInterpreter.class.st b/smalltalksrc/VMMaker/CoInterpreter.class.st index e8040e5fe9..608efe3495 100644 --- a/smalltalksrc/VMMaker/CoInterpreter.class.st +++ b/smalltalksrc/VMMaker/CoInterpreter.class.st @@ -2182,6 +2182,8 @@ CoInterpreter >> encodedNativePCOf: mcpc cogMethod: cogMethod [ mcpc = cogit ceCannotResumePC ifTrue: [^HasBeenReturnedFromMCPCOop]. + + self assert: (cogMethodZone methodFor: mcpc) = cogMethod. ^objectMemory integerObjectOf: cogMethod asInteger - mcpc ] @@ -4584,44 +4586,42 @@ CoInterpreter >> returnToExecutive: inInterpreter postContextSwitch: switchedCon machine code. The instructionPointer tells us where from. If it is above startOfMemory we're in the interpreter. If it is below, then we are in machine-code unless it is ceReturnToInterpreterPC, in which case we're in a machine-code primitive called from the interpreter." - - | cogMethod retValue fullyInInterpreter | - + + | retValue fullyInInterpreter | cogit assertCStackWellAligned. - (self isMachineCodeFrame: framePointer) ifTrue: - [self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: false line: #'__LINE__'. - "If returning after a context switch then a result may have to be popped from the stack. + (self isMachineCodeFrame: framePointer) ifTrue: [ + self + assertValidExecutionPointe: instructionPointer + r: framePointer + s: stackPointer + imbar: false + line: #__LINE__. + "If returning after a context switch then a result may have to be popped from the stack. If the process is suspended at a send then the result of the primitive in which the process was suspended is still on the stack and must be popped into ReceiverResultReg. If not, nothing should be popped and ReceiverResultReg gets the receiver." - switchedContext - ifTrue: - [cogMethod := self mframeCogMethod: framePointer. - self assert: (instructionPointer asUnsignedInteger > cogit minCogMethodAddress - and: [instructionPointer asUnsignedInteger < cogit maxCogMethodAddress]). - (instructionPointer ~= (cogMethod asInteger + cogMethod stackCheckOffset) - and: [cogit isSendReturnPC: instructionPointer]) - ifTrue: - [self assert: (objectMemory addressCouldBeOop: self stackTop). - retValue := self popStack] - ifFalse: - [retValue := self mframeReceiver: framePointer]] - ifFalse: [retValue := self mframeReceiver: framePointer]. - self push: instructionPointer. - self push: retValue. - self callEnilopmart: #ceEnterCogCodePopReceiverReg. - self unreachable]. + retValue := self mframeReceiver: framePointer. + self push: instructionPointer. + self push: retValue. + self callEnilopmart: #ceEnterCogCodePopReceiverReg. + self unreachable ]. self setMethod: (self iframeMethod: framePointer). fullyInInterpreter := inInterpreter. - instructionPointer = cogit ceReturnToInterpreterPC ifTrue: - [instructionPointer := (self iframeSavedIP: framePointer) asUnsignedInteger. - fullyInInterpreter := false]. - self assertValidExecutionPointe: instructionPointer r: framePointer s: stackPointer imbar: true line: #'__LINE__'. - fullyInInterpreter ifFalse: - [self siglong: reenterInterpreter jmp: ReturnToInterpreter. - self unreachable]. - ^nil + instructionPointer = cogit ceReturnToInterpreterPC ifTrue: [ + instructionPointer := (self iframeSavedIP: framePointer) + asUnsignedInteger. + fullyInInterpreter := false ]. + self + assertValidExecutionPointe: instructionPointer + r: framePointer + s: stackPointer + imbar: true + line: #__LINE__. + fullyInInterpreter ifFalse: [ + self siglong: reenterInterpreter jmp: ReturnToInterpreter. + self unreachable ]. + ^ nil ] { #category : 'return bytecodes' } diff --git a/smalltalksrc/VMMaker/CogVMSimulator.class.st b/smalltalksrc/VMMaker/CogVMSimulator.class.st index 817db6e8eb..6ce7913fe0 100644 --- a/smalltalksrc/VMMaker/CogVMSimulator.class.st +++ b/smalltalksrc/VMMaker/CogVMSimulator.class.st @@ -1322,34 +1322,6 @@ CogVMSimulator >> primTraceLogSize [ ^PrimTraceLogSize * objectMemory wordSize ] -{ #category : 'debugging traps' } -CogVMSimulator >> primitiveContextAtPut [ - "| aContext | - aContext := self stackValue: 2. - (#(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]]." - ^super primitiveContextAtPut -] - -{ #category : 'debugging traps' } -CogVMSimulator >> primitiveDoPrimitiveWithArgs [ - | primIndex | - primIndex := objectMemory integerValueOf: (self stackValue: 1). - transcript nextPutAll: 'DO PRIMITIVE: '; print: (self functionPointerFor: primIndex inClass: nil); cr; flush. - (#(76 "primitiveStoreStackp" 188 189 "eval method") includes: primIndex) ifTrue: - [self halt]. - ^super primitiveDoPrimitiveWithArgs -] - -{ #category : 'debugging traps' } -CogVMSimulator >> primitiveExecuteMethod [ - self halt: thisContext selector. - ^super primitiveExecuteMethod -] - { #category : 'as yet unclassified' } CogVMSimulator >> primitiveFailCount [ ^ primitiveFailCount @@ -1381,15 +1353,6 @@ CogVMSimulator >> primitiveForceMachineCodeCompaction [ ] -{ #category : 'debugging traps' } -CogVMSimulator >> primitiveNewWithArg [ - "(objectMemory hasSpurMemoryManagerAPI - and: [self classNameOf: (self stackValue: 1) Is: 'Bitmap']) ifTrue: - [self printExternalHeadFrame. - self halt]." - ^super primitiveNewWithArg -] - { #category : 'object access primitives' } CogVMSimulator >> primitiveObjectAt [ "self transcript @@ -1401,12 +1364,6 @@ CogVMSimulator >> primitiveObjectAt [ ^super primitiveObjectAt ] -{ #category : 'debugging traps' } -CogVMSimulator >> primitiveObjectPointsTo [ - "self halt." - ^super primitiveObjectPointsTo -] - { #category : 'system control primitives' } CogVMSimulator >> primitiveSignalAtMilliseconds [ super primitiveSignalAtMilliseconds. @@ -1418,14 +1375,6 @@ CogVMSimulator >> primitiveSignalAtMilliseconds [ nextPutAll: ' wakeup - now '; print: nextWakeupUsecs - self ioUTCMicroseconds; flush]" ] -{ #category : 'debugging traps' } -CogVMSimulator >> primitiveStoreStackp [ - "self printContext: (self stackValue: 1). - self halt." - "(self stackValue: 1) = 16r1934F80 ifTrue: [self halt]." - super primitiveStoreStackp -] - { #category : 'plugin support' } CogVMSimulator >> primitiveThatDoNothingWithOneArgument [ diff --git a/smalltalksrc/VMMaker/Cogit.class.st b/smalltalksrc/VMMaker/Cogit.class.st index 10973486a5..be7be3454c 100644 --- a/smalltalksrc/VMMaker/Cogit.class.st +++ b/smalltalksrc/VMMaker/Cogit.class.st @@ -953,10 +953,10 @@ Cogit class >> initializePrimitiveTable [ "(82 primitiveFail)" "Blue Book: primitiveValueWithArgs" (83 genPrimitivePerform) "(84 primitivePerformWithArgs)" - "(85 primitiveSignal)" - "(86 primitiveWait)" - "(87 primitiveResume)" - "(88 primitiveSuspend)" + (85 genNonImplementedPrimitive -1 #maycallback) "primitiveSignal" + (86 genNonImplementedPrimitive -1 #maycallback) "primitiveWait" + (87 genNonImplementedPrimitive -1 #maycallback) "primitiveResume" + (88 genNonImplementedPrimitive -1 #maycallback) "primitiveSuspend" "(89 primitiveFlushCache)" "(90 primitiveMousePoint)" @@ -1004,6 +1004,8 @@ Cogit class >> initializePrimitiveTable [ (165 genPrimitiveIntegerAt 1) "Signed version of genPrimitiveAt" (166 genPrimitiveIntegerAtPut 2) "Signed version of genPrimitiveAtPut" + (167 genNonImplementedPrimitive -1 #maycallback) "primitiveYield" + (169 genPrimitiveNotIdentical 1) (170 genPrimitiveAsCharacter) "SmallInteger>>asCharacter, Character class>>value:" @@ -8651,18 +8653,6 @@ Cogit >> isSendAnnotation: annotation [ ^annotation >= IsSendCall ] -{ #category : 'jit - api' } -Cogit >> isSendReturnPC: retpc [ - - "Answer if the instruction preceding retpc is a call instruction." - | target | - (backEnd isCallPrecedingReturnPC: retpc) ifFalse: - [^false]. - target := backEnd callTargetFromReturnAddress: retpc. - ^(target between: firstSend and: lastSend) - or: [target between: methodZoneBase and: methodZone freeStart] -] - { #category : 'initialization' } Cogit >> isTrampolineArgConstant: n [ "Test for true and false and 0 to N encoded via trampolineArgConstant:" diff --git a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st index 85e50d57fc..0a0968510a 100644 --- a/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st +++ b/smalltalksrc/VMMaker/StackInterpreterSimulator.class.st @@ -993,18 +993,6 @@ StackInterpreterSimulator >> primitiveAtPut [ ^super primitiveAtPut ] -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveContextAt [ - "self halt." - ^super primitiveContextAt -] - -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveDoPrimitiveWithArgs [ - self halt. - ^super primitiveDoPrimitiveWithArgs -] - { #category : 'control primitives' } StackInterpreterSimulator >> primitiveExecuteMethod [ self halt: thisContext selector. @@ -1019,72 +1007,6 @@ StackInterpreterSimulator >> primitiveExecuteMethodArgsArray [ ^super primitiveExecuteMethodArgsArray ] -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveFailFor: reasonCode [ - "self halt." - ^super primitiveFailFor: reasonCode -] - -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveIdentityHash [ - "| oop | - oop := self stackTop. - ((objectMemory isBytes: oop) - and: [(objectMemory lengthOf: oop) = 'smallSelect' size - and: [(self stringOf: oop) = 'smallSelect']]) ifTrue: - [self halt]." - ^super primitiveIdentityHash -] - -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveNewWithArg [ - "(objectMemory hasSpurMemoryManagerAPI - and: [self classNameOf: (self stackValue: 1) Is: 'MethodDictionary']) ifTrue: - [self halt]." - "| hash | - hash := objectMemory rawHashBitsOf: (self stackValue: 1)." - "| format | - format := objectMemory instSpecOfClass: (self stackValue: 1)." - "(objectMemory numSlotsOf: (self stackValue: 1)) = 3 ifTrue: - [self halt]." - super primitiveNewWithArg. - "self successful ifTrue: - [(Smalltalk at: #Counts ifAbsentPut: [Bag new]) add: format]." - "(self successful and: [objectMemory hasSpurMemoryManagerAPI]) ifTrue: - [(Smalltalk at: #Counts ifAbsentPut: [Bag new]) add: hash]" - "Smalltalk removeKey: #Counts" - "Counts sortedCounts collect: [:assoc| - assoc key -> ((SpurMemoryManager organization listAtCategoryNamed: #'header formats') detect: - [:f| (SpurMemoryManager basicNew perform: f) = assoc value])] - {3251->#arrayFormat. - 1685->#firstByteFormat. - 1533->#firstLongFormat. - 110->#weakArrayFormat. - 35->#indexablePointersFormat. - 5->#nonIndexablePointerFormat}" - "Counts sortedCounts collect: [:assoc| - assoc value = 0 - ifTrue: [assoc] - ifFalse: [assoc key -> {(self nameOfClass: (objectMemory classAtIndex: assoc value)). - (SpurMemoryManager organization listAtCategoryNamed: #'header formats') detect: - [:f| (objectMemory perform: f) - = (objectMemory instSpecOfClass: (objectMemory classAtIndex: assoc value))]}]] - {1062->#('Array' #arrayFormat). - 777->#('Bitmap' #firstLongFormat). - 395->#('Float' #firstLongFormat). - 345->#('ByteString' #firstByteFormat). - 237->#('MatrixTransform2x3' #firstLongFormat). - 233->#('LargePositiveInteger' #firstByteFormat). - 103->#('WordArray' #firstLongFormat). - 58->#('WeakArray' #weakArrayFormat). - 52->#('WeakMessageSend' #weakArrayFormat). - 9->#('MethodContext' #indexablePointersFormat). - 4->#('DirectoryEntry' #nonIndexablePointerFormat). - 3->#('BalloonBuffer' #firstLongFormat). - 1->#('ByteArray' #firstByteFormat). - 1->0}" -] - { #category : 'object access primitives' } StackInterpreterSimulator >> primitiveObjectPointsTo [ "self halt." @@ -1108,14 +1030,6 @@ StackInterpreterSimulator >> primitiveVMParameter [ ^super primitiveVMParameter ] -{ #category : 'debugging traps' } -StackInterpreterSimulator >> primitiveWait [ - "Catch errors before we start the whole morphic error process" - - "byteCount > 1000000 ifTrue: [self halt]." "Ignore early process activity" - ^ super primitiveWait -] - { #category : 'debug printing' } StackInterpreterSimulator >> print: it [ @@ -1525,13 +1439,6 @@ StackInterpreterSimulator >> startInSender [ withValue: (self fetchStackPointerOf: senderContext) + 1 ] -{ #category : 'debugging traps' } -StackInterpreterSimulator >> success: successBoolean [ - "successBoolean ifFalse: - [self halt]." - ^super success: successBoolean -] - { #category : 'simulation only' } StackInterpreterSimulator >> systemAttributes [ ^systemAttributes