diff --git a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st index cd7ef0b9..9473becd 100644 --- a/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st +++ b/src/GToolkit-GemStone-GemStone/GtGemStoneEvaluationContext.class.st @@ -188,6 +188,21 @@ GtGemStoneEvaluationContext >> handlerBlock: anObject [ ex resume ] ] +{ #category : 'actions - debug' } +GtGemStoneEvaluationContext >> interruptAsyncComputation [ + + process suspend. + + self createNewCallStack firstNonCriticalFrameIndex + ifNil: [ "Possibly handle the case of processes that we cannot interrupt" ] + ifNotNil: [ :anIndex | + process setStepIntoBreaksAtLevel: anIndex ]. + + process resume. + + ^ #interruptedAsync +] + { #category : 'testing' } GtGemStoneEvaluationContext >> isCompleted [ "Answer a boolean indicating whether the receiver's process has completed and successfully answered a result" diff --git a/src/GToolkit-GemStone/GtGemStoneLocalCallFrame.class.st b/src/GToolkit-GemStone/GtGemStoneLocalCallFrame.class.st index 2222ca7b..75971a64 100644 --- a/src/GToolkit-GemStone/GtGemStoneLocalCallFrame.class.st +++ b/src/GToolkit-GemStone/GtGemStoneLocalCallFrame.class.st @@ -1,6 +1,6 @@ Class { - #name : #GtGemStoneLocalCallFrame, - #superclass : #Object, + #name : 'GtGemStoneLocalCallFrame', + #superclass : 'Object', #instVars : [ 'frameArray', 'homeMethod', @@ -9,32 +9,32 @@ Class { #category : 'GToolkit-GemStone' } -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame class >> forFrameArray: aFrameArray [ ^ self forFrameArray: aFrameArray withIdentifier: nil ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame class >> forFrameArray: aFrameArray withIdentifier: aFrameIdentifier [ ^ self new initializeForFrameArray: aFrameArray withIdentifier: aFrameIdentifier ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallFrame >> description [ ^ String streamContents: [ :aStream | self printDescriptionOn: aStream] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> frameIdentifier [ ^ frameIdentifier ] -{ #category : #'gt - extensions' } +{ #category : 'gt - extensions' } GtGemStoneLocalCallFrame >> gtFrameArrayItemsFor: aView [ @@ -49,40 +49,46 @@ GtGemStoneLocalCallFrame >> gtFrameArrayItemsFor: aView [ text: [ :eachItem | eachItem gtDisplayString ]. ] -{ #category : #testing } +{ #category : 'testing' } GtGemStoneLocalCallFrame >> hasSamePropertiesAs: anotherContext [ ^ (self isForSameMethodOrBlockAs: anotherContext) and: [ self ipOffset = anotherContext ipOffset ] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> homeMethod [ ^ homeMethod ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> homeMethodOop [ ^ self homeMethod asOop ] -{ #category : #initialization } +{ #category : 'initialization' } GtGemStoneLocalCallFrame >> initializeForFrameArray: aFrameArray withIdentifier: aFrameIdentifier [ frameArray := aFrameArray. homeMethod := frameArray first homeMethod. frameIdentifier := aFrameIdentifier ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> ipOffset [ ^ frameArray at: 2 ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> isForBlock [ ^ frameArray first isMethodForBlock ] -{ #category : #testing } +{ #category : 'testing' } +GtGemStoneLocalCallFrame >> isForCriticalMethod [ + ^ ProcessorScheduler scheduler _criticalMethods + includes: self homeMethod +] + +{ #category : 'testing' } GtGemStoneLocalCallFrame >> isForSameMethodOrBlockAs: anotherContext [ "This amims to detect of two contexts are different" ^ self methodClassName = anotherContext methodClassName and: [ @@ -90,24 +96,24 @@ GtGemStoneLocalCallFrame >> isForSameMethodOrBlockAs: anotherContext [ self homeMethodOop = anotherContext homeMethodOop ] ] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> methodClass [ ^ homeMethod inClass ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> methodClassName [ ^ self methodClass ifNotNil: [ :aClass | aClass name ] ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallFrame >> methodDescription [ ^ String streamContents: [ :aStream | self printMethodDescriptionOn: aStream ] ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallFrame >> printClassLabelOn: aStream [ self selfObjectClass ~= self methodClass ifTrue: [ @@ -120,14 +126,14 @@ GtGemStoneLocalCallFrame >> printClassLabelOn: aStream [ aStream nextPutAll: (self methodClassName ifNil: [ '']) ] ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallFrame >> printDescriptionOn: aStream [ self printMethodDescriptionOn: aStream. aStream nextPutAll: ' '. self printExtraDetailsOn: aStream. ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallFrame >> printExtraDetailsOn: aStream [ aStream nextPutAll: '['; @@ -136,7 +142,7 @@ GtGemStoneLocalCallFrame >> printExtraDetailsOn: aStream [ nextPutAll: self frameIdentifier description ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallFrame >> printMethodDescriptionOn: aStream [ self isForBlock ifTrue: [ aStream nextPutAll: '[] in ' ]. @@ -149,7 +155,7 @@ GtGemStoneLocalCallFrame >> printMethodDescriptionOn: aStream [ aStream nextPutAll: aSelector ] ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallFrame >> printOn: aStream [ super printOn: aStream. @@ -157,49 +163,49 @@ GtGemStoneLocalCallFrame >> printOn: aStream [ self printDescriptionOn: aStream ] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> programCounterMarkers [ | currentSourceInfo | currentSourceInfo := self sourceInfo. ^ { currentSourceInfo first . currentSourceInfo second } ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> receiver [ ^ frameArray at: 10 ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> receiverClass [ ^ self receiver class ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> receiverClassName [ ^ self receiverClass name ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> selector [ ^ homeMethod selector. ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> selfObject [ ^ frameArray at: 8 ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> selfObjectClass [ ^ self selfObject class ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> selfObjectClassName [ ^ self selfObjectClass name ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallFrame >> sourceInfo [ | source ipOffset markers startIndex endIndex i | @@ -219,12 +225,12 @@ GtGemStoneLocalCallFrame >> sourceInfo [ ^ { startIndex. endIndex. source. } ] -{ #category : #updating } +{ #category : 'updating' } GtGemStoneLocalCallFrame >> updateIdentifierBasedOn: aCallFrame [ self updateIdentifierTo: aCallFrame frameIdentifier ] -{ #category : #updating } +{ #category : 'updating' } GtGemStoneLocalCallFrame >> updateIdentifierTo: anIdentifier [ frameIdentifier := anIdentifier ] diff --git a/src/GToolkit-GemStone/GtGemStoneLocalCallStack.class.st b/src/GToolkit-GemStone/GtGemStoneLocalCallStack.class.st index 39799efd..598a9016 100644 --- a/src/GToolkit-GemStone/GtGemStoneLocalCallStack.class.st +++ b/src/GToolkit-GemStone/GtGemStoneLocalCallStack.class.st @@ -1,56 +1,65 @@ Class { - #name : #GtGemStoneLocalCallStack, - #superclass : #Object, + #name : 'GtGemStoneLocalCallStack', + #superclass : 'Object', #instVars : [ 'callFrames', 'gsProcess', 'nextFrameIdentifier' ], - #category : #'GToolkit-GemStone' + #category : 'GToolkit-GemStone' } -{ #category : #'instance creation' } +{ #category : 'instance creation' } GtGemStoneLocalCallStack class >> forProcess: aGsProcess [ ^ self new initializeForProcess: aGsProcess ] -{ #category : #updating } +{ #category : 'updating' } GtGemStoneLocalCallStack >> appendCallFramesFromIndex: anIndex from: aNewCallStack [ (aNewCallStack callFrames copyFrom: 1 to: anIndex) reverseDo: [ :aNewCallFrame | self appendFirstNewCallFrame: aNewCallFrame ] ] -{ #category : #updating } +{ #category : 'updating' } GtGemStoneLocalCallStack >> appendFirstNewCallFrame: aNewCallFrame [ aNewCallFrame updateIdentifierTo: self generateIdentifier. callFrames addFirst: aNewCallFrame ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallStack >> callFrames [ ^ callFrames ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallStack >> callFramesAt: anIndex [ ^ self callFrames at: anIndex ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallStack >> createSpecification [ ^ GtGemStoneProcessSpecification forGsCallStack: self ] -{ #category : #accessing } +{ #category : 'accessing' } +GtGemStoneLocalCallStack >> firstNonCriticalFrameIndex [ + 1 to: self numberOfCallFrames do: [ :anIndex | + (self callFrames at: anIndex) isForCriticalMethod + ifFalse: [ ^ anIndex ] ]. + + ^ nil +] + +{ #category : 'accessing' } GtGemStoneLocalCallStack >> frameForIdentifier: aFrameIdentifier [ | frameLevel | frameLevel := self frameLevelForIdentifier: aFrameIdentifier. ^ self callFrames at: frameLevel ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallStack >> frameLevelForIdentifier: aFrameIdentifier [ aFrameIdentifier ifNil: [ Error signal: 'aFrameIdentifier cannot be nil' ]. @@ -62,7 +71,7 @@ GtGemStoneLocalCallStack >> frameLevelForIdentifier: aFrameIdentifier [ Error signal: 'Could not find frame with identifier: ', aFrameIdentifier printString ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallStack >> generateIdentifier [ | currentIdentifier | currentIdentifier := nextFrameIdentifier. @@ -70,7 +79,7 @@ GtGemStoneLocalCallStack >> generateIdentifier [ ^ currentIdentifier ] -{ #category : #'gt - extensions' } +{ #category : 'gt - extensions' } GtGemStoneLocalCallStack >> gtViewStackFramesFor: aView [ @@ -93,7 +102,7 @@ GtGemStoneLocalCallStack >> gtViewStackFramesFor: aView [ aStackFrame methodDescription ] ] -{ #category : #initialization } +{ #category : 'initialization' } GtGemStoneLocalCallStack >> initializeForProcess: aGsProcess [ nextFrameIdentifier := GtGemStoneCallFrameIdentifier initialIdentifier. @@ -105,17 +114,17 @@ GtGemStoneLocalCallStack >> initializeForProcess: aGsProcess [ withIdentifier: self generateIdentifier ]). ] -{ #category : #testing } +{ #category : 'testing' } GtGemStoneLocalCallStack >> isEmpty [ ^ self numberOfCallFrames = 0 ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallStack >> numberOfCallFrames [ ^ self callFrames size ] -{ #category : #printing } +{ #category : 'printing' } GtGemStoneLocalCallStack >> printOn: aStream [ super printOn: aStream. @@ -124,12 +133,12 @@ GtGemStoneLocalCallStack >> printOn: aStream [ aStream nextPutAll: ' frames' ] ] -{ #category : #accessing } +{ #category : 'accessing' } GtGemStoneLocalCallStack >> removeAllCallFrames [ callFrames := OrderedCollection new ] -{ #category : #updating } +{ #category : 'updating' } GtGemStoneLocalCallStack >> removeCallFramesUpwardsFromIndex: anIndex [ "Remove all call frames upwards starting from the given 1-based index" @@ -139,7 +148,7 @@ GtGemStoneLocalCallStack >> removeCallFramesUpwardsFromIndex: anIndex [ to: callFrames size ] -{ #category : #updating } +{ #category : 'updating' } GtGemStoneLocalCallStack >> replaceFrameAt: anIndex with: aNewContext [ self callFrames at: anIndex put: aNewContext ]