From a4d0ca0c05768ba18abe518ef2028432ae49151a Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Wed, 22 Mar 2023 10:20:02 +0100 Subject: [PATCH 01/13] SindarinDebugger first pass: putting flags, first fix to use API inside the API, formatting code --- Sindarin/SindarinDebugger.class.st | 189 +++++++++++++++-------------- 1 file changed, 101 insertions(+), 88 deletions(-) diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index ce84b83..3b09614 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -70,6 +70,8 @@ SindarinDebugger class >> debugSession: aDebugSession [ { #category : #'graphical debugger' } SindarinDebugger >> activateAutoRefreshOfAttachedGraphicalDebugger [ + + self flag: 'unused. What was it used for?'. sindarinSession activateEventTriggering. self refreshAttachedGraphicalDebugger ] @@ -85,8 +87,8 @@ SindarinDebugger >> arguments [ SindarinDebugger >> assignmentValue [ "Returns the value about to be assigned, if the current node is an assignment node. Otherwise, returns nil" - self node isAssignment - ifFalse: [ ^ nil "Error signal: 'Not about to perform a assignment'" ]. + self node isAssignment ifFalse: [ + ^ nil "Error signal: 'Not about to perform a assignment'" ]. ^ self context at: self currentContextStackSize ] @@ -94,8 +96,8 @@ SindarinDebugger >> assignmentValue [ SindarinDebugger >> assignmentVariableName [ "Returns the variable name about to be assigned to, if the current node is an assignment node. Otherwise, returns nil" - self node isAssignment - ifFalse: [ ^ nil "Error signal: 'Not about to perform a assignment'" ]. + self node isAssignment ifFalse: [ + ^ nil "Error signal: 'Not about to perform a assignment'" ]. ^ self node variable name ] @@ -110,23 +112,23 @@ SindarinDebugger >> attachTo: aDebugSession [ { #category : #astAndAstMapping } SindarinDebugger >> bestNodeFor: anInterval [ - ^self node methodNode bestNodeFor: anInterval + + ^ self node methodNode bestNodeFor: anInterval ] { #category : #'ast manipulation' } SindarinDebugger >> canStillExecute: aProgramNode [ - "returns true if the last pc mapped to aProgramNode is greater than `self pc` in the right context " | lastPcForNode rightContext | rightContext := self context. - [ - rightContext == rightContext outerMostContext or: [ - rightContext method ast allChildren identityIncludes: aProgramNode ] ] + [ + rightContext == rightContext outerMostContext or: [ + rightContext method ast allChildren identityIncludes: aProgramNode ] ] whileFalse: [ rightContext := rightContext sender ]. - lastPcForNode := (rightContext method ast lastPcForNode: aProgramNode) + lastPcForNode := (rightContext method ast lastPcForNode: aProgramNode) ifNil: [ 0 ]. ^ rightContext pc < lastPcForNode @@ -151,18 +153,17 @@ SindarinDebugger >> contextIsAboutToSignalException: aContext [ "Returns whether aContext is about to execute a message-send of selector #signal to an instance of the Exception class (or one of its subclasses)" | node | - node := aContext method methodNode bcToASTCache nodeForPC: aContext pc. - node isMessage - ifFalse: [ ^ false ]. - node selector = #signal - ifFalse: [ ^ false ]. - aContext basicSize >= 1 - ifFalse: [ ^ false ]. + node := aContext method methodNode bcToASTCache nodeForPC: + aContext pc. + node isMessage ifFalse: [ ^ false ]. + self flag: + 'What about `#signalIn:`? We will have the same problem as in the debugger, right?'. + node selector = #signal ifFalse: [ ^ false ]. + aContext basicSize >= 1 ifFalse: [ ^ false ]. (Exception allSubclasses includes: (aContext at: aContext basicSize)) - ifTrue: [ ^ true ]. "#signal sent to a subclass of Exception" - (Exception allSubclasses - includes: (aContext at: aContext basicSize) class) - ifTrue: [ ^ true ]. "#signal sent to an instance of a subclass of Exception" + ifTrue: [ ^ true ]. "#signal sent to a subclass of Exception" + (Exception allSubclasses includes: + (aContext at: aContext basicSize) class) ifTrue: [ ^ true ]. "#signal sent to an instance of a subclass of Exception" ^ false ] @@ -178,31 +179,39 @@ SindarinDebugger >> continue [ { #category : #accessing } SindarinDebugger >> currentBytecode [ + + self flag: + 'This method has a really confusing name as, from its name, we expect that it returns a bytecode. But actually, it returns the entire list of symbolic bytecodes'. ^ self context method symbolicBytecodes ] { #category : #private } SindarinDebugger >> currentContextStackSize [ + ^ self context basicSize ] { #category : #process } SindarinDebugger >> currentProcess [ - ^process + + ^ process ] { #category : #'graphical debugger' } SindarinDebugger >> deactivateAutoRefreshOfAttachedGraphicalDebugger [ + self flag: 'unused. What was it used for?'. sindarinSession deactivateEventTriggering ] { #category : #start } SindarinDebugger >> debug: aBlock [ + blockToDebug := aBlock. - process := aBlock newProcess name: 'ExecutionDebuggedByScriptableDebugger'. + process := aBlock newProcess name: + 'ExecutionDebuggedByScriptableDebugger'. sindarinSession := SindarinDebugSession - newWithName: 'ScriptableDebuggerDebugSession' - forProcess: process. + newWithName: 'ScriptableDebuggerDebugSession' + forProcess: process. sindarinSession deactivateEventTriggering. "Step the process until it enters the block for which a process was created" [ self context closure == blockToDebug ] whileFalse: [ self step ] @@ -224,7 +233,10 @@ SindarinDebugger >> firstPCOfStatement: aStatementNode [ { #category : #'execution predicates' } SindarinDebugger >> hasSignalledUnhandledException [ "Returns true if the debugged execution has signalled an exception that has not been handled by any on:do: (i.e. the #defaultAction of the exception is about to be executed. This default action typically leads to opening a debugger on the process that signalled the exception)" - ^ (#(#defaultAction #signal) includes: self selector ) and: [ self receiver isKindOf: Exception ] + + self flag: 'And `#signalIn:`?'. + ^ (#( #defaultAction #signal ) includes: self selector) and: [ + self receiver isKindOf: Exception ] ] { #category : #private } @@ -234,7 +246,9 @@ SindarinDebugger >> instanceCreationPrimitives [ /* 79 */ primitiveNewMethod, /* 148 */ primitiveClone, /* 160 */ primitiveAdoptInstance" - ^#(70 71 79 148 160) + + self flag: 'These numbers may have changed. This is to be checked'. + ^ #( 70 71 79 148 160 ) ] { #category : #'execution predicates' } @@ -264,7 +278,6 @@ SindarinDebugger >> isExecutionFinished [ { #category : #'API - changes' } SindarinDebugger >> jumpIntoBlock: aBlockNode toNode: targetNode [ - "Moves to targetNode that must be in aBlockNode, which should be a recursive child" | blockClosure newContext firstPCForNode | @@ -272,7 +285,7 @@ SindarinDebugger >> jumpIntoBlock: aBlockNode toNode: targetNode [ firstPCForNode := self methodNode firstPcForNode: aBlockNode. self pc: firstPCForNode. self stepBytecode. - blockClosure := self context top. + blockClosure := self topStack. newContext := blockClosure asContextWithSender: self context. "we need to change the suspended context and do the same in its debug session to see what we do in the debugger" @@ -285,28 +298,16 @@ SindarinDebugger >> jumpIntoBlock: aBlockNode toNode: targetNode [ SindarinDebugger >> message: aSelector [ "Returns whether the execution is about to send a message of selector @aSelector to any object" - | node | - node := self node. - node isMessage - ifFalse: [ ^ false ]. - node selector = aSelector - ifFalse: [ ^ false ]. - ^ true + [ ^ self messageSelector = aSelector ] + on: Error + do: [ ^ false ] ] { #category : #stackAccessHelpers } SindarinDebugger >> message: aSelector to: anObject [ "Returns whether the execution is about to send a message of selector @aSelector to @anObject" - | node | - node := self node. - node isMessage - ifFalse: [ ^ false ]. - node selector = aSelector - ifFalse: [ ^ false ]. - self messageReceiver == anObject - ifFalse: [ ^ false ]. - ^ true + ^ (self message: aSelector) and: [ self messageReceiver == anObject ] ] { #category : #stackAccessHelpers } @@ -329,17 +330,15 @@ SindarinDebugger >> messageArguments [ "Returns the arguments of the message about to be sent, if the current node is a message node." | argumentNumber arguments i | - self node isMessage - ifFalse: [ Error signal: 'Not about to send a message' ]. + self node isMessage ifFalse: [ + Error signal: 'Not about to send a message' ]. argumentNumber := self node arguments size. arguments := OrderedCollection new. i := 0. - [ i = argumentNumber ] - whileFalse: [ arguments - add: - (self context - at: self currentContextStackSize - argumentNumber + i + 1). - i := i + 1 ]. + [ i = argumentNumber ] whileFalse: [ + arguments add: (self context at: + self currentContextStackSize - argumentNumber + i + 1). + i := i + 1 ]. ^ arguments ] @@ -407,7 +406,7 @@ SindarinDebugger >> moveToNode: aNode [ SindarinDebugger >> nextBytecode [ ^ self currentBytecode detect: [ :each | - each offset = self context pc ] + each offset = self pc ] ] { #category : #'API - changes' } @@ -420,7 +419,7 @@ SindarinDebugger >> nextExecutedNodeAfter: aNode [ SindarinDebugger >> node [ "Returns the AST node about to be executed by the top context of the execution" - ^ self context method sourceNodeForPC: self context pc + ^ self nodeForContext: self context ] { #category : #astAndAstMapping } @@ -432,10 +431,11 @@ SindarinDebugger >> nodeForContext: aContext [ { #category : #'graphical debugger' } SindarinDebugger >> openInGraphicalDebugger [ - sindarinSession canBeTerminated: false. "Prevents the graphical debugger from terminating the debug session when it's closed." - self - flag: - 'Should be an extension of DebuggerSelector and handled by its sole instance' + + self flag: 'unused. What was it used for?'. + sindarinSession canBeTerminated: false. "Prevents the graphical debugger from terminating the debug session when it's closed." + self flag: + 'Should be an extension of DebuggerSelector and handled by its sole instance' ] { #category : #'accessing - context' } @@ -496,14 +496,17 @@ SindarinDebugger >> receiver [ { #category : #'graphical debugger' } SindarinDebugger >> refreshAttachedGraphicalDebugger [ + + 'only used by an unused method. What was it used for?'. sindarinSession refreshAttachedDebugger ] { #category : #stackAccess } SindarinDebugger >> restart [ "Resets this debugger on a new execution of the block passed as argument to the initial call to #debug:" + self initialize. - self debug: blockToDebug. + self debug: blockToDebug ] { #category : #'stepping - auto' } @@ -514,6 +517,9 @@ SindarinDebugger >> resume [ { #category : #scripts } SindarinDebugger >> run: aSindarinScript [ + + self flag: + 'missing method for scripts. Scripts are not loaded by default so this method shouldn''t be loaded neither'. aSindarinScript executeWith: self ] @@ -526,22 +532,23 @@ SindarinDebugger >> selector [ { #category : #asserting } SindarinDebugger >> shouldStepIntoInMethod: aRBMethodNode [ + "used by #stpeToReturn to know if it should stepInto or stepOver. It should stepInto to get to non-local returns" | messageNode childrenOfMessageNode | messageNode := self node. messageNode isMessage ifFalse: [ ^ false ]. childrenOfMessageNode := messageNode children. childrenOfMessageNode := childrenOfMessageNode - select: [ :child | - child isBlock or: [ - child isVariable and: [ + select: [ :child | + child isBlock or: [ + child isVariable and: [ (child variableValueInContext: self context) isBlock ] ] ] - thenCollect: [ :child | - child isVariable ifTrue: [ + thenCollect: [ :child | + child isVariable ifTrue: [ (child variableValueInContext: self context) startpcOrOuterCode ast ] ]. - ^ childrenOfMessageNode anySatisfy: [ :child | + ^ childrenOfMessageNode anySatisfy: [ :child | (RBBlockDefinitionSearchingVisitor newToSearch: child) visitNode: aRBMethodNode ] ] @@ -596,14 +603,15 @@ SindarinDebugger >> skip [ SindarinDebugger >> skipAssignmentNodeCompletely [ | currentBytecode | - currentBytecode := self currentBytecode detect: [ :each | - each offset = self context pc ]. + currentBytecode := self nextBytecode. "Pop the value that will be assigned" self context pop. "If the assignment is a store bytecode and not a pop bytecode, we push the current value of the variable that was going to be assigned." - (#( 243 244 245 252 ) includes: currentBytecode bytes first) ifTrue: [ + self flag: + 'Maybe this should be an extension method on the InstructionStream or elsewhere'. + (#( 243 244 245 252 ) includes: currentBytecode bytes first) ifTrue: [ self context push: (self node variable variableValueInContext: self context) ]. @@ -616,27 +624,28 @@ SindarinDebugger >> skipAssignmentNodeCompletely [ { #category : #'stepping - skip' } SindarinDebugger >> skipAssignmentNodeWith: replacementValue [ + "I think this method could be removed." + self context pop. "Pop the value to be assigned" "Push the replacement value on the context's value stack, to simulate that the assignment happened and had value nil" self context push: replacementValue. self step. "Execute bytecodes the debugger usually executes without stopping the execution (for example popping the return value of the just executed message send if it is not used afterwards)" - self debugSession - stepToFirstInterestingBytecodeWithJumpIn: self debugSession interruptedProcess + self debugSession stepToFirstInterestingBytecodeWithJumpIn: + self debugSession interruptedProcess ] { #category : #'stepping - skip' } SindarinDebugger >> skipBlockNode [ | nextBytecode | - nextBytecode := self currentBytecode detect: [ :bytecode | - bytecode offset = self pc ]. + nextBytecode := self nextBytecode. self context pc: self pc + nextBytecode bytes size. self context push: nil. - + self debugSession stepToFirstInterestingBytecodeWithJumpIn: self debugSession interruptedProcess ] @@ -647,10 +656,10 @@ SindarinDebugger >> skipJump [ | instructionStream nextBytecode | instructionStream := self context instructionStream. "If the next bytecode is a jumpTrue: or a jumpFalse: bytecode, then it expects one argument on the stack. As we skip the jump bytecode, we pop it." - (instructionStream willJumpIfFalse or: [ + (instructionStream willJumpIfFalse or: [ instructionStream willJumpIfTrue ]) ifTrue: [ self context pop ]. - nextBytecode := self currentBytecode detect: [ :each | - each offset = self pc ]. + nextBytecode := self nextBytecode. + self flag: 'This could be extracted as a #skipBytecode method'. self context pc: self context pc + nextBytecode bytes size. self debugSession stepToFirstInterestingBytecodeWithJumpIn: self debugSession interruptedProcess @@ -686,6 +695,7 @@ SindarinDebugger >> skipMessageNodeWith: replacementValue [ { #category : #'stepping - skip' } SindarinDebugger >> skipReturnNode [ + self flag: 'We should be able to skip a return node as long as it''s not the last one in the method'. ^ SindarinSkippingReturnWarning signal: 'Cannot skip a return node' ] @@ -789,6 +799,7 @@ SindarinDebugger >> step: anInt [ SindarinDebugger >> stepBatchAndReturnNodeHashAndStackSize [ "For EchoDebugger" | nodesHashAndStackSize count | + self flag: 'What''s that? If it is for the echo debugger, then it should be an extension method of the echo debugger'. count := 0. nodesHashAndStackSize := OrderedCollection new. [ [ count <= 1000] whileTrue: [ count := count + 1. nodesHashAndStackSize add: {self node dictionaryRepresentation hash. self stack size}. self step ]] on: DebuggedExecutionException do: [ "when debugged execution is over or signals exception, stop and return the result data" ^ nodesHashAndStackSize ]. @@ -834,6 +845,7 @@ SindarinDebugger >> stepThrough [ { #category : #'stepping - steps' } SindarinDebugger >> stepToMethodEntry [ + self flag: 'Maybe all the instructionStream API should be in Sindarin, as helpers'. self stepUntil: [ self context instructionStream willSend ]. process step: self context. self debugSession updateContextTo: process suspendedContext @@ -846,16 +858,13 @@ SindarinDebugger >> stepToReturn [ oldContext := self outerMostContextOf: self context. methodAST := self context method ast. - [ - ((self outerMostContextOf: self context) = oldContext and: [ - self context instructionStream willReturn ]) or: [ - self hasSignalledUnhandledException ] ] whileFalse: [ + [ + ((self outerMostContextOf: self context) = oldContext and: [ + self context instructionStream willReturn ]) or: [ + self hasSignalledUnhandledException ] ] whileFalse: [ (self shouldStepIntoInMethod: methodAST) ifTrue: [ self debugSession stepInto ] ifFalse: [ self debugSession stepOver ] ] - "[ - self context instructionStream willReturn or: [ self hasSignalledUnhandledException ] ] - whileFalse: [ self debugSession stepOver ]" ] { #category : #'stepping - steps' } @@ -867,22 +876,26 @@ SindarinDebugger >> stepUntil: aBlock [ { #category : #stackAccessHelpers } SindarinDebugger >> temporaryNamed: aSymbol [ - ^self context tempNamed: aSymbol + + self flag: + 'Why not. But wouldn''t it be more interesting to have an helper for Context>>#readVariableNamed: , to get the value of the variable?'. + ^ self context tempNamed: aSymbol ] { #category : #process } SindarinDebugger >> terminate [ + sindarinSession terminate ] { #category : #stackAccessHelpers } SindarinDebugger >> topStack [ - ^self context top + + ^ self context top ] { #category : #'API - changes' } SindarinDebugger >> tryMoveToNodeInHomeContext: aNode [ - "Moves to node aNode if aNode is in the lexical context. Otherwise, the program state goes back to how it was before trying and signals an error as the node is not in AST" | oldContext | @@ -891,7 +904,7 @@ SindarinDebugger >> tryMoveToNodeInHomeContext: aNode [ self debugSession suspendedContext: oldContext home. [ self moveToNode: aNode ] on: NodeNotInASTError - do: [ + do: [ self currentProcess suspendedContext: oldContext. self debugSession suspendedContext: oldContext. ^ NodeNotInASTError signal ] From 40930c2594d9be6497842a755e6f30720d805d78 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Wed, 22 Mar 2023 11:03:18 +0100 Subject: [PATCH 02/13] removing unused methods + renaming confusing method + setting extension method correctly --- .../SindarinDebugger.extension.st | 7 ++ Sindarin-Tests/SindarinDebuggerTest.class.st | 96 +++++++++---------- Sindarin/SindarinDebugger.class.st | 57 ++--------- 3 files changed, 61 insertions(+), 99 deletions(-) create mode 100644 Sindarin-Scripts/SindarinDebugger.extension.st diff --git a/Sindarin-Scripts/SindarinDebugger.extension.st b/Sindarin-Scripts/SindarinDebugger.extension.st new file mode 100644 index 0000000..de4a9bc --- /dev/null +++ b/Sindarin-Scripts/SindarinDebugger.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #SindarinDebugger } + +{ #category : #'*Sindarin-Scripts' } +SindarinDebugger >> run: aSindarinScript [ + + aSindarinScript executeWith: self +] diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index a272616..2813bc5 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -302,12 +302,12 @@ SindarinDebuggerTest >> testChangingPcInTheMiddleOfStatementSkipsTheBeginningOfS stepOver. "pc of a := 5" - self assert: (scdbg temporaryNamed: #a) equals: 1. + self assert: (scdbg readVariableNamed: #a) equals: 1. scdbg pc: newPc. "It should skip the assignment a:=5 AND skip the beginning of the statement ('3' asInteger)" - self assert: (scdbg temporaryNamed: #a) equals: 1. + self assert: (scdbg readVariableNamed: #a) equals: 1. self assert: scdbg node equals: newNode. self assert: scdbg pc equals: newPc. self deny: scdbg topStack equals: expectedStackTop. @@ -331,11 +331,11 @@ SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnSt stepOver; stepOver. - self assert: (scdbg temporaryNamed: #a) equals: 5. + self assert: (scdbg readVariableNamed: #a) equals: 5. scdbg pc: newPc. - self assert: (scdbg temporaryNamed: #a) equals: 5. + self assert: (scdbg readVariableNamed: #a) equals: 5. self assert: scdbg node equals: newNode. self assert: scdbg pc equals: newPc. self assert: scdbg topStack equals: expectedStackTop @@ -593,12 +593,12 @@ SindarinDebuggerTest >> testMoveToNodeInTheMiddleOfStatementSkipsTheBeginningOfS stepOver. "pc of a := 5" - self assert: (scdbg temporaryNamed: #a) equals: 1. + self assert: (scdbg readVariableNamed: #a) equals: 1. scdbg moveToNode: newNode. "It should skip the assignment a:=5 AND skip the beginning of the statement ('3' asInteger)" - self assert: (scdbg temporaryNamed: #a) equals: 1. + self assert: (scdbg readVariableNamed: #a) equals: 1. self assert: scdbg node equals: newNode. self assert: scdbg pc equals: newPc. self deny: scdbg topStack equals: expectedStackTop. @@ -622,11 +622,11 @@ SindarinDebuggerTest >> testMoveToNodeKeepsSameStateAndPushesCorrectElementsOnSt stepOver; stepOver. - self assert: (scdbg temporaryNamed: #a) equals: 5. + self assert: (scdbg readVariableNamed: #a) equals: 5. scdbg moveToNode: newNode. - self assert: (scdbg temporaryNamed: #a) equals: 5. + self assert: (scdbg readVariableNamed: #a) equals: 5. self assert: scdbg node equals: newNode. self assert: scdbg pc equals: newPc. self assert: scdbg topStack equals: expectedStackTop @@ -756,11 +756,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedBlockToOuterContext [ aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNil. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg context home identicalTo: oldContext. self @@ -770,7 +770,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedBlockToOuterContext [ sdbg stepOver. "2 is going to be assigned to a" - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg topStack equals: 2. sdbg moveToNode: methodNode statements third. @@ -780,7 +780,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedBlockToOuterContext [ "We went back to the home context" self assert: sdbg context identicalTo: oldContext. "2 has not been assigned to a" - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg topStack equals: 1 ] @@ -805,11 +805,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToHomeConte aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNil. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg context home identicalTo: oldContext. self @@ -819,7 +819,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToHomeConte sdbg stepOver. "2 is going to be assigned to a" - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg topStack equals: 2. sdbg moveToNode: methodNode statements third. @@ -829,7 +829,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToHomeConte "We went back to the home context" self assert: sdbg context identicalTo: oldContext. "2 has not been assigned to a" - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg topStack equals: 1 ] @@ -854,11 +854,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToNodeThatI aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNil. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg context home identicalTo: oldContext. self @@ -868,7 +868,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToNodeThatI sdbg stepOver. "2 is going to be assigned to a" - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg topStack equals: 2. oldNode := sdbg node. @@ -883,7 +883,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToNodeThatI "We went back to the home context" self assert: sdbg context identicalTo: oldContext. "2 has not been assigned to a" - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg topStack equals: 2 ] @@ -911,11 +911,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBloc aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNil. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg node identicalTo: aimedNode. self assert: sdbg context sender identicalTo: oldContext. @@ -925,7 +925,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBloc stepOver; stepOver. - self assert: (sdbg temporaryNamed: #a) equals: 2. + self assert: (sdbg readVariableNamed: #a) equals: 2. "When you perform a stepOver, you quit the block and continue right where you were before moving to caret" self assert: sdbg node identicalTo: sdbg methodNode statements third value. @@ -956,11 +956,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBloc aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNil. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg node identicalTo: aimedNode. self assert: sdbg context sender identicalTo: oldContext. @@ -970,7 +970,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBloc stepOver; stepOver. - self assert: (sdbg temporaryNamed: #a) equals: 2. + self assert: (sdbg readVariableNamed: #a) equals: 2. "When you perform a stepOver, you quit the block and continue right where you were before moving to caret" self assert: sdbg node identicalTo: oldNode value. @@ -997,11 +997,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInIfTrueIfFalseBlock [ aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNotNil. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg node identicalTo: aimedNode. self assert: sdbg pc identicalTo: aimedPC. @@ -1009,11 +1009,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInIfTrueIfFalseBlock [ sdbg stepOver. - self assert: (sdbg temporaryNamed: #a) equals: 3. + self assert: (sdbg readVariableNamed: #a) equals: 3. sdbg stepOver. "When you perform a stepOver, you quit the block and continue just after the ifTrue: message" - self assert: (sdbg temporaryNamed: #a) equals: 4 + self assert: (sdbg readVariableNamed: #a) equals: 4 ] { #category : #tests } @@ -1110,11 +1110,11 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsNonInlinedAndEmbeddedInNonInline aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNil. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg readVariableNamed: #a) equals: 1. self assert: sdbg node identicalTo: aimedNode. self assert: sdbg context home identicalTo: oldContext. @@ -1125,7 +1125,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsNonInlinedAndEmbeddedInNonInline stepOver; stepOver. - self assert: (sdbg temporaryNamed: #a) equals: 2. + self assert: (sdbg readVariableNamed: #a) equals: 2. "When you perform a stepOver, you quit the block and continue after the embedded block creation in the embedding block context" self assert: sdbg methodNode identicalTo: methodNode statements second. @@ -1137,7 +1137,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsNonInlinedAndEmbeddedInNonInline stepOver; stepOver. - self assert: (sdbg temporaryNamed: #a) equals: 2. + self assert: (sdbg readVariableNamed: #a) equals: 2. "When you perform stepOver again, you quit the embedding block and continue after the embedding block creation in the old context" self assert: sdbg methodNode identicalTo: methodNode. @@ -1357,7 +1357,7 @@ SindarinDebuggerTest >> testSkipThroughNode [ debug: [ self methodWithTwoAssignments ]. dbg step; stepOver; stepOver. targetExecNode := dbg node. - realValueOfA := (dbg temporaryNamed: #a). + realValueOfA := (dbg readVariableNamed: #a). dbg stepOver. nodeAfterSkipThrough := dbg node. realExecTopStack := dbg topStack. @@ -1371,7 +1371,7 @@ SindarinDebuggerTest >> testSkipThroughNode [ self assert: dbg pc equals: realExecPC. self assert: dbg node identicalTo: nodeAfterSkipThrough. self assert: realValueOfA equals: 5. - self assert: (dbg temporaryNamed: #a) equals: 1. + self assert: (dbg readVariableNamed: #a) equals: 1. self assert: realExecTopStack equals: 3. self assert: dbg topStack equals: '3' ] @@ -1385,7 +1385,7 @@ SindarinDebuggerTest >> testSkipToPC [ dbg step; stepOver; stepOver. realExecPC := dbg pc. realExecNode := dbg node. - realValueOfA := (dbg temporaryNamed: #a). + realValueOfA := (dbg readVariableNamed: #a). realExecTopStack := dbg topStack. dbg := SindarinDebugger @@ -1395,7 +1395,7 @@ SindarinDebuggerTest >> testSkipToPC [ self assert: dbg pc equals: realExecPC. self assert: dbg node equals: realExecNode. self assert: realValueOfA equals: 5. - self assert: (dbg temporaryNamed: #a) equals: 1. + self assert: (dbg readVariableNamed: #a) equals: 1. self assert: dbg topStack equals: realExecTopStack ] @@ -1450,7 +1450,7 @@ SindarinDebuggerTest >> testSkipUpToIgnoresJumps [ statements first. aimedPC := sdbg methodNode firstPcForNode: aimedNode. - a := sdbg temporaryNamed: #a. + a := sdbg readVariableNamed: #a. self assert: a isNil. @@ -1465,7 +1465,7 @@ SindarinDebuggerTest >> testSkipUpToIgnoresJumps [ statements first. aimedPC := sdbg methodNode firstPcForNode: aimedNode. - a := sdbg temporaryNamed: #a. + a := sdbg readVariableNamed: #a. self assert: a isNil. @@ -1479,7 +1479,7 @@ SindarinDebuggerTest >> testSkipUpToIgnoresJumps [ aimedNode := sdbg methodNode statements third. aimedPC := sdbg methodNode firstPcForNode: aimedNode. - a := sdbg temporaryNamed: #a. + a := sdbg readVariableNamed: #a. self assert: a isNil. @@ -1500,7 +1500,7 @@ SindarinDebuggerTest >> testSkipUpToNode [ dbg step; stepOver; stepOver. realExecPC := dbg pc. realExecNode := dbg node. - realValueOfA := (dbg temporaryNamed: #a). + realValueOfA := (dbg readVariableNamed: #a). realExecTopStack := dbg topStack. dbg := SindarinDebugger @@ -1510,7 +1510,7 @@ SindarinDebuggerTest >> testSkipUpToNode [ self assert: dbg pc equals: realExecPC. self assert: dbg node identicalTo: realExecNode. self assert: realValueOfA equals: 5. - self assert: (dbg temporaryNamed: #a) equals: 1. + self assert: (dbg readVariableNamed: #a) equals: 1. self assert: dbg topStack equals: realExecTopStack ] @@ -1546,7 +1546,7 @@ SindarinDebuggerTest >> testSkipUpToNodeInEvaluatedBlock [ stepOver; stepOver; stepThrough. - oldValueOfA := dbg temporaryNamed: #a. + oldValueOfA := dbg readVariableNamed: #a. "after stepping, we stop on b: = 3 + 2 assignment node" dbg stepOver. @@ -1571,12 +1571,12 @@ SindarinDebuggerTest >> testSkipUpToNodeInEvaluatedBlock [ skipUpToNode: realExecNode. self assert: dbg pc equals: realExecPC. self assert: dbg node identicalTo: realExecNode. - self assert: (dbg temporaryNamed: #a) equals: oldValueOfA. + self assert: (dbg readVariableNamed: #a) equals: oldValueOfA. self assert: dbg topStack equals: valueOfBAfterSkipAndStep. dbg stepOver. "3 is on the stack so stepping over the assignment should put 3 into b" - self assert: (dbg temporaryNamed: #b) equals: valueOfBAfterSkipAndStep + self assert: (dbg readVariableNamed: #b) equals: valueOfBAfterSkipAndStep ] { #category : #'tests - skipping' } @@ -1888,9 +1888,9 @@ SindarinDebuggerTest >> testTemporaryNamed [ | dbg | dbg := SindarinDebugger debug: [ self methodWithOneAssignment ]. dbg step. - self assert: (dbg temporaryNamed: #a) equals: nil. + self assert: (dbg readVariableNamed: #a) equals: nil. dbg step. - self assert: (dbg temporaryNamed: #a) equals: 5 + self assert: (dbg readVariableNamed: #a) equals: 5 ] { #category : #tests } diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 3b09614..0a38d04 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -68,14 +68,6 @@ SindarinDebugger class >> debugSession: aDebugSession [ ] -{ #category : #'graphical debugger' } -SindarinDebugger >> activateAutoRefreshOfAttachedGraphicalDebugger [ - - self flag: 'unused. What was it used for?'. - sindarinSession activateEventTriggering. - self refreshAttachedGraphicalDebugger -] - { #category : #stackAccessHelpers } SindarinDebugger >> arguments [ "Returns the arguments of the current stack-frame." @@ -197,12 +189,6 @@ SindarinDebugger >> currentProcess [ ^ process ] -{ #category : #'graphical debugger' } -SindarinDebugger >> deactivateAutoRefreshOfAttachedGraphicalDebugger [ - self flag: 'unused. What was it used for?'. - sindarinSession deactivateEventTriggering -] - { #category : #start } SindarinDebugger >> debug: aBlock [ @@ -429,15 +415,6 @@ SindarinDebugger >> nodeForContext: aContext [ ^ aContext method sourceNodeForPC: aContext pc ] -{ #category : #'graphical debugger' } -SindarinDebugger >> openInGraphicalDebugger [ - - self flag: 'unused. What was it used for?'. - sindarinSession canBeTerminated: false. "Prevents the graphical debugger from terminating the debug session when it's closed." - self flag: - 'Should be an extension of DebuggerSelector and handled by its sole instance' -] - { #category : #'accessing - context' } SindarinDebugger >> outerMostContextOf: aContext [ @@ -487,6 +464,12 @@ SindarinDebugger >> proceed [ ^ self continue ] +{ #category : #stackAccessHelpers } +SindarinDebugger >> readVariableNamed: aSymbol [ + + ^ self context readVariableNamed: aSymbol +] + { #category : #stackAccessHelpers } SindarinDebugger >> receiver [ "Returns the receiver of the current stack-frame." @@ -515,14 +498,6 @@ SindarinDebugger >> resume [ sindarinSession resumeAndClear ] -{ #category : #scripts } -SindarinDebugger >> run: aSindarinScript [ - - self flag: - 'missing method for scripts. Scripts are not loaded by default so this method shouldn''t be loaded neither'. - aSindarinScript executeWith: self -] - { #category : #stackAccessHelpers } SindarinDebugger >> selector [ "Returns the selector of the current stack-frame." @@ -795,18 +770,6 @@ SindarinDebugger >> step: anInt [ anInt timesRepeat: [ self step ] ] -{ #category : #'stepping - echo' } -SindarinDebugger >> stepBatchAndReturnNodeHashAndStackSize [ - "For EchoDebugger" - | nodesHashAndStackSize count | - self flag: 'What''s that? If it is for the echo debugger, then it should be an extension method of the echo debugger'. - count := 0. - nodesHashAndStackSize := OrderedCollection new. - [ [ count <= 1000] whileTrue: [ count := count + 1. nodesHashAndStackSize add: {self node dictionaryRepresentation hash. self stack size}. self step ]] on: DebuggedExecutionException do: [ "when debugged execution is over or signals exception, stop and return the result data" ^ nodesHashAndStackSize ]. - ^ nodesHashAndStackSize - -] - { #category : #'stepping - steps' } SindarinDebugger >> stepBytecode [ "Executes the next bytecode" @@ -874,14 +837,6 @@ SindarinDebugger >> stepUntil: aBlock [ aBlock whileFalse: [ self step ] ] -{ #category : #stackAccessHelpers } -SindarinDebugger >> temporaryNamed: aSymbol [ - - self flag: - 'Why not. But wouldn''t it be more interesting to have an helper for Context>>#readVariableNamed: , to get the value of the variable?'. - ^ self context tempNamed: aSymbol -] - { #category : #process } SindarinDebugger >> terminate [ From 81778dfb62ba76028af35dd0023f2b1c8647551a Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Wed, 22 Mar 2023 14:06:58 +0100 Subject: [PATCH 03/13] second pass: extracting smaller methods + Sindarin-Core --- .../BaselineOfSindarin.class.st | 3 +- .../SindarinDebugSession.class.st | 2 +- Sindarin-Core/SindarinDebugger.class.st | 256 ++++++++ Sindarin-Core/package.st | 1 + Sindarin/InstructionStream.extension.st | 10 + Sindarin/SindarinDebugger.class.st | 408 +++--------- Sindarin/SindarinDebugger.extension.st | 617 ++++++++++++++++++ 7 files changed, 980 insertions(+), 317 deletions(-) rename {Sindarin => Sindarin-Core}/SindarinDebugSession.class.st (98%) create mode 100644 Sindarin-Core/SindarinDebugger.class.st create mode 100644 Sindarin-Core/package.st create mode 100644 Sindarin/SindarinDebugger.extension.st diff --git a/BaselineOfSindarin/BaselineOfSindarin.class.st b/BaselineOfSindarin/BaselineOfSindarin.class.st index 234ede0..5165ad7 100644 --- a/BaselineOfSindarin/BaselineOfSindarin.class.st +++ b/BaselineOfSindarin/BaselineOfSindarin.class.st @@ -12,11 +12,12 @@ BaselineOfSindarin >> baseline: spec [ for: #common do: [ spec + package: 'Sindarin-Core'; package: 'Sindarin'; package: 'Sindarin-Tests'; package: 'Sindarin-Experiments' ]. spec - group: 'default' with: #('Sindarin' 'Sindarin-Tests'); + group: 'default' with: #( 'Sindarin-Core' 'Sindarin' 'Sindarin-Tests'); group: 'experiments' with: #('default' 'Sindarin-Experiments') ] diff --git a/Sindarin/SindarinDebugSession.class.st b/Sindarin-Core/SindarinDebugSession.class.st similarity index 98% rename from Sindarin/SindarinDebugSession.class.st rename to Sindarin-Core/SindarinDebugSession.class.st index e338fea..a585445 100644 --- a/Sindarin/SindarinDebugSession.class.st +++ b/Sindarin-Core/SindarinDebugSession.class.st @@ -11,7 +11,7 @@ Class { 'canBeTerminated', 'debugSession' ], - #category : #'Sindarin-Base' + #category : #'Sindarin-Core' } { #category : #'instance creation' } diff --git a/Sindarin-Core/SindarinDebugger.class.st b/Sindarin-Core/SindarinDebugger.class.st new file mode 100644 index 0000000..6afdd0d --- /dev/null +++ b/Sindarin-Core/SindarinDebugger.class.st @@ -0,0 +1,256 @@ +" +# Start +Get a ScriptableDebugger instance by doing: `ScriptableDebugger debug: [ ]`. +Alternatively, you can get a ScriptableDebugger instance attached on an already existing DebugSession by doing: `ScriptableDebugger attach: aDebugSession` + +# Breakpoints +ScriptableDebugger uses the VirtualBreakpoints class for its breakpoints. +The breakpoints set by ScriptableDebugger are ""virtual"", in the sense that they do not modify any bytecode (as common breakpoints do) and do not show up in the rest of the IDE. They are simply markers indicating that the scritpable debugger should stop the debugged execution if it reaches an ast node or method on which a virtual breakpoint has been set. A virtual breakpoint set by a scriptable debugger instance is ""visible"" by all other scriptable debugger instances. + +Virtual breakpoints were introduced because due to technical limitations, normal breakpoints cannot be set in methods that are already in the stack of the debugged execution. + +# Instance Variables: +- process: the (suspended) Process in which the debugged execution takes place +- debugSession: the DebugSession monitoring the debugged execution. +- stepHooks: OrderedCollection. A list of blocks to be evaluated after each step of the debugged execution +" +Class { + #name : #SindarinDebugger, + #superclass : #Object, + #traits : 'TDebugger', + #classTraits : 'TDebugger classTrait', + #instVars : [ + 'process', + 'sindarinSession', + 'blockToDebug' + ], + #category : #'Sindarin-Core' +} + +{ #category : #start } +SindarinDebugger class >> attachTo: aDebugSession [ + "Returns a new instance of ScriptableDebugger attached to aDebugSession" + + ^ self new attachTo: aDebugSession +] + +{ #category : #actions } +SindarinDebugger class >> closeAllDebuggers [ +