From 8647db7fd467d669090c7a9d935d2d00615739bf Mon Sep 17 00:00:00 2001 From: adri09070 Date: Wed, 29 Jun 2022 08:43:27 +0200 Subject: [PATCH 01/29] Adding first test when moving cursor to the beginning of a statement, checking that the receiver and arguments are pushed on the stack and that nothing is executed --- Sindarin-Tests/SindarinDebuggerTest.class.st | 31 ++++++++++++++++++++ Sindarin/SindarinDebugger.class.st | 11 +++++++ 2 files changed, 42 insertions(+) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index f376524..12fcefb 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -5,6 +5,9 @@ Class { 'breakpointsBeforeTest', 'testObjectPoint' ], + #classInstVars : [ + 'helperMethod1' + ], #category : #'Sindarin-Tests-Base' } @@ -297,6 +300,34 @@ SindarinDebuggerTest >> testAssignmentVariableName [ self assert: scdbg assignmentVariableName equals: #a ] +{ #category : #'tests - skipping' } +SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnStack [ + + | scdbg newPc newNode expectedStackTop | + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver. + "pc of '3' asInteger" + newNode := scdbg node. + newPc := scdbg pc. + expectedStackTop := scdbg topStack. + scdbg + stepOver; + stepOver; + stepOver. + + self assert: (scdbg temporaryNamed: #a) equals: 5. + + scdbg pc: newPc. + + self assert: (scdbg temporaryNamed: #a) equals: 5. + self assert: scdbg node equals: newNode. + self assert: scdbg pc equals: newPc. + self assert: scdbg topStack equals: expectedStackTop +] + { #category : #tests } SindarinDebuggerTest >> testContext [ | scdbg | diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 545f32f..65be67b 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -402,6 +402,17 @@ SindarinDebugger >> pc [ ^ self context pc ] +{ #category : #accessing } +SindarinDebugger >> pc: anInteger [ + + self context pc: anInteger. + [ self context stackPtr > self context numTemps ] whileTrue: [ + self context pop ]. + + self debugSession stepToFirstInterestingBytecodeIn: + self debugSession interruptedProcess +] + { #category : #'stepping - auto' } SindarinDebugger >> proceed [ "alias of #continue" From 3fb665644103bb6ec69b03bed89805e2131f19f2 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 4 Oct 2022 13:34:02 +0200 Subject: [PATCH 02/29] implement API to get the statement node that contains an exact subtree --- Sindarin-Tests/SindarinDebuggerTest.class.st | 35 ++++++++++++++++++++ Sindarin/NodeNotInASTError.class.st | 5 +++ Sindarin/NotValidPcError.class.st | 5 +++ Sindarin/SindarinDebugger.class.st | 17 ++++++++++ 4 files changed, 62 insertions(+) create mode 100644 Sindarin/NodeNotInASTError.class.st create mode 100644 Sindarin/NotValidPcError.class.st diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index c2dbaa6..e8914f2 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -1077,6 +1077,41 @@ SindarinDebuggerTest >> testStack [ self assert: (scdbg stack at: 2) equals: context1 ] +{ #category : #tests } +SindarinDebuggerTest >> testStatementNodeContaining [ + + | sdbg | + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg step; stepOver; stepOver; stepOver. "pc of Point x: y:" + + self assert: (sdbg statementNodeContaining: sdbg node) identicalTo: sdbg methodNode statements last +] + +{ #category : #tests } +SindarinDebuggerTest >> testStatementNodeContainingReturnsStatementNodeThatContainsTheIdenticalSubtree [ + + | sdbg | + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg step. + + "1 is in the tree but it should return its parent only if we provide the exact literal node" + self + should: [ sdbg statementNodeContaining: (RBLiteralNode value: 1) ] + raise: NodeNotInASTError +] + +{ #category : #tests } +SindarinDebuggerTest >> testStatementNodeContainingWhenNodeIsNotInAST [ + + | sdbg | + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg step. + + self + should: [ sdbg statementNodeContaining: (RBLiteralNode value: 2) ] + raise: NodeNotInASTError +] + { #category : #tests } SindarinDebuggerTest >> testStep [ | node scdbg | diff --git a/Sindarin/NodeNotInASTError.class.st b/Sindarin/NodeNotInASTError.class.st new file mode 100644 index 0000000..262b90f --- /dev/null +++ b/Sindarin/NodeNotInASTError.class.st @@ -0,0 +1,5 @@ +Class { + #name : #NodeNotInASTError, + #superclass : #Error, + #category : #'Sindarin-Exceptions' +} diff --git a/Sindarin/NotValidPcError.class.st b/Sindarin/NotValidPcError.class.st new file mode 100644 index 0000000..2aa8b35 --- /dev/null +++ b/Sindarin/NotValidPcError.class.st @@ -0,0 +1,5 @@ +Class { + #name : #NotValidPcError, + #superclass : #Error, + #category : #'Sindarin-Exceptions' +} diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 3ccec11..340c2f5 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -714,6 +714,23 @@ SindarinDebugger >> stack [ ^ self debugSession stack ] +{ #category : #API } +SindarinDebugger >> statementNodeContaining: aNode [ + + | method statementNode parentOfStatementNode | + method := self methodNode. + statementNode := aNode. + parentOfStatementNode := method parentOfIdenticalSubtree: + statementNode. + parentOfStatementNode + ifNil: [ ^ NodeNotInASTError signal ] + ifNotNil: [ + [ parentOfStatementNode isSequence ] whileFalse: [ + statementNode := parentOfStatementNode. + parentOfStatementNode := parentOfStatementNode parent ] ]. + ^ statementNode +] + { #category : #'stepping - steps' } SindarinDebugger >> step [ "Executes the next instruction. If the instruction is a message-send, step inside it." From 30d24a3168e2f18eb44b9aca078dd9cc0b53937a Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 4 Oct 2022 13:42:08 +0200 Subject: [PATCH 03/29] forgot to commit a method --- Sindarin/RBMethodNode.extension.st | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 Sindarin/RBMethodNode.extension.st diff --git a/Sindarin/RBMethodNode.extension.st b/Sindarin/RBMethodNode.extension.st new file mode 100644 index 0000000..93926da --- /dev/null +++ b/Sindarin/RBMethodNode.extension.st @@ -0,0 +1,10 @@ +Extension { #name : #RBMethodNode } + +{ #category : #'*Sindarin' } +RBMethodNode >> parentOfIdenticalSubtree: subtree [ + + ^ self allChildren reversed + detect: [ :e | e == subtree ] + ifFound: [ :e | e parent ] + ifNone: [ nil ] +] From b1058fcf868d8cd77f41966eb22614f1cd6293d7 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 4 Oct 2022 14:04:32 +0200 Subject: [PATCH 04/29] refactoring statementNodeContaining using propagation to RBMethodNode --- Sindarin/RBMethodNode.extension.st | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/Sindarin/RBMethodNode.extension.st b/Sindarin/RBMethodNode.extension.st index 93926da..4b4e9c8 100644 --- a/Sindarin/RBMethodNode.extension.st +++ b/Sindarin/RBMethodNode.extension.st @@ -8,3 +8,19 @@ RBMethodNode >> parentOfIdenticalSubtree: subtree [ ifFound: [ :e | e parent ] ifNone: [ nil ] ] + +{ #category : #'*Sindarin' } +RBMethodNode >> statementNodeContaining: aNode [ + + | statementNode parentOfStatementNode | + statementNode := aNode. + parentOfStatementNode := self parentOfIdenticalSubtree: + statementNode. + parentOfStatementNode + ifNil: [ ^ NodeNotInASTError signal ] + ifNotNil: [ + [ parentOfStatementNode isSequence ] whileFalse: [ + statementNode := parentOfStatementNode. + parentOfStatementNode := parentOfStatementNode parent ] ]. + ^ statementNode +] From bcbda1383a045d0c27065eaf502fb4562f87aaa7 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 4 Oct 2022 14:15:34 +0200 Subject: [PATCH 05/29] tests for changing pc --- Sindarin-Tests/SindarinDebuggerTest.class.st | 32 ++++++++++++++++++-- 1 file changed, 30 insertions(+), 2 deletions(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 6963162..053e397 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -389,7 +389,7 @@ SindarinDebuggerTest >> testCanStillExecuteWhenAimedNodePcIsBeforeInAnyContext [ self deny: (sdbg canStillExecute: aimedNodeOutsideContext) ] -{ #category : #'tests - skipping' } +{ #category : #tests } SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnStack [ | scdbg newPc newNode expectedStackTop | @@ -397,13 +397,13 @@ SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnSt scdbg step; + stepOver; stepOver. "pc of '3' asInteger" newNode := scdbg node. newPc := scdbg pc. expectedStackTop := scdbg topStack. scdbg - stepOver; stepOver; stepOver. @@ -417,6 +417,34 @@ SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnSt self assert: scdbg topStack equals: expectedStackTop ] +{ #category : #tests } +SindarinDebuggerTest >> testChangingPcRaisesErrorWhenPcIsLowerThanInitialPC [ + + | scdbg newPc newNode expectedStackTop | + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver; + stepOver. + + self shouldnt: [ scdbg pc: scdbg method initialPC ] raise: NotValidPcError. + + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver; + stepOver. + + self should: [ scdbg pc: scdbg method initialPC - 1 ] raise: NotValidPcError. + + self assert: (scdbg temporaryNamed: #a) equals: 5. + self assert: scdbg node equals: newNode. + self assert: scdbg pc equals: newPc. + self assert: scdbg topStack equals: expectedStackTop +] + { #category : #tests } SindarinDebuggerTest >> testContext [ | scdbg | From 00fbf26f414d4ea8d16d39c3d74de39d229d7800 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 7 Oct 2022 09:30:39 +0200 Subject: [PATCH 06/29] =?UTF-8?q?Allowing=20`pc=C3=82=C2=A0:`=20to=20move?= =?UTF-8?q?=20pc,=20while=20ensuring=20that=20the=20right=20number=20of=20?= =?UTF-8?q?arguments=20is=20pushed=20on=20the=20stack=20(without=20executi?= =?UTF-8?q?ng=20any=20instruction)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Sindarin-Tests/SindarinDebuggerTest.class.st | 69 +++++++++++++++++--- Sindarin/RBMethodNode.extension.st | 13 ++++ Sindarin/SindarinDebugger.class.st | 24 ++++++- 3 files changed, 95 insertions(+), 11 deletions(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 053e397..69922f1 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -390,7 +390,7 @@ SindarinDebuggerTest >> testCanStillExecuteWhenAimedNodePcIsBeforeInAnyContext [ ] { #category : #tests } -SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnStack [ +SindarinDebuggerTest >> testChangingPcInTheMiddleOfStatementSkipsTheBeginningOfStatement [ | scdbg newPc newNode expectedStackTop | scdbg := SindarinDebugger debug: [ self helperMethod1 ]. @@ -398,8 +398,42 @@ SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnSt scdbg step; stepOver; + stepOver; stepOver. - "pc of '3' asInteger" + "pc of Point x: y:" + newNode := scdbg node. + newPc := scdbg pc. + expectedStackTop := scdbg topStack. + + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver. + "pc of a := 5" + + self assert: (scdbg temporaryNamed: #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 node equals: newNode. + self assert: scdbg pc equals: newPc. + self deny: scdbg topStack equals: expectedStackTop. + self assert: scdbg topStack equals: '3' "topStack is nil because the message send asInteger to the receiver '3' has been skipped" +] + +{ #category : #tests } +SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnStack [ + + | scdbg newPc newNode expectedStackTop | + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver. + "pc of a := 5" newNode := scdbg node. newPc := scdbg pc. expectedStackTop := scdbg topStack. @@ -417,10 +451,34 @@ SindarinDebuggerTest >> testChangingPcKeepsSameStateAndPushesCorrectElementsOnSt self assert: scdbg topStack equals: expectedStackTop ] +{ #category : #tests } +SindarinDebuggerTest >> testChangingPcRaisesErrorWhenPcIsGreaterThanEndPC [ + + | oldPC sdbg | + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg + step; + stepOver; + stepOver. + oldPC := sdbg pc. + self + shouldnt: [ sdbg pc: sdbg method endPC ] raise: NotValidPcError; + deny: sdbg pc equals: oldPC. + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg + step; + stepOver; + stepOver. + oldPC := sdbg pc. + self + should: [ sdbg pc: sdbg method endPC + 1 ] raise: NotValidPcError; + assert: sdbg pc equals: oldPC +] + { #category : #tests } SindarinDebuggerTest >> testChangingPcRaisesErrorWhenPcIsLowerThanInitialPC [ - | scdbg newPc newNode expectedStackTop | + | scdbg | scdbg := SindarinDebugger debug: [ self helperMethod1 ]. scdbg @@ -438,11 +496,6 @@ SindarinDebuggerTest >> testChangingPcRaisesErrorWhenPcIsLowerThanInitialPC [ stepOver. self should: [ scdbg pc: scdbg method initialPC - 1 ] raise: NotValidPcError. - - self assert: (scdbg temporaryNamed: #a) equals: 5. - self assert: scdbg node equals: newNode. - self assert: scdbg pc equals: newPc. - self assert: scdbg topStack equals: expectedStackTop ] { #category : #tests } diff --git a/Sindarin/RBMethodNode.extension.st b/Sindarin/RBMethodNode.extension.st index 4b4e9c8..d62b2ff 100644 --- a/Sindarin/RBMethodNode.extension.st +++ b/Sindarin/RBMethodNode.extension.st @@ -1,5 +1,18 @@ Extension { #name : #RBMethodNode } +{ #category : #'*Sindarin' } +RBMethodNode >> firstPCOfStatement: aStatementNode [ + + | indexOfStatementNode statementBefore lastPcInStatementBefore | + indexOfStatementNode := self statements identityIndexOf: + aStatementNode. + indexOfStatementNode == 1 ifTrue: [ ^ self compiledMethod initialPC ]. + statementBefore := self statements at: indexOfStatementNode - 1. + lastPcInStatementBefore := self lastPcForNode: statementBefore. + ^ self bcToASTCache bcToASTMap keys sorted detect: [ :key | + key > lastPcInStatementBefore ] +] + { #category : #'*Sindarin' } RBMethodNode >> parentOfIdenticalSubtree: subtree [ diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index c0d14a9..3cb40bc 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -242,6 +242,12 @@ SindarinDebugger >> debugSession [ ^ sindarinSession debugSession ] +{ #category : #accessing } +SindarinDebugger >> firstPCOfStatement: aStatementNode [ + + ^ self methodNode firstPCOfStatement: aStatementNode +] + { #category : #private } 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)" @@ -434,12 +440,24 @@ SindarinDebugger >> pc [ { #category : #accessing } SindarinDebugger >> pc: anInteger [ - self context pc: anInteger. + | statementNodeContainingNextNode nextNode firstExecutedNodeInStatement methodNode firstPCOfStatementNode | + (anInteger < self method initialPC or: [ + anInteger > self method endPC ]) ifTrue: [ + ^ NotValidPcError signal ]. + methodNode := self methodNode. + nextNode := methodNode sourceNodeForPC: anInteger. + statementNodeContainingNextNode := self statementNodeContaining: + nextNode. + firstPCOfStatementNode := self firstPCOfStatement: + statementNodeContainingNextNode. + firstExecutedNodeInStatement := methodNode sourceNodeForPC: + firstPCOfStatementNode. [ self context stackPtr > self context numTemps ] whileTrue: [ self context pop ]. - + self context pc: self method initialPC. self debugSession stepToFirstInterestingBytecodeIn: - self debugSession interruptedProcess + self debugSession interruptedProcess. + self skipUpToNode: nextNode ] { #category : #'stepping - auto' } From 0b8bc1472c0196056aea2dd32329a646c97b6c6b Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Mon, 10 Oct 2022 12:37:02 +0200 Subject: [PATCH 07/29] Adding moveToNode: method for classic cases --- Sindarin-Tests/SindarinDebuggerTest.class.st | 148 +++++++++++++++++++ Sindarin/SindarinDebugger.class.st | 13 ++ 2 files changed, 161 insertions(+) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 69922f1..e20a38c 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -668,6 +668,154 @@ SindarinDebuggerTest >> testMethod [ self assert: scdbg method equals: String>>#asInteger ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeInTheMiddleOfStatementSkipsTheBeginningOfStatement [ + + | scdbg newPc newNode expectedStackTop | + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver; + stepOver; + stepOver. + "pc of Point x: y:" + newNode := scdbg node. + newPc := scdbg pc. + expectedStackTop := scdbg topStack. + + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver. + "pc of a := 5" + + self assert: (scdbg temporaryNamed: #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 node equals: newNode. + self assert: scdbg pc equals: newPc. + self deny: scdbg topStack equals: expectedStackTop. + self assert: scdbg topStack equals: '3' "topStack is nil because the message send asInteger to the receiver '3' has been skipped" +] + +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeKeepsSameStateAndPushesCorrectElementsOnStack [ + + | scdbg newPc newNode expectedStackTop | + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver. + "pc of a := 5" + newNode := scdbg node. + newPc := scdbg pc. + expectedStackTop := scdbg topStack. + scdbg + stepOver; + stepOver. + + self assert: (scdbg temporaryNamed: #a) equals: 5. + + scdbg moveToNode: newNode. + + self assert: (scdbg temporaryNamed: #a) equals: 5. + self assert: scdbg node equals: newNode. + self assert: scdbg pc equals: newPc. + self assert: scdbg topStack equals: expectedStackTop +] + +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeRaisesErrorWhenNodeIsNotIdenticalToANodeInMethod [ + + | oldNode sdbg aimedNode | + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg + step; + stepOver. + aimedNode := sdbg node. + sdbg + stepOver; + stepOver. + oldNode := sdbg node. + self + shouldnt: [ sdbg moveToNode: aimedNode ] raise: NodeNotInASTError; + assert: sdbg node equals: aimedNode. + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg + step; + stepOver; + stepOver. + oldNode := sdbg node. + self + should: [ sdbg moveToNode: (RBLiteralValueNode value: 1) ] + raise: NodeNotInASTError; + assert: sdbg node equals: oldNode +] + +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeRaisesErrorWhenNodeIsNotInMethod [ + + | oldNode sdbg | + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg + step; + stepOver; + stepOver. + oldNode := sdbg node. + self + shouldnt: [ sdbg moveToNode: sdbg methodNode statements last ] + raise: NodeNotInASTError; + deny: sdbg node equals: oldNode. + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg + step; + stepOver; + stepOver. + oldNode := sdbg node. + self + should: [ sdbg moveToNode: (RBLiteralValueNode value: 2) ] + raise: NodeNotInASTError; + assert: sdbg node equals: oldNode +] + +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenNodeIsLiteralOrVariableExecutesAssociatedBytecodesBecauseRelatedToStack [ + + | oldNode sdbg aimedNode siblingsAfterAimedNode indexOfAimedNode realNode indexOfRealNode | + sdbg := SindarinDebugger debug: [ self helperMethod1 ]. + sdbg step. + oldNode := sdbg node. + "This is the literal value node 5 from `Point x: 5 y: '3' asInteger" + aimedNode := sdbg methodNode statements last value receiver. + indexOfAimedNode := sdbg methodNode allChildren indexOf: aimedNode. + siblingsAfterAimedNode := sdbg methodNode allChildren + withIndexSelect: [ :value :index | + index > indexOfAimedNode ]. + + self deny: (sdbg methodNode pcsForNode: aimedNode) isEmpty. + self assert: aimedNode isVariable. + + sdbg moveToNode: aimedNode. + + realNode := sdbg node. + indexOfRealNode := siblingsAfterAimedNode indexOf: realNode. + + self deny: realNode identicalTo: aimedNode. + siblingsAfterAimedNode + from: 1 + to: indexOfRealNode - 1 + do: [ :each | + self assert: (each isVariable or: [ each isLiteralNode ]) ]. + + self deny: (realNode isLiteralNode or: [ realNode isVariable ]) +] + { #category : #tests } SindarinDebuggerTest >> testNode [ | node scdbg | diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 3cb40bc..d939b65 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -391,6 +391,19 @@ SindarinDebugger >> methodNode [ ^ self method ast ] +{ #category : #'API - changes' } +SindarinDebugger >> moveToNode: aNode [ + + | firstPCForNode | + firstPCForNode := self methodNode firstPcForNode: aNode. + + firstPCForNode ifNil: [ + (self methodNode parentOfIdenticalSubtree: aNode) ifNil: [ + ^ NodeNotInASTError signal ] ]. + + self pc: firstPCForNode +] + { #category : #'accessing - bytes' } SindarinDebugger >> nextBytecode [ From 74d9c3d59c5835c76bcf94206da55fb27d3c7e97 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 11 Oct 2022 13:23:15 +0200 Subject: [PATCH 08/29] fixing pc: that was always rewinding to initialPC + making it possible to go to a pc associated to a method or sequence node that are not (necessarily) contained in a statement --- Sindarin-Tests/SindarinDebuggerTest.class.st | 21 ++++++++++++++++++ Sindarin/SindarinDebugger.class.st | 23 +++++++++++--------- 2 files changed, 34 insertions(+), 10 deletions(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index e20a38c..d200c45 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -389,6 +389,27 @@ SindarinDebuggerTest >> testCanStillExecuteWhenAimedNodePcIsBeforeInAnyContext [ self deny: (sdbg canStillExecute: aimedNodeOutsideContext) ] +{ #category : #tests } +SindarinDebuggerTest >> testChangingPcAssociatedToMethodOrSequenceNodeKeepsStackAsItIs [ + + | scdbg newPc newNode expectedStackTop | + scdbg := SindarinDebugger debug: [ + self helperMethodWithDoubleAssignment ]. + + scdbg + step; + stepOver. + newNode := scdbg methodNode. + newPc := scdbg methodNode firstPcForNode: newNode. + expectedStackTop := scdbg topStack. + + scdbg pc: newPc. + + self assert: scdbg node equals: newNode. + self assert: scdbg pc equals: newPc. + self assert: scdbg topStack equals: expectedStackTop +] + { #category : #tests } SindarinDebuggerTest >> testChangingPcInTheMiddleOfStatementSkipsTheBeginningOfStatement [ diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index d939b65..1f0c9ca 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -453,21 +453,24 @@ SindarinDebugger >> pc [ { #category : #accessing } SindarinDebugger >> pc: anInteger [ - | statementNodeContainingNextNode nextNode firstExecutedNodeInStatement methodNode firstPCOfStatementNode | + | statementNodeContainingNextNode nextNode methodNode firstPCOfStatementNode | (anInteger < self method initialPC or: [ anInteger > self method endPC ]) ifTrue: [ ^ NotValidPcError signal ]. methodNode := self methodNode. nextNode := methodNode sourceNodeForPC: anInteger. - statementNodeContainingNextNode := self statementNodeContaining: - nextNode. - firstPCOfStatementNode := self firstPCOfStatement: - statementNodeContainingNextNode. - firstExecutedNodeInStatement := methodNode sourceNodeForPC: - firstPCOfStatementNode. - [ self context stackPtr > self context numTemps ] whileTrue: [ - self context pop ]. - self context pc: self method initialPC. + (nextNode == methodNode or: [ nextNode == methodNode body ]) + ifTrue: [ firstPCOfStatementNode := anInteger ] + ifFalse: [ + statementNodeContainingNextNode := self statementNodeContaining: + nextNode. + firstPCOfStatementNode := self firstPCOfStatement: + statementNodeContainingNextNode. + "firstExecutedNodeInStatement := methodNode sourceNodeForPC: + firstPCOfStatementNode." + [ self context stackPtr > self context numTemps ] whileTrue: [ + self context pop ] ]. + self context pc: firstPCOfStatementNode. self debugSession stepToFirstInterestingBytecodeIn: self debugSession interruptedProcess. self skipUpToNode: nextNode From 504de9095644bfd522d9a8a0bd60ec0ed06e2a50 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 11 Oct 2022 13:26:40 +0200 Subject: [PATCH 09/29] making moveToNode: work if the aimed node is a literal value node or a variable node that has (or doesn't have) an associated pc + making moveToNode: work if the aimed node is a method node that has an assicuated pc --- Sindarin-Tests/SindarinDebuggerTest.class.st | 76 +++++++++++++++++++- Sindarin/RBProgramNode.extension.st | 12 ++++ Sindarin/SindarinDebugger.class.st | 16 ++++- 3 files changed, 99 insertions(+), 5 deletions(-) create mode 100644 Sindarin/RBProgramNode.extension.st diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index d200c45..e07748f 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -242,6 +242,13 @@ SindarinDebuggerTest >> helperMethodWithBlockWithNoReturn [ ^ 43 ] +{ #category : #helpers } +SindarinDebuggerTest >> helperMethodWithDoubleAssignment [ + + | b a | + a := b := 1 +] + { #category : #helpers } SindarinDebuggerTest >> helperMethodWithEvaluatedBlock [ @@ -751,6 +758,28 @@ SindarinDebuggerTest >> testMoveToNodeKeepsSameStateAndPushesCorrectElementsOnSt self assert: scdbg topStack equals: expectedStackTop ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeKeepsStackWhenAimedNodeIsMethodNode [ + + | scdbg newPc newNode expectedStackTop | + scdbg := SindarinDebugger debug: [ + self helperMethodWithDoubleAssignment ]. + + scdbg + step; + stepOver. + "pc of a := 5" + newNode := scdbg methodNode. + newPc := scdbg methodNode firstPcForNode: scdbg methodNode. + expectedStackTop := scdbg topStack. + + scdbg moveToNode: newNode. + + self assert: scdbg node equals: newNode. + self assert: scdbg pc equals: newPc. + self assert: scdbg topStack equals: expectedStackTop +] + { #category : #tests } SindarinDebuggerTest >> testMoveToNodeRaisesErrorWhenNodeIsNotIdenticalToANodeInMethod [ @@ -812,10 +841,10 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsLiteralOrVariableExecutesAssocia sdbg := SindarinDebugger debug: [ self helperMethod1 ]. sdbg step. oldNode := sdbg node. - "This is the literal value node 5 from `Point x: 5 y: '3' asInteger" + "This is the literal variable Point from `Point x: 5 y: '3' asInteger" aimedNode := sdbg methodNode statements last value receiver. - indexOfAimedNode := sdbg methodNode allChildren indexOf: aimedNode. - siblingsAfterAimedNode := sdbg methodNode allChildren + indexOfAimedNode := sdbg methodNode allChildrenPostOrder identityIndexOf: aimedNode. + siblingsAfterAimedNode := sdbg methodNode allChildrenPostOrder withIndexSelect: [ :value :index | index > indexOfAimedNode ]. @@ -837,6 +866,47 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsLiteralOrVariableExecutesAssocia self deny: (realNode isLiteralNode or: [ realNode isVariable ]) ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenNodeIsLiteralOrVariableThatHasNoAssociatedBytecodesMovesToNextNodeThatIsNotLiteralNorVariableThatHasAnAssociatedPC [ + + | oldNode sdbg aimedNode siblingsAfterAimedNode indexOfAimedNode realNode indexOfRealNode | + sdbg := SindarinDebugger debug: [ + self helperMethodWithDoubleAssignment ]. + sdbg step. + oldNode := sdbg node. + "This is the variable node b from `a:= b:= 1`" + aimedNode := sdbg methodNode statements first value variable. + indexOfAimedNode := sdbg methodNode allChildrenPostOrder identityIndexOf: + aimedNode. + siblingsAfterAimedNode := sdbg methodNode allChildrenPostOrder + withIndexSelect: [ :value :index | + index > indexOfAimedNode ]. + + self assert: (sdbg methodNode pcsForNode: aimedNode) isEmpty. + + sdbg moveToNode: aimedNode. + + realNode := sdbg node. + indexOfRealNode := siblingsAfterAimedNode identityIndexOf: realNode. + + self deny: realNode identicalTo: aimedNode. + siblingsAfterAimedNode + from: 1 + to: indexOfRealNode - 1 + do: [ :each | + self assert: (each isVariable or: [ + each isLiteralNode or: [ + (sdbg methodNode pcsForNode: each) isEmpty ] ]) ]. + + " Why doesn't it work ?? + self deny: (realNode isLiteralNode or: [ realNode isVariable or: [ (sdbg methodNode pcsForNode: realNode) isEmpty  ] ]) " + + self + deny: realNode isLiteralNode; + deny: realNode isVariable; + deny: (sdbg methodNode pcsForNode: realNode) isEmpty +] + { #category : #tests } SindarinDebuggerTest >> testNode [ | node scdbg | diff --git a/Sindarin/RBProgramNode.extension.st b/Sindarin/RBProgramNode.extension.st new file mode 100644 index 0000000..612a11b --- /dev/null +++ b/Sindarin/RBProgramNode.extension.st @@ -0,0 +1,12 @@ +Extension { #name : #RBProgramNode } + +{ #category : #'*Sindarin' } +RBProgramNode >> allChildrenPostOrder [ + + | children | + children := OrderedCollection new. + self children do: [ :each | + each allChildrenPostOrder do: [ :child | children addLast: child ] ]. + children addLast: self. + ^ children +] diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 1f0c9ca..d20bda9 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -398,8 +398,20 @@ SindarinDebugger >> moveToNode: aNode [ firstPCForNode := self methodNode firstPcForNode: aNode. firstPCForNode ifNil: [ - (self methodNode parentOfIdenticalSubtree: aNode) ifNil: [ - ^ NodeNotInASTError signal ] ]. + (self methodNode parentOfIdenticalSubtree: aNode) + ifNil: [ ^ NodeNotInASTError signal ] + ifNotNil: [ :parent | + | nodesAfter indexOfNode indexOfNextNode nextNode | + nodesAfter := self methodNode allChildrenPostOrder. + indexOfNode := nodesAfter identityIndexOf: aNode. + nodesAfter := nodesAfter withIndexSelect: [ :value :index | + index > indexOfNode ]. + "if aimed node has no associated pc, we find the first node executed after him (in pre-order) that has at least one associated pc" + indexOfNextNode := nodesAfter findFirst: [ :each | + (self methodNode firstPcForNode: each) + isNotNil ]. + nextNode := nodesAfter at: indexOfNextNode. + firstPCForNode := self methodNode firstPcForNode: nextNode ] ]. self pc: firstPCForNode ] From a49670415271a2a899ed45c18ab626d1f00343f8 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 11 Oct 2022 13:40:56 +0200 Subject: [PATCH 10/29] Making moveToNode: work when the aimed node is a method node that has no associated pc --- Sindarin-Tests/SindarinDebuggerTest.class.st | 27 ++++++++++++++++++++ Sindarin/SindarinDebugger.class.st | 5 +++- 2 files changed, 31 insertions(+), 1 deletion(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index e07748f..920f224 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -780,6 +780,33 @@ SindarinDebuggerTest >> testMoveToNodeKeepsStackWhenAimedNodeIsMethodNode [ self assert: scdbg topStack equals: expectedStackTop ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeKeepsStackWhenAimedNodeIsMethodNodeThatDoesNotHaveAssociatedPC [ + + | scdbg newPc newNode realPC realNode | + scdbg := SindarinDebugger debug: [ self helperMethod1 ]. + + scdbg + step; + stepOver. + "pc of a := 5" + newNode := scdbg methodNode. + newPc := scdbg methodNode firstPcForNode: scdbg methodNode. + + + self assert: newPc isNil. + + scdbg moveToNode: newNode. + + realPC := scdbg pc. + realNode := scdbg node. + + self assert: scdbg pc equals: scdbg method endPC. + self + assert: scdbg node + identicalTo: (scdbg methodNode sourceNodeForPC: scdbg pc) +] + { #category : #tests } SindarinDebuggerTest >> testMoveToNodeRaisesErrorWhenNodeIsNotIdenticalToANodeInMethod [ diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index d20bda9..a936c32 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -399,7 +399,10 @@ SindarinDebugger >> moveToNode: aNode [ firstPCForNode ifNil: [ (self methodNode parentOfIdenticalSubtree: aNode) - ifNil: [ ^ NodeNotInASTError signal ] + ifNil: [ + (aNode == self methodNode or: [ aNode == self methodNode body ]) + ifTrue: [ firstPCForNode := self method endPC ] + ifFalse: [ ^ NodeNotInASTError signal ] ] ifNotNil: [ :parent | | nodesAfter indexOfNode indexOfNextNode nextNode | nodesAfter := self methodNode allChildrenPostOrder. From d1444b8799b11ff311feaae17618401501d00d9d Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Tue, 11 Oct 2022 14:27:41 +0200 Subject: [PATCH 11/29] adding test when changing pc to a non-existing bytecode offset --- Sindarin-Tests/SindarinDebuggerTest.class.st | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 920f224..7fa7853 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -526,6 +526,26 @@ SindarinDebuggerTest >> testChangingPcRaisesErrorWhenPcIsLowerThanInitialPC [ self should: [ scdbg pc: scdbg method initialPC - 1 ] raise: NotValidPcError. ] +{ #category : #tests } +SindarinDebuggerTest >> testChangingPcToNonExistingBytecodeOffsetGoesToPreviousPcWithExistingBytecodeOffset [ + + | scdbg newPc newNode | + scdbg := SindarinDebugger debug: [ + self helperMethodWithDoubleAssignment ]. + + scdbg step. + "pc of b := 1 from `a:= b:= 1` This is associated to the pc of a storeIntoTemp bytecode, of length 2 bytes. So we add 1 to get a pc that is in the middle of the bytecode" + newNode := scdbg methodNode statements first value. + newPc := (scdbg methodNode firstPcForNode: newNode) + 1. + + self assert: (scdbg methodNode sourceNodeForPC: newPc) identicalTo: newNode. + + scdbg pc: newPc. + + self assert: scdbg node equals: newNode. + self assert: scdbg pc equals: newPc - 1. +] + { #category : #tests } SindarinDebuggerTest >> testContext [ | scdbg | From dc88d0486a7d942209be64b56bca4f20e1cd2b66 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Mon, 17 Oct 2022 11:23:10 +0200 Subject: [PATCH 12/29] Implementing logic to enter blocks. It doesn't work because the debug session's interrupted context --- Sindarin-Tests/SindarinDebuggerTest.class.st | 106 +++++++++++++++++++ Sindarin/RBMethodNode.extension.st | 4 +- Sindarin/SindarinDebugger.class.st | 43 +++++++- 3 files changed, 147 insertions(+), 6 deletions(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 7fa7853..f8950ab 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -260,6 +260,25 @@ SindarinDebuggerTest >> helperMethodWithEvaluatedBlock [ ] +{ #category : #helpers } +SindarinDebuggerTest >> helperMethodWithIfTrueBlock [ + + | a | + a := 1. + a = 2 ifTrue: [ a := 3 ]. + a := 4 +] + +{ #category : #helpers } +SindarinDebuggerTest >> helperMethodWithNotEvaluatedBlock [ + + | a | + a := 0. + [ a := a + 1 ]. + a := a + 2. + ^ a * 42 +] + { #category : #helpers } SindarinDebuggerTest >> helperMethodWithSeveralInstructionsInBlock [ @@ -881,6 +900,93 @@ SindarinDebuggerTest >> testMoveToNodeRaisesErrorWhenNodeIsNotInMethod [ assert: sdbg node equals: oldNode ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBlockHasBeenCreated [ + + | oldNode sdbg aimedNode oldContext aimedPC | + sdbg := SindarinDebugger debug: [ + self helperMethodWithNotEvaluatedBlock ]. + sdbg + step; + stepOver; + stepOver; + stepOver. + + sdbg moveToNode: sdbg methodNode statements first. + + "It is going to execute the comparison a = 2" + oldNode := sdbg node. + oldContext := sdbg context. + + "We want to enter the block, to get to execute a:=3" + aimedNode := sdbg methodNode statements second body statements first + value. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + self assert: aimedPC isNil. + self assert: (sdbg temporaryNamed: #a) equals: 0. + + sdbg moveToNode: aimedNode. + + self assert: (sdbg temporaryNamed: #a) equals: 0. + + self assert: sdbg node identicalTo: aimedNode. + self assert: sdbg context sender identicalTo: oldContext. + + sdbg + stepOver; + stepOver. + + self assert: (sdbg temporaryNamed: #a) equals: 1. + + sdbg + stepOver; + stepOver; + stepOver. + "When you perform a stepOver, you quit the block and continue just after the ifTrue: message" + self assert: (sdbg temporaryNamed: #a) equals: 3. + self assert: sdbg topStack equals: 42 +] + +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInIfTrueIfFalseBlock [ + + | oldNode sdbg aimedNode oldContext aimedPC | + self skip. + sdbg := SindarinDebugger debug: [ self helperMethodWithIfTrueBlock ]. + sdbg + step; + stepOver. + + "It is going to execute the comparison a = 2" + oldNode := sdbg node. + oldContext := sdbg context. + + "We want to enter the block, to get to execute a:=3" + aimedNode := sdbg methodNode statements second arguments first body + statements first. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + self assert: aimedPC isNotNil. + self assert: (sdbg temporaryNamed: #a) equals: 1. + + sdbg moveToNode: aimedNode. + + self assert: (sdbg temporaryNamed: #a) equals: 1. + + self assert: sdbg node identicalTo: aimedNode. + self assert: sdbg pc identicalTo: aimedPC. + self assert: sdbg context identicalTo: oldContext. + + sdbg stepOver. + + self assert: (sdbg temporaryNamed: #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 +] + { #category : #tests } SindarinDebuggerTest >> testMoveToNodeWhenNodeIsLiteralOrVariableExecutesAssociatedBytecodesBecauseRelatedToStack [ diff --git a/Sindarin/RBMethodNode.extension.st b/Sindarin/RBMethodNode.extension.st index d62b2ff..704e3b9 100644 --- a/Sindarin/RBMethodNode.extension.st +++ b/Sindarin/RBMethodNode.extension.st @@ -6,7 +6,9 @@ RBMethodNode >> firstPCOfStatement: aStatementNode [ | indexOfStatementNode statementBefore lastPcInStatementBefore | indexOfStatementNode := self statements identityIndexOf: aStatementNode. - indexOfStatementNode == 1 ifTrue: [ ^ self compiledMethod initialPC ]. + indexOfStatementNode == 1 ifTrue: [ + ^ self bcToASTCache bcToASTMap keys sorted detect: [ :key | + (self sourceNodeForPC: key) statementNode == aStatementNode ] ]. statementBefore := self statements at: indexOfStatementNode - 1. lastPcInStatementBefore := self lastPcForNode: statementBefore. ^ self bcToASTCache bcToASTMap keys sorted detect: [ :key | diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index a936c32..e058947 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -397,7 +397,7 @@ SindarinDebugger >> moveToNode: aNode [ | firstPCForNode | firstPCForNode := self methodNode firstPcForNode: aNode. - firstPCForNode ifNil: [ + firstPCForNode ifNil: [ "]" (self methodNode parentOfIdenticalSubtree: aNode) ifNil: [ (aNode == self methodNode or: [ aNode == self methodNode body ]) @@ -405,6 +405,15 @@ SindarinDebugger >> moveToNode: aNode [ ifFalse: [ ^ NodeNotInASTError signal ] ] ifNotNil: [ :parent | | nodesAfter indexOfNode indexOfNextNode nextNode | + "aNode statementNode parent parent isBlock ifTrue: [ + | newContext blockClosure | + blockClosure := aNode statementNode parent parent evaluate. + newContext := blockClosure asContextWithSender: self context. + ""we need to change the suspended context and maybe do the same in its debug session"" + self currentProcess suspendedContext: newContext. + self debugSession + process: self currentProcess + context: newContext ].""ifFalse: [ " nodesAfter := self methodNode allChildrenPostOrder. indexOfNode := nodesAfter identityIndexOf: aNode. nodesAfter := nodesAfter withIndexSelect: [ :value :index | @@ -414,7 +423,22 @@ SindarinDebugger >> moveToNode: aNode [ (self methodNode firstPcForNode: each) isNotNil ]. nextNode := nodesAfter at: indexOfNextNode. - firstPCForNode := self methodNode firstPcForNode: nextNode ] ]. + firstPCForNode := self methodNode firstPcForNode: nextNode. + nextNode isBlock ifTrue: [ + | newContext blockClosure olderPC | + olderPC := self pc. + "We move to the block node pc to get its full block closure" + self pc: firstPCForNode. + self stepBytecode. + "The array of temps is missing on the stack. The last bytecode of the previous statement pushes it." + blockClosure := self context pop. + newContext := blockClosure asContextWithSender: self context. + self pc: olderPC. + "we need to change the suspended context and maybe do the same in its debug session" + self currentProcess suspendedContext: newContext. + self debugSession process: self currentProcess context: newContext. + "This does an infinite loop because it doesn't actually change the interrupted context in the debug session" + ^ self moveToNode: aNode ] ] ]. self pc: firstPCForNode ] @@ -476,11 +500,20 @@ SindarinDebugger >> pc: anInteger [ nextNode := methodNode sourceNodeForPC: anInteger. (nextNode == methodNode or: [ nextNode == methodNode body ]) ifTrue: [ firstPCOfStatementNode := anInteger ] - ifFalse: [ - statementNodeContainingNextNode := self statementNodeContaining: + ifFalse: [ "statementNodeContainingNextNode := self statementNodeContaining: nextNode. + [ statementNodeContainingNextNode parent == self methodNode body ] + whileFalse: [ + statementNodeContainingNextNode := self statementNodeContaining: + statementNodeContainingNextNode + parent ]. firstPCOfStatementNode := self firstPCOfStatement: - statementNodeContainingNextNode. + statementNodeContainingNextNode." + firstPCOfStatementNode := methodNode bcToASTCache bcToASTMap keys + sorted detect: [ :key | + (methodNode sourceNodeForPC: key) + statementNode + == methodNode statements first ]. "firstExecutedNodeInStatement := methodNode sourceNodeForPC: firstPCOfStatementNode." [ self context stackPtr > self context numTemps ] whileTrue: [ From 94f3452e2854c6bb1be4dbad6461c09bdfb1889f Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Mon, 17 Oct 2022 14:41:49 +0200 Subject: [PATCH 13/29] allowing moveToNode: to enter a block that is not embedded + adding possibility to modify interrupted context in debug session --- Sindarin-Tests/SindarinDebuggerTest.class.st | 24 +++++++++----------- Sindarin/DebugSession.extension.st | 6 +++++ Sindarin/SindarinDebugger.class.st | 2 +- 3 files changed, 18 insertions(+), 14 deletions(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index f8950ab..f0fb984 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -273,7 +273,7 @@ SindarinDebuggerTest >> helperMethodWithIfTrueBlock [ SindarinDebuggerTest >> helperMethodWithNotEvaluatedBlock [ | a | - a := 0. + a := 1. [ a := a + 1 ]. a := a + 2. ^ a * 42 @@ -914,38 +914,36 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBloc sdbg moveToNode: sdbg methodNode statements first. - "It is going to execute the comparison a = 2" + "It is going to execute the comparison a := 1" oldNode := sdbg node. oldContext := sdbg context. - "We want to enter the block, to get to execute a:=3" + "We want to enter the block, to get to execute a + 1 in the block" aimedNode := sdbg methodNode statements second body statements first value. aimedPC := sdbg methodNode firstPcForNode: aimedNode. self assert: aimedPC isNil. - self assert: (sdbg temporaryNamed: #a) equals: 0. + self assert: (sdbg temporaryNamed: #a) equals: 1. sdbg moveToNode: aimedNode. - self assert: (sdbg temporaryNamed: #a) equals: 0. + self assert: (sdbg temporaryNamed: #a) equals: 1. self assert: sdbg node identicalTo: aimedNode. self assert: sdbg context sender identicalTo: oldContext. sdbg + stepOver; stepOver; stepOver. - self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: (sdbg temporaryNamed: #a) equals: 2. - sdbg - stepOver; - stepOver; - stepOver. - "When you perform a stepOver, you quit the block and continue just after the ifTrue: message" - self assert: (sdbg temporaryNamed: #a) equals: 3. - self assert: sdbg topStack equals: 42 + "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. + self assert: sdbg context identicalTo: oldContext. + self assert: sdbg topStack equals: 2 ] { #category : #tests } diff --git a/Sindarin/DebugSession.extension.st b/Sindarin/DebugSession.extension.st index 7d932fe..e61bb1f 100644 --- a/Sindarin/DebugSession.extension.st +++ b/Sindarin/DebugSession.extension.st @@ -4,3 +4,9 @@ Extension { #name : #DebugSession } DebugSession >> asSindarinDebugSession [ ^ SindarinDebugSession new debugSession: self ] + +{ #category : #'*Sindarin' } +DebugSession >> suspendedContext: aContext [ + + interruptedContext := aContext +] diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index e058947..ff5f7e5 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -436,7 +436,7 @@ SindarinDebugger >> moveToNode: aNode [ self pc: olderPC. "we need to change the suspended context and maybe do the same in its debug session" self currentProcess suspendedContext: newContext. - self debugSession process: self currentProcess context: newContext. + self debugSession suspendedContext: newContext. "This does an infinite loop because it doesn't actually change the interrupted context in the debug session" ^ self moveToNode: aNode ] ] ]. From 8d3025d6d174c18205e5ecd69b30b2aefe7d4948 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 21 Oct 2022 14:04:38 +0200 Subject: [PATCH 14/29] skipBlockNode now stepsToFirstInterestingBytecode after skipping the block creation --- Sindarin/SindarinDebugger.class.st | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 3ccec11..4b9d13b 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -562,7 +562,7 @@ SindarinDebugger >> skip [ self node isAssignment ifTrue: [ ^ self skipAssignmentNodeCompletely ]. self node isMessage ifTrue: [ ^ self skipMessageNode ]. self node isMethod ifTrue: [ ^ self step ]. - self node isBlock ifTrue: [ self skipBlockNode ]. + self node isBlock ifTrue: [ ^ self skipBlockNode ]. nextBytecode := self currentBytecode detect: [ :each | each offset = self pc ]. (self node isReturn or: [ @@ -611,11 +611,15 @@ SindarinDebugger >> skipAssignmentNodeWith: replacementValue [ SindarinDebugger >> skipBlockNode [ | nextBytecode | - nextBytecode := self currentBytecode detect: [ :bytecode | bytecode offset = self pc ]. - + nextBytecode := self currentBytecode detect: [ :bytecode | + bytecode offset = self pc ]. + self context pc: self pc + nextBytecode bytes size. - - self context push: nil + + self context push: nil. + + self debugSession stepToFirstInterestingBytecodeIn: + self debugSession interruptedProcess ] { #category : #'stepping - skip' } From a8c4d775dbe98ec1d61d95f7704b0dedda2996fc Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 21 Oct 2022 16:33:17 +0200 Subject: [PATCH 15/29] adding a way to skip jumps with skip/skipUpTo --- Sindarin/DebugSession.extension.st | 19 +++++++++ Sindarin/InstructionStream.extension.st | 22 +++++++++++ Sindarin/Process.extension.st | 9 +++++ Sindarin/SindarinDebugger.class.st | 51 ++++++++++++++++++------- 4 files changed, 88 insertions(+), 13 deletions(-) create mode 100644 Sindarin/InstructionStream.extension.st create mode 100644 Sindarin/Process.extension.st diff --git a/Sindarin/DebugSession.extension.st b/Sindarin/DebugSession.extension.st index 7d932fe..6e41190 100644 --- a/Sindarin/DebugSession.extension.st +++ b/Sindarin/DebugSession.extension.st @@ -4,3 +4,22 @@ Extension { #name : #DebugSession } DebugSession >> asSindarinDebugSession [ ^ SindarinDebugSession new debugSession: self ] + +{ #category : #'*Sindarin' } +DebugSession >> stepToFirstInterestingBytecodeWithJumpIn: aProcess [ + "After a restart of a method activation step to the first + bytecode instruction that is of interest for the debugger. + + In this case step until a bytecode that causes a context switch, + as otherwise one will have to press may time step into without + seeing any visible results." + + "If we are are stepping into a quick method, + make sure that we step correctly over the first primitive bytecode" + | suspendedContext | + suspendedContext := aProcess suspendedContext. + (suspendedContext method isQuick and: [ suspendedContext pc == suspendedContext method initialPC ]) + ifTrue: [ ^ suspendedContext updatePCForQuickPrimitiveRestart ]. + + ^ aProcess stepToSendOrReturnOrJump +] diff --git a/Sindarin/InstructionStream.extension.st b/Sindarin/InstructionStream.extension.st new file mode 100644 index 0000000..6525fd1 --- /dev/null +++ b/Sindarin/InstructionStream.extension.st @@ -0,0 +1,22 @@ +Extension { #name : #InstructionStream } + +{ #category : #'*Sindarin' } +InstructionStream >> willJumpIfFalse [ + "Answer whether the next bytecode is a jump-if-false." + + ^ self method encoderClass isBranchIfFalseAt: pc in: self method +] + +{ #category : #'*Sindarin' } +InstructionStream >> willJumpIfTrue [ + "Answer whether the next bytecode is a jump-if-false." + + ^ self method encoderClass isBranchIfTrueAt: pc in: self method +] + +{ #category : #'*Sindarin' } +InstructionStream >> willJumpTo [ + "Answer whether the next bytecode is a jump-if-false." + + ^ self method encoderClass isJumpAt: pc in: self method +] diff --git a/Sindarin/Process.extension.st b/Sindarin/Process.extension.st new file mode 100644 index 0000000..eb3b21f --- /dev/null +++ b/Sindarin/Process.extension.st @@ -0,0 +1,9 @@ +Extension { #name : #Process } + +{ #category : #'*Sindarin' } +Process >> stepToSendOrReturnOrJump [ + + ^Processor activeProcess + evaluate: [suspendedContext := suspendedContext stepToSendOrReturnOrJump] + onBehalfOf: self +] diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 3ccec11..fe25225 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -556,18 +556,25 @@ SindarinDebugger >> sindarinSession: aSindarinDebugSession [ { #category : #'stepping - skip' } SindarinDebugger >> skip [ - - | nextBytecode | + + | nextBytecode instructionStream | "If it is a message send or assignment, skips the execution of the current instruction, and puts nil on the execution stack." self node isAssignment ifTrue: [ ^ self skipAssignmentNodeCompletely ]. - self node isMessage ifTrue: [ ^ self skipMessageNode ]. - self node isMethod ifTrue: [ ^ self step ]. - self node isBlock ifTrue: [ self skipBlockNode ]. + "We need to treat jumps before messages because if it is associated to a message node, it would pop the arguments of the message, that aren't on the stack if they are jumps" + instructionStream := self context instructionStream. + (instructionStream willJumpTo or: [ + instructionStream willJumpIfFalse or: [ + instructionStream willJumpIfTrue ] ]) ifTrue: [ ^ self skipJump ]. + self node isMessage ifTrue: [ ^ self skipMessageNode ]. + self node isMethod ifTrue: [ ^ self step ]. + self node isBlock ifTrue: [ ^ self skipBlockNode ]. nextBytecode := self currentBytecode detect: [ :each | each offset = self pc ]. + (self node isReturn or: [ nextBytecode bytes first between: 88 and: 94 ]) ifTrue: [ ^ self skipReturnNode ]. + self node isSequence ifTrue: [ ^ self step ]. self skipWith: nil @@ -591,7 +598,7 @@ SindarinDebugger >> skipAssignmentNodeCompletely [ "Increase the pc to go over the assignment" self context pc: self context pc + currentBytecode bytes size. "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 stepToFirstInterestingBytecodeIn: + self debugSession stepToFirstInterestingBytecodeWithJumpIn: self debugSession interruptedProcess ] @@ -604,18 +611,36 @@ SindarinDebugger >> skipAssignmentNodeWith: 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 - stepToFirstInterestingBytecodeIn: self debugSession interruptedProcess + stepToFirstInterestingBytecodeWithJumpIn: self debugSession interruptedProcess ] { #category : #'stepping - skip' } SindarinDebugger >> skipBlockNode [ | nextBytecode | - nextBytecode := self currentBytecode detect: [ :bytecode | bytecode offset = self pc ]. - + nextBytecode := self currentBytecode detect: [ :bytecode | + bytecode offset = self pc ]. + self context pc: self pc + nextBytecode bytes size. - - self context push: nil + + self context push: nil. + + self debugSession stepToFirstInterestingBytecodeWithJumpIn: + self debugSession interruptedProcess +] + +{ #category : #'stepping - skip' } +SindarinDebugger >> skipJump [ + + | instructionStream nextBytecode | + instructionStream := self context instructionStream. + (instructionStream willJumpIfFalse or: [ + instructionStream willJumpIfTrue ]) ifTrue: [ self context pop ]. + nextBytecode := self currentBytecode detect: [ :each | + each offset = self pc ]. + self context pc: self context pc + nextBytecode bytes size. + self debugSession stepToFirstInterestingBytecodeWithJumpIn: + self debugSession interruptedProcess ] { #category : #'stepping - skip' } @@ -626,7 +651,7 @@ SindarinDebugger >> skipMessageNode [ "Increase the pc to go over the message send" self context pc: self context pc + self nextBytecode bytes size. "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 stepToFirstInterestingBytecodeIn: + self debugSession stepToFirstInterestingBytecodeWithJumpIn: self debugSession interruptedProcess ] @@ -641,7 +666,7 @@ SindarinDebugger >> skipMessageNodeWith: replacementValue [ "Increase the pc to go over the message send" self context pc: self context pc + self nextBytecode bytes size. "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 stepToFirstInterestingBytecodeIn: + self debugSession stepToFirstInterestingBytecodeWithJumpIn: self debugSession interruptedProcess ] From c80a890ecf13ffbe5bba66db4c951c4674089b92 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 21 Oct 2022 16:48:58 +0200 Subject: [PATCH 16/29] adding tests for skipping jumps --- Sindarin-Tests/SindarinDebuggerTest.class.st | 64 ++++++++++++++++++++ 1 file changed, 64 insertions(+) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index c2dbaa6..e9112a7 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -250,6 +250,17 @@ SindarinDebuggerTest >> helperMethodWithEvaluatedBlock [ ] +{ #category : #tests } +SindarinDebuggerTest >> helperMethodWithIfTrueIfFalse [ + + | a | + a := true. + a + ifFalse: [ a := 1 ] + ifTrue: [ a := 2 ]. + a := 3 +] + { #category : #helpers } SindarinDebuggerTest >> helperMethodWithSeveralInstructionsInBlock [ @@ -885,6 +896,59 @@ SindarinDebuggerTest >> testSkipToPcDoesNotLoopWhenAimedPcIsBeforeCurrentPc [ self assert: sdbg pc equals: pcBeforeSkip. ] +{ #category : #tests } +SindarinDebuggerTest >> testSkipUpToIgnoresJumps [ + + | sdbg aimedNode aimedPC a | + sdbg := SindarinDebugger debug: [ self helperMethodWithIfTrueIfFalse ]. + + sdbg step. + + aimedNode := sdbg methodNode statements second arguments first + statements first. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + a := sdbg temporaryNamed: #a. + + self assert: a isNil. + + sdbg skipUpToNode: aimedNode. + + self + assert: a isNil; + assert: sdbg node identicalTo: aimedNode; + assert: sdbg pc equals: aimedPC. + + aimedNode := sdbg methodNode statements second arguments second + statements first. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + a := sdbg temporaryNamed: #a. + + self assert: a isNil. + + sdbg skipUpToNode: aimedNode . + + self + assert: a isNil; + assert: sdbg node identicalTo: aimedNode; + assert: sdbg pc equals: aimedPC. + + aimedNode := sdbg methodNode statements third. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + a := sdbg temporaryNamed: #a. + + self assert: a isNil. + + sdbg skipUpToNode: aimedNode. + + self + assert: a isNil; + assert: sdbg node identicalTo: aimedNode; + assert: sdbg pc equals: aimedPC +] + { #category : #'tests - skipping' } SindarinDebuggerTest >> testSkipUpToNode [ | dbg realExecPC realValueOfA realExecNode realExecTopStack | From 32006e39c22a3c239fdc86b7b5f8fe63ea465084 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 28 Oct 2022 09:29:39 +0200 Subject: [PATCH 17/29] Adding a forgotten extension method in Context --- Sindarin/Context.extension.st | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 Sindarin/Context.extension.st diff --git a/Sindarin/Context.extension.st b/Sindarin/Context.extension.st new file mode 100644 index 0000000..d861128 --- /dev/null +++ b/Sindarin/Context.extension.st @@ -0,0 +1,16 @@ +Extension { #name : #Context } + +{ #category : #'*Sindarin' } +Context >> stepToSendOrReturnOrJump [ + "Simulate the execution of bytecodes until either sending a message or + returning a value to the receiver (that is, until switching contexts)." + + | stream context | + stream := InstructionStream on: method pc: pc. + [ self isDead or: [ stream willSend or: [ stream willReturn or: [ stream willStore or: [ stream willCreateBlock or: [ stream willJumpIfFalse or:[ stream willJumpIfTrue or: [ stream willJumpTo ] ] ] ] ] ] ] ] + whileFalse: [ + context := stream interpretNextInstructionFor: self. + context == self ifFalse: [ + "Caused by mustBeBoolean handling" + ^context ]] +] From d740d5fccbb108e94deab94c91144d9119f561e8 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 28 Oct 2022 14:25:29 +0200 Subject: [PATCH 18/29] fixing moveToNode to go on AFTER the block after jumping inside a block, instead of going back to where we were before jumping inside a block --- Sindarin-Tests/SindarinDebuggerTest.class.st | 2 +- Sindarin/SindarinDebugger.class.st | 8 +++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index f0fb984..6bdc3f5 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -941,7 +941,7 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBloc self assert: (sdbg temporaryNamed: #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. + self assert: sdbg node identicalTo: sdbg methodNode statements third value. self assert: sdbg context identicalTo: oldContext. self assert: sdbg topStack equals: 2 ] diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index ff5f7e5..2187c1b 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -426,14 +426,16 @@ SindarinDebugger >> moveToNode: aNode [ firstPCForNode := self methodNode firstPcForNode: nextNode. nextNode isBlock ifTrue: [ | newContext blockClosure olderPC | - olderPC := self pc. + "olderPC := self pc." + "We move to the block node pc to get its full block closure" self pc: firstPCForNode. self stepBytecode. "The array of temps is missing on the stack. The last bytecode of the previous statement pushes it." - blockClosure := self context pop. + blockClosure := self context top. newContext := blockClosure asContextWithSender: self context. - self pc: olderPC. + "self pc: olderPC." + "we need to change the suspended context and maybe do the same in its debug session" self currentProcess suspendedContext: newContext. self debugSession suspendedContext: newContext. From d225aa2e55870a187c4d3c62403257898d27b039 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 28 Oct 2022 16:54:11 +0200 Subject: [PATCH 19/29] making jumpToCaret jump into embedded blocks --- Sindarin-Tests/SindarinDebuggerTest.class.st | 66 ++++++++++++++++++++ Sindarin/RBBlockNode.extension.st | 10 +++ 2 files changed, 76 insertions(+) create mode 100644 Sindarin/RBBlockNode.extension.st diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 6bdc3f5..9231182 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -249,6 +249,16 @@ SindarinDebuggerTest >> helperMethodWithDoubleAssignment [ a := b := 1 ] +{ #category : #helpers } +SindarinDebuggerTest >> helperMethodWithEmbeddedBlock [ + + | a | + a := 1. + [ :each | a := a + each. [ a := a + 1 ]. a * 42 ]. + a := a + 2. + ^ a * 42 +] + { #category : #helpers } SindarinDebuggerTest >> helperMethodWithEvaluatedBlock [ @@ -1058,6 +1068,62 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsLiteralOrVariableThatHasNoAssoci deny: (sdbg methodNode pcsForNode: realNode) isEmpty ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenNodeIsNonInlinedAndEmbeddedInNonInlinedBlock [ + + | oldNode sdbg aimedNode oldContext aimedPC methodNode | + sdbg := SindarinDebugger debug: [ + self helperMethodWithEmbeddedBlock ]. + sdbg + step; + stepOver; + stepOver. + + "stops on outer block creation" + oldNode := sdbg node. + oldContext := sdbg context. + methodNode := sdbg methodNode. + + "We want to move to node 'a + 1' in [a := a +1] (embedded block)" + aimedNode := sdbg methodNode statements second statements second statements first value. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + self assert: aimedPC isNil. + self assert: (sdbg temporaryNamed: #a) equals: 1. + + sdbg moveToNode: aimedNode. + + self assert: (sdbg temporaryNamed: #a) equals: 1. + + self assert: sdbg node identicalTo: aimedNode. + self assert: sdbg context home identicalTo: oldContext. + self assert: sdbg methodNode identicalTo: methodNode statements second statements second. + + sdbg + stepOver; + stepOver; + stepOver. + + self assert: (sdbg temporaryNamed: #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. + self assert: sdbg node identicalTo: methodNode statements second statements third. + self assert: sdbg context sender identicalTo: oldContext. + + sdbg + stepOver; + stepOver; + stepOver. + + self assert: (sdbg temporaryNamed: #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. + self assert: sdbg node identicalTo: sdbg methodNode statements third. + self assert: sdbg context identicalTo: oldContext. +] + { #category : #tests } SindarinDebuggerTest >> testNode [ | node scdbg | diff --git a/Sindarin/RBBlockNode.extension.st b/Sindarin/RBBlockNode.extension.st new file mode 100644 index 0000000..a31daa6 --- /dev/null +++ b/Sindarin/RBBlockNode.extension.st @@ -0,0 +1,10 @@ +Extension { #name : #RBBlockNode } + +{ #category : #'*Sindarin' } +RBBlockNode >> parentOfIdenticalSubtree: subtree [ + + ^ self allChildren reversed + detect: [ :e | e == subtree ] + ifFound: [ :e | e parent ] + ifNone: [ nil ] +] From cd3390c6d696370e7c773c81096b385e17ed3a3b Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Wed, 2 Nov 2022 09:39:49 +0100 Subject: [PATCH 20/29] making moveToNode exit blocks + tests --- Sindarin-Tests/SindarinDebuggerTest.class.st | 150 +++++++++++++++++++ Sindarin/SindarinDebugger.class.st | 23 ++- 2 files changed, 167 insertions(+), 6 deletions(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 9231182..4f7d467 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -910,6 +910,156 @@ SindarinDebuggerTest >> testMoveToNodeRaisesErrorWhenNodeIsNotInMethod [ assert: sdbg node equals: oldNode ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedBlockToOuterContext [ + + | oldNode sdbg aimedNode oldContext aimedPC methodNode | + sdbg := SindarinDebugger debug: [ + self helperMethodWithNotEvaluatedBlock ]. + sdbg + step; + stepOver; + stepOver. + + "stops on block creation" + oldNode := sdbg node. + oldContext := sdbg context. + methodNode := sdbg methodNode. + + "We want to move to node 'a + 1' in [a := a +1]" + aimedNode := sdbg methodNode statements second statements first value. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + self assert: aimedPC isNil. + self assert: (sdbg temporaryNamed: #a) equals: 1. + + sdbg moveToNode: aimedNode. + + self assert: (sdbg temporaryNamed: #a) equals: 1. + + self assert: sdbg context home identicalTo: oldContext. + self + assert: sdbg methodNode + identicalTo: methodNode statements second. + + sdbg stepOver. + + "2 is going to be assigned to a" + self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: sdbg topStack equals: 2. + + sdbg moveToNode: methodNode statements third. + "We jump to node outside of block" + self assert: sdbg methodNode identicalTo: methodNode. + self assert: sdbg node identicalTo: methodNode statements third. + "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 topStack equals: 1 +] + +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToHomeContext [ + + | oldNode sdbg aimedNode oldContext aimedPC methodNode | + sdbg := SindarinDebugger debug: [ + self helperMethodWithEmbeddedBlock ]. + sdbg + step; + stepOver; + stepOver. + + "stops on block creation" + oldNode := sdbg node. + oldContext := sdbg context. + methodNode := sdbg methodNode. + + "We want to move to node 'a + 1' in [a := a +1]" + aimedNode := sdbg methodNode statements second statements second statements first value. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + self assert: aimedPC isNil. + self assert: (sdbg temporaryNamed: #a) equals: 1. + + sdbg moveToNode: aimedNode. + + self assert: (sdbg temporaryNamed: #a) equals: 1. + + self assert: sdbg context home identicalTo: oldContext. + self + assert: sdbg methodNode + identicalTo: methodNode statements second statements second. + + sdbg stepOver. + + "2 is going to be assigned to a" + self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: sdbg topStack equals: 2. + + sdbg moveToNode: methodNode statements third. + "We jump to node in home context of embedded block" + self assert: sdbg methodNode identicalTo: methodNode. + self assert: sdbg node identicalTo: methodNode statements third. + "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 topStack equals: 1 +] + +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToNodeThatIsNotInHomeContext [ + + | oldNode oldPC sdbg aimedNode oldContext aimedPC methodNode | + sdbg := SindarinDebugger debug: [ self helperMethodWithEmbeddedBlock ]. + sdbg + step; + stepOver; + stepOver. + + "stops on block creation" + oldNode := sdbg node. + oldContext := sdbg context. + methodNode := sdbg methodNode. + + "We want to move to node 'a + 1' in [a := a +1]" + aimedNode := sdbg methodNode statements second statements second + statements first value. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + self assert: aimedPC isNil. + self assert: (sdbg temporaryNamed: #a) equals: 1. + + sdbg moveToNode: aimedNode. + + self assert: (sdbg temporaryNamed: #a) equals: 1. + + self assert: sdbg context home identicalTo: oldContext. + self + assert: sdbg methodNode + identicalTo: methodNode statements second statements second. + + sdbg stepOver. + + "2 is going to be assigned to a" + self assert: (sdbg temporaryNamed: #a) equals: 1. + self assert: sdbg topStack equals: 2. + + oldNode := sdbg node. + oldPC := sdbg pc. + oldContext := sdbg context. + + sdbg moveToNode: (RBLiteralValueNode value: 1). + "We jump to node in home context of embedded block" + self assert: sdbg node identicalTo: oldNode. + "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 topStack equals: 2 +] + { #category : #tests } SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBlockHasBeenCreated [ diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 2187c1b..edcba22 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -402,7 +402,20 @@ SindarinDebugger >> moveToNode: aNode [ ifNil: [ (aNode == self methodNode or: [ aNode == self methodNode body ]) ifTrue: [ firstPCForNode := self method endPC ] - ifFalse: [ ^ NodeNotInASTError signal ] ] + ifFalse: [ + self context ~~ self context home + ifTrue: [ + | oldContext | + oldContext := self context. + self currentProcess suspendedContext: oldContext home. + self debugSession suspendedContext: oldContext home. + [ self moveToNode: aNode ] + on: NodeNotInASTError + do: [ + self currentProcess suspendedContext: oldContext. + self debugSession suspendedContext: oldContext ]. + ^ self ] + ifFalse: [ ^ NodeNotInASTError signal ] ] ] ifNotNil: [ :parent | | nodesAfter indexOfNode indexOfNextNode nextNode | "aNode statementNode parent parent isBlock ifTrue: [ @@ -426,21 +439,19 @@ SindarinDebugger >> moveToNode: aNode [ firstPCForNode := self methodNode firstPcForNode: nextNode. nextNode isBlock ifTrue: [ | newContext blockClosure olderPC | - "olderPC := self pc." - - "We move to the block node pc to get its full block closure" + "olderPC := self pc.""We move to the block node pc to get its full block closure" self pc: firstPCForNode. self stepBytecode. "The array of temps is missing on the stack. The last bytecode of the previous statement pushes it." blockClosure := self context top. newContext := blockClosure asContextWithSender: self context. "self pc: olderPC." - + "we need to change the suspended context and maybe do the same in its debug session" self currentProcess suspendedContext: newContext. self debugSession suspendedContext: newContext. "This does an infinite loop because it doesn't actually change the interrupted context in the debug session" - ^ self moveToNode: aNode ] ] ]. + ^ self moveToNode: aNode ] ] ]. self pc: firstPCForNode ] From 33fbcebb73032818b6f48fdd11e0cb815013793a Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Wed, 2 Nov 2022 09:57:33 +0100 Subject: [PATCH 21/29] Adding tests that were failing because of skipUpTo bugs --- Sindarin-Tests/SindarinDebuggerTest.class.st | 46 +++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index 5392f77..aeff4b9 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -1114,11 +1114,55 @@ SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBloc self assert: sdbg topStack equals: 2 ] +{ #category : #tests } +SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInBlockThatCreatesContextAndBlockHasBeenCreatedBackward [ + + | oldNode sdbg aimedNode oldContext aimedPC | + sdbg := SindarinDebugger debug: [ + self helperMethodWithNotEvaluatedBlock ]. + sdbg + step; + stepOver; + stepOver; + stepOver; + stepOver. + + "It is going to execute a := a + 2" + oldNode := sdbg node. + oldContext := sdbg context. + + "We want to enter the block, to get to execute a + 1 in the block" + aimedNode := sdbg methodNode statements second body statements first + value. + aimedPC := sdbg methodNode firstPcForNode: aimedNode. + + self assert: aimedPC isNil. + self assert: (sdbg temporaryNamed: #a) equals: 1. + + sdbg moveToNode: aimedNode. + + self assert: (sdbg temporaryNamed: #a) equals: 1. + + self assert: sdbg node identicalTo: aimedNode. + self assert: sdbg context sender identicalTo: oldContext. + + sdbg + stepOver; + stepOver; + stepOver. + + self assert: (sdbg temporaryNamed: #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. + self assert: sdbg context identicalTo: oldContext. + self assert: sdbg topStack equals: 2 +] + { #category : #tests } SindarinDebuggerTest >> testMoveToNodeWhenNodeIsInIfTrueIfFalseBlock [ | oldNode sdbg aimedNode oldContext aimedPC | - self skip. sdbg := SindarinDebugger debug: [ self helperMethodWithIfTrueBlock ]. sdbg step; From 9888805de7792c34c0867afda5395c0ea1e158ce Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Wed, 2 Nov 2022 14:14:14 +0100 Subject: [PATCH 22/29] cleaning code in moveToNode: and pc: --- Sindarin-Tests/SindarinDebuggerTest.class.st | 4 +- Sindarin/NodeNotInASTError.class.st | 3 + Sindarin/NotValidPcError.class.st | 3 + Sindarin/OCBytecodeToASTCache.extension.st | 8 ++ Sindarin/RBBlockNode.extension.st | 31 +++++ Sindarin/RBMethodNode.extension.st | 36 +++-- Sindarin/SindarinDebugger.class.st | 130 ++++++++++--------- 7 files changed, 140 insertions(+), 75 deletions(-) create mode 100644 Sindarin/OCBytecodeToASTCache.extension.st diff --git a/Sindarin-Tests/SindarinDebuggerTest.class.st b/Sindarin-Tests/SindarinDebuggerTest.class.st index aeff4b9..21bffac 100644 --- a/Sindarin-Tests/SindarinDebuggerTest.class.st +++ b/Sindarin-Tests/SindarinDebuggerTest.class.st @@ -1058,7 +1058,9 @@ SindarinDebuggerTest >> testMoveToNodeWhenFromNonInlinedEmbeddedBlockToNodeThatI oldPC := sdbg pc. oldContext := sdbg context. - sdbg moveToNode: (RBLiteralValueNode value: 1). + self + should: [ sdbg moveToNode: (RBLiteralValueNode value: 1) ] + raise: NodeNotInASTError. "We jump to node in home context of embedded block" self assert: sdbg node identicalTo: oldNode. "We went back to the home context" diff --git a/Sindarin/NodeNotInASTError.class.st b/Sindarin/NodeNotInASTError.class.st index 262b90f..e10cd45 100644 --- a/Sindarin/NodeNotInASTError.class.st +++ b/Sindarin/NodeNotInASTError.class.st @@ -1,3 +1,6 @@ +" +I am signaled when we try to move the execution to a node that is not in the home context's method ast. +" Class { #name : #NodeNotInASTError, #superclass : #Error, diff --git a/Sindarin/NotValidPcError.class.st b/Sindarin/NotValidPcError.class.st index 2aa8b35..643a4f6 100644 --- a/Sindarin/NotValidPcError.class.st +++ b/Sindarin/NotValidPcError.class.st @@ -1,3 +1,6 @@ +" +I am signaled when I try to modify the execution of a context to get to an invalid PC (lower than the method initalPC or greater than the method endPC) +" Class { #name : #NotValidPcError, #superclass : #Error, diff --git a/Sindarin/OCBytecodeToASTCache.extension.st b/Sindarin/OCBytecodeToASTCache.extension.st new file mode 100644 index 0000000..534915d --- /dev/null +++ b/Sindarin/OCBytecodeToASTCache.extension.st @@ -0,0 +1,8 @@ +Extension { #name : #OCBytecodeToASTCache } + +{ #category : #'*Sindarin' } +OCBytecodeToASTCache >> firstRecursiveBcOffsetForStatementNode: aStatementNode [ + + ^ self methodOrBlockNode bcToASTCache bcToASTMap keys sorted detect: [ + :key | (self nodeForPC: key) statementNode == aStatementNode ] +] diff --git a/Sindarin/RBBlockNode.extension.st b/Sindarin/RBBlockNode.extension.st index a31daa6..6db8765 100644 --- a/Sindarin/RBBlockNode.extension.st +++ b/Sindarin/RBBlockNode.extension.st @@ -1,5 +1,36 @@ Extension { #name : #RBBlockNode } +{ #category : #'*Sindarin' } +RBBlockNode >> executedNodesAfter: aNode [ + + "Gives all nodes that are executed after aNode. Assuming that aNode is a recursive child, then all nodes executed after it are all nodes after it in allChildrenPostOrder" + + | nodesAfter indexOfNode | + nodesAfter := self allChildrenPostOrder. + indexOfNode := nodesAfter identityIndexOf: aNode. + nodesAfter := nodesAfter withIndexSelect: [ :value :index | + index > indexOfNode ]. + ^ nodesAfter +] + +{ #category : #'*Sindarin' } +RBBlockNode >> firstPCOfStatement: aStatementNode [ + + ^ self bcToASTCache firstRecursiveBcOffsetForStatementNode: aStatementNode +] + +{ #category : #'*Sindarin' } +RBBlockNode >> nextExecutedNodeAfter: aNode [ + + "Find first node that is after aNode that has an associated pc in method node all children (post-order)" + + | indexOfNextNode nodesAfter | + nodesAfter := self executedNodesAfter: aNode. + indexOfNextNode := nodesAfter findFirst: [ :each | + (self firstPcForNode: each) isNotNil ]. + ^ nodesAfter at: indexOfNextNode +] + { #category : #'*Sindarin' } RBBlockNode >> parentOfIdenticalSubtree: subtree [ diff --git a/Sindarin/RBMethodNode.extension.st b/Sindarin/RBMethodNode.extension.st index 704e3b9..789a1d9 100644 --- a/Sindarin/RBMethodNode.extension.st +++ b/Sindarin/RBMethodNode.extension.st @@ -1,18 +1,34 @@ Extension { #name : #RBMethodNode } +{ #category : #'*Sindarin' } +RBMethodNode >> executedNodesAfter: aNode [ + + "Gives all nodes that are executed after aNode. Assuming that aNode is a recursive child, then all nodes executed after it are all nodes after it in allChildrenPostOrder" + + | nodesAfter indexOfNode | + nodesAfter := self allChildrenPostOrder. + indexOfNode := nodesAfter identityIndexOf: aNode. + nodesAfter := nodesAfter withIndexSelect: [ :value :index | + index > indexOfNode ]. + ^ nodesAfter +] + { #category : #'*Sindarin' } RBMethodNode >> firstPCOfStatement: aStatementNode [ - | indexOfStatementNode statementBefore lastPcInStatementBefore | - indexOfStatementNode := self statements identityIndexOf: - aStatementNode. - indexOfStatementNode == 1 ifTrue: [ - ^ self bcToASTCache bcToASTMap keys sorted detect: [ :key | - (self sourceNodeForPC: key) statementNode == aStatementNode ] ]. - statementBefore := self statements at: indexOfStatementNode - 1. - lastPcInStatementBefore := self lastPcForNode: statementBefore. - ^ self bcToASTCache bcToASTMap keys sorted detect: [ :key | - key > lastPcInStatementBefore ] + ^ self bcToASTCache firstRecursiveBcOffsetForStatementNode: aStatementNode +] + +{ #category : #'*Sindarin' } +RBMethodNode >> nextExecutedNodeAfter: aNode [ + + "Find first node that is after aNode that has an associated pc in method node all children (post-order)" + + | indexOfNextNode nodesAfter | + nodesAfter := self executedNodesAfter: aNode. + indexOfNextNode := nodesAfter findFirst: [ :each | + (self firstPcForNode: each) isNotNil ]. + ^ nodesAfter at: indexOfNextNode ] { #category : #'*Sindarin' } diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 50d819b..1b08dfe 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -140,6 +140,13 @@ SindarinDebugger >> canStillExecute: aProgramNode [ ^ rightContext pc < lastPcForNode ] +{ #category : #cleaning } +SindarinDebugger >> cleanStack [ + + [ self context stackPtr > self context numTemps ] whileTrue: [ + self context pop ] +] + { #category : #stackAccess } SindarinDebugger >> context [ "Returns a reification of the current stack-frame." @@ -297,6 +304,25 @@ SindarinDebugger >> isExecutionFinished [ ^ process isTerminated ] +{ #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 | + "To jump into a block, we change pc to the block creation pc and we step it to get the block closure and create a new context for it. Then, we call moveToNode: recursively to go to the correct pc in the new context (or to create even more contexts if we want to enter embedded blocks)" + firstPCForNode := self methodNode firstPcForNode: aBlockNode. + self pc: firstPCForNode. + self stepBytecode. + blockClosure := self context top. + 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" + self currentProcess suspendedContext: newContext. + self debugSession suspendedContext: newContext. + ^ self moveToNode: targetNode +] + { #category : #stackAccessHelpers } SindarinDebugger >> message: aSelector [ "Returns whether the execution is about to send a message of selector @aSelector to any object" @@ -394,64 +420,27 @@ SindarinDebugger >> methodNode [ { #category : #'API - changes' } SindarinDebugger >> moveToNode: aNode [ + "Allows to jump to the first bytecode offset associated to aNode, as long as aNode is in the same lexical context as the suspended context" + | firstPCForNode | firstPCForNode := self methodNode firstPcForNode: aNode. - firstPCForNode ifNil: [ "]" + firstPCForNode ifNil: [ "If a node does not have any associated pc and if it is not a child in the method node then, aNode may be identical to the method node or its body, in which case, we move to the endPC. Otherwise, we check if it is a child in the home context's method node. If this is the case, this means we want to exit a block context. Otherwise, aNode is not a child in the home context's method node" (self methodNode parentOfIdenticalSubtree: aNode) ifNil: [ (aNode == self methodNode or: [ aNode == self methodNode body ]) ifTrue: [ firstPCForNode := self method endPC ] ifFalse: [ self context ~~ self context home - ifTrue: [ - | oldContext | - oldContext := self context. - self currentProcess suspendedContext: oldContext home. - self debugSession suspendedContext: oldContext home. - [ self moveToNode: aNode ] - on: NodeNotInASTError - do: [ - self currentProcess suspendedContext: oldContext. - self debugSession suspendedContext: oldContext ]. - ^ self ] + ifTrue: [ ^ self tryMoveToNodeInHomeContext: aNode ] ifFalse: [ ^ NodeNotInASTError signal ] ] ] ifNotNil: [ :parent | - | nodesAfter indexOfNode indexOfNextNode nextNode | - "aNode statementNode parent parent isBlock ifTrue: [ - | newContext blockClosure | - blockClosure := aNode statementNode parent parent evaluate. - newContext := blockClosure asContextWithSender: self context. - ""we need to change the suspended context and maybe do the same in its debug session"" - self currentProcess suspendedContext: newContext. - self debugSession - process: self currentProcess - context: newContext ].""ifFalse: [ " - nodesAfter := self methodNode allChildrenPostOrder. - indexOfNode := nodesAfter identityIndexOf: aNode. - nodesAfter := nodesAfter withIndexSelect: [ :value :index | - index > indexOfNode ]. - "if aimed node has no associated pc, we find the first node executed after him (in pre-order) that has at least one associated pc" - indexOfNextNode := nodesAfter findFirst: [ :each | - (self methodNode firstPcForNode: each) - isNotNil ]. - nextNode := nodesAfter at: indexOfNextNode. + | nextNode | + "If a node does not have any associated pc but this node is a child in the method node then, we go to the next node that will be executed (so in pre-order) and that has an associated pc in this context." + nextNode := self nextExecutedNodeAfter: aNode. firstPCForNode := self methodNode firstPcForNode: nextNode. - nextNode isBlock ifTrue: [ - | newContext blockClosure olderPC | - "olderPC := self pc.""We move to the block node pc to get its full block closure" - self pc: firstPCForNode. - self stepBytecode. - "The array of temps is missing on the stack. The last bytecode of the previous statement pushes it." - blockClosure := self context top. - newContext := blockClosure asContextWithSender: self context. - "self pc: olderPC." - - "we need to change the suspended context and maybe do the same in its debug session" - self currentProcess suspendedContext: newContext. - self debugSession suspendedContext: newContext. - "This does an infinite loop because it doesn't actually change the interrupted context in the debug session" - ^ self moveToNode: aNode ] ] ]. + nextNode isBlock ifTrue: [ "If the node after aNode is a block node, then this means we want to enter a block." + ^ self jumpIntoBlock: nextNode toNode: aNode ] ] ]. self pc: firstPCForNode ] @@ -463,6 +452,12 @@ SindarinDebugger >> nextBytecode [ each offset = self context pc ] ] +{ #category : #'API - changes' } +SindarinDebugger >> nextExecutedNodeAfter: aNode [ + + ^ self methodNode nextExecutedNodeAfter: aNode +] + { #category : #astAndAstMapping } SindarinDebugger >> node [ "Returns the AST node about to be executed by the top context of the execution" @@ -505,32 +500,22 @@ SindarinDebugger >> pc [ { #category : #accessing } SindarinDebugger >> pc: anInteger [ - | statementNodeContainingNextNode nextNode methodNode firstPCOfStatementNode | + "Allows to move to the first PC associated to the node to which anInteger is associated. anInteger must be a valid pc in the suspended context" + + | nextNode methodNode firstPCOfStatementNode | + "If aimedPC is outside the context PCs range, then an error is signaled" (anInteger < self method initialPC or: [ anInteger > self method endPC ]) ifTrue: [ ^ NotValidPcError signal ]. methodNode := self methodNode. nextNode := methodNode sourceNodeForPC: anInteger. + "If the aimed node is associated to the method node or its body, then we suppose that it is wanted and we'll get there directly" (nextNode == methodNode or: [ nextNode == methodNode body ]) ifTrue: [ firstPCOfStatementNode := anInteger ] - ifFalse: [ "statementNodeContainingNextNode := self statementNodeContaining: - nextNode. - [ statementNodeContainingNextNode parent == self methodNode body ] - whileFalse: [ - statementNodeContainingNextNode := self statementNodeContaining: - statementNodeContainingNextNode - parent ]. + ifFalse: [ "If not, we skip to the wanted node, from the first (recursive) pc of the first statement node. We don't skip from the method node initial pc, otherwise we would create again the temp variables and lose their values." firstPCOfStatementNode := self firstPCOfStatement: - statementNodeContainingNextNode." - firstPCOfStatementNode := methodNode bcToASTCache bcToASTMap keys - sorted detect: [ :key | - (methodNode sourceNodeForPC: key) - statementNode - == methodNode statements first ]. - "firstExecutedNodeInStatement := methodNode sourceNodeForPC: - firstPCOfStatementNode." - [ self context stackPtr > self context numTemps ] whileTrue: [ - self context pop ] ]. + methodNode statements first. + self cleanStack ]. self context pc: firstPCOfStatementNode. self debugSession stepToFirstInterestingBytecodeIn: self debugSession interruptedProcess. @@ -974,3 +959,20 @@ SindarinDebugger >> terminate [ SindarinDebugger >> topStack [ ^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 | + oldContext := self context. + self currentProcess suspendedContext: oldContext home. + self debugSession suspendedContext: oldContext home. + [ self moveToNode: aNode ] + on: NodeNotInASTError + do: [ + self currentProcess suspendedContext: oldContext. + self debugSession suspendedContext: oldContext. + ^ NodeNotInASTError signal ] +] From 26ca3521b5ba6be2b7161d4ad40fcdda34bac4d7 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 25 Nov 2022 09:59:09 +0100 Subject: [PATCH 23/29] refactoring Context>>#stepToSendOrReturnOrJump to make it more readable + using InstructionStream>>#willReturn in SindarinDebugger>>#skip instead of hardcoding the list of return bytecodes --- Sindarin/Context.extension.st | 14 ++++++++------ Sindarin/InstructionStream.extension.st | 16 ++++++++++++++++ 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/Sindarin/Context.extension.st b/Sindarin/Context.extension.st index d861128..5621831 100644 --- a/Sindarin/Context.extension.st +++ b/Sindarin/Context.extension.st @@ -2,15 +2,17 @@ Extension { #name : #Context } { #category : #'*Sindarin' } Context >> stepToSendOrReturnOrJump [ + "Simulate the execution of bytecodes until either sending a message or returning a value to the receiver (that is, until switching contexts)." | stream context | - stream := InstructionStream on: method pc: pc. - [ self isDead or: [ stream willSend or: [ stream willReturn or: [ stream willStore or: [ stream willCreateBlock or: [ stream willJumpIfFalse or:[ stream willJumpIfTrue or: [ stream willJumpTo ] ] ] ] ] ] ] ] - whileFalse: [ + stream := InstructionStream on: method pc: pc. + [ + self isDead or: [ + stream willSendOrReturnOrStoreOrCreateBlock or: [ stream willJump ] ] ] + whileFalse: [ context := stream interpretNextInstructionFor: self. - context == self ifFalse: [ - "Caused by mustBeBoolean handling" - ^context ]] + context == self ifFalse: [ "Caused by mustBeBoolean handling" + ^ context ] ] ] diff --git a/Sindarin/InstructionStream.extension.st b/Sindarin/InstructionStream.extension.st index 6525fd1..e819f3d 100644 --- a/Sindarin/InstructionStream.extension.st +++ b/Sindarin/InstructionStream.extension.st @@ -1,5 +1,12 @@ Extension { #name : #InstructionStream } +{ #category : #'*Sindarin' } +InstructionStream >> willJump [ + "Answer whether the next bytecode will jump." + + ^ self willJumpIfFalse or:[ self willJumpIfTrue or: [ self willJumpTo ] ] +] + { #category : #'*Sindarin' } InstructionStream >> willJumpIfFalse [ "Answer whether the next bytecode is a jump-if-false." @@ -20,3 +27,12 @@ InstructionStream >> willJumpTo [ ^ self method encoderClass isJumpAt: pc in: self method ] + +{ #category : #'*Sindarin' } +InstructionStream >> willSendOrReturnOrStoreOrCreateBlock [ + + "Answer whether the next bytecode will be interesting for the debugger to stop." + + ^ self willSend or: [ + self willReturn or: [ self willStore or: [ self willCreateBlock ] ] ] +] From ebbacd00db09b41060c2cdd179f06cb8ace17357 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 25 Nov 2022 10:00:58 +0100 Subject: [PATCH 24/29] deleting a useless method call --- Sindarin/SindarinDebugger.class.st | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index fe25225..137bce8 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -575,9 +575,7 @@ SindarinDebugger >> skip [ nextBytecode bytes first between: 88 and: 94 ]) ifTrue: [ ^ self skipReturnNode ]. - self node isSequence ifTrue: [ ^ self step ]. - - self skipWith: nil + self node isSequence ifTrue: [ ^ self step ] ] { #category : #'stepping - skip' } From d88ef2bb5a99a02de82138a61e68083e711e83d1 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 25 Nov 2022 10:09:11 +0100 Subject: [PATCH 25/29] simplifying skip using InstructionStream>>#willReturn + adding comment in skipJump --- Sindarin/SindarinDebugger.class.st | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index 137bce8..fc45fb9 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -557,22 +557,18 @@ SindarinDebugger >> sindarinSession: aSindarinDebugSession [ { #category : #'stepping - skip' } SindarinDebugger >> skip [ - | nextBytecode instructionStream | + | instructionStream | "If it is a message send or assignment, skips the execution of the current instruction, and puts nil on the execution stack." self node isAssignment ifTrue: [ ^ self skipAssignmentNodeCompletely ]. "We need to treat jumps before messages because if it is associated to a message node, it would pop the arguments of the message, that aren't on the stack if they are jumps" instructionStream := self context instructionStream. - (instructionStream willJumpTo or: [ - instructionStream willJumpIfFalse or: [ - instructionStream willJumpIfTrue ] ]) ifTrue: [ ^ self skipJump ]. + (instructionStream willJump) ifTrue: [ ^ self skipJump ]. self node isMessage ifTrue: [ ^ self skipMessageNode ]. self node isMethod ifTrue: [ ^ self step ]. self node isBlock ifTrue: [ ^ self skipBlockNode ]. - nextBytecode := self currentBytecode detect: [ :each | - each offset = self pc ]. (self node isReturn or: [ - nextBytecode bytes first between: 88 and: 94 ]) ifTrue: [ + instructionStream willReturn ]) ifTrue: [ ^ self skipReturnNode ]. self node isSequence ifTrue: [ ^ self step ] @@ -632,6 +628,7 @@ 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 willJumpIfTrue ]) ifTrue: [ self context pop ]. nextBytecode := self currentBytecode detect: [ :each | From bdfc0771f33d094db0cb330d20f5c2d55386e846 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Fri, 25 Nov 2022 10:27:29 +0100 Subject: [PATCH 26/29] refactoring skip to use double dispatch --- Sindarin/RBAssignmentNode.extension.st | 7 +++++++ Sindarin/RBBlockNode.extension.st | 7 +++++++ Sindarin/RBMessageNode.extension.st | 7 +++++++ Sindarin/RBProgramNode.extension.st | 9 +++++++++ Sindarin/RBReturnNode.extension.st | 7 +++++++ Sindarin/SindarinDebugger.class.st | 17 +++++------------ 6 files changed, 42 insertions(+), 12 deletions(-) create mode 100644 Sindarin/RBAssignmentNode.extension.st create mode 100644 Sindarin/RBBlockNode.extension.st create mode 100644 Sindarin/RBMessageNode.extension.st create mode 100644 Sindarin/RBProgramNode.extension.st create mode 100644 Sindarin/RBReturnNode.extension.st diff --git a/Sindarin/RBAssignmentNode.extension.st b/Sindarin/RBAssignmentNode.extension.st new file mode 100644 index 0000000..6878bcd --- /dev/null +++ b/Sindarin/RBAssignmentNode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #RBAssignmentNode } + +{ #category : #'*Sindarin' } +RBAssignmentNode >> skipWithDebugger: aSindarinDebugger [ + + aSindarinDebugger skipAssignmentNodeCompletely +] diff --git a/Sindarin/RBBlockNode.extension.st b/Sindarin/RBBlockNode.extension.st new file mode 100644 index 0000000..bec38e5 --- /dev/null +++ b/Sindarin/RBBlockNode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #RBBlockNode } + +{ #category : #'*Sindarin' } +RBBlockNode >> skipWithDebugger: aSindarinDebugger [ + + aSindarinDebugger skipBlockNode +] diff --git a/Sindarin/RBMessageNode.extension.st b/Sindarin/RBMessageNode.extension.st new file mode 100644 index 0000000..20711a9 --- /dev/null +++ b/Sindarin/RBMessageNode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #RBMessageNode } + +{ #category : #'*Sindarin' } +RBMessageNode >> skipWithDebugger: aSindarinDebugger [ + + aSindarinDebugger skipMessageNode +] diff --git a/Sindarin/RBProgramNode.extension.st b/Sindarin/RBProgramNode.extension.st new file mode 100644 index 0000000..129da3b --- /dev/null +++ b/Sindarin/RBProgramNode.extension.st @@ -0,0 +1,9 @@ +Extension { #name : #RBProgramNode } + +{ #category : #'*Sindarin' } +RBProgramNode >> skipWithDebugger: aSindarinDebugger [ + + aSindarinDebugger step + + +] diff --git a/Sindarin/RBReturnNode.extension.st b/Sindarin/RBReturnNode.extension.st new file mode 100644 index 0000000..e9ffb01 --- /dev/null +++ b/Sindarin/RBReturnNode.extension.st @@ -0,0 +1,7 @@ +Extension { #name : #RBReturnNode } + +{ #category : #'*Sindarin' } +RBReturnNode >> skipWithDebugger: aSindarinDebugger [ + + aSindarinDebugger skipReturnNode +] diff --git a/Sindarin/SindarinDebugger.class.st b/Sindarin/SindarinDebugger.class.st index fc45fb9..f7080e5 100644 --- a/Sindarin/SindarinDebugger.class.st +++ b/Sindarin/SindarinDebugger.class.st @@ -558,20 +558,13 @@ SindarinDebugger >> sindarinSession: aSindarinDebugSession [ SindarinDebugger >> skip [ | instructionStream | - "If it is a message send or assignment, skips the execution of the current instruction, and puts nil on the execution stack." - self node isAssignment ifTrue: [ ^ self skipAssignmentNodeCompletely ]. - "We need to treat jumps before messages because if it is associated to a message node, it would pop the arguments of the message, that aren't on the stack if they are jumps" instructionStream := self context instructionStream. - (instructionStream willJump) ifTrue: [ ^ self skipJump ]. - self node isMessage ifTrue: [ ^ self skipMessageNode ]. - self node isMethod ifTrue: [ ^ self step ]. - self node isBlock ifTrue: [ ^ self skipBlockNode ]. - - (self node isReturn or: [ - instructionStream willReturn ]) ifTrue: [ - ^ self skipReturnNode ]. + "We need to treat jumps before messages because if it is associated to a message node, it would pop the arguments of the message, that aren't on the stack if they are jumps" + instructionStream willJump ifTrue: [ ^ self skipJump ]. + "A return bytecode can be on any node so have to treat it here systematically" + instructionStream willReturn ifTrue: [ ^ self skipReturnNode ]. - self node isSequence ifTrue: [ ^ self step ] + self node skipWithDebugger: self ] { #category : #'stepping - skip' } From 9166045679eeb49b31fcde3c78128722c8324aa6 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Mon, 6 Feb 2023 15:09:53 +0100 Subject: [PATCH 27/29] Update RBBlockNode.extension.st --- Sindarin/RBBlockNode.extension.st | 1 + 1 file changed, 1 insertion(+) diff --git a/Sindarin/RBBlockNode.extension.st b/Sindarin/RBBlockNode.extension.st index 53f5e55..9b28646 100644 --- a/Sindarin/RBBlockNode.extension.st +++ b/Sindarin/RBBlockNode.extension.st @@ -38,6 +38,7 @@ RBBlockNode >> parentOfIdenticalSubtree: subtree [ detect: [ :e | e == subtree ] ifFound: [ :e | e parent ] ifNone: [ nil ] +] RBBlockNode >> skipWithDebugger: aSindarinDebugger [ From f95a1ebd85f40a0a53f8eaa2a665d9e733902e14 Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Mon, 6 Feb 2023 15:11:11 +0100 Subject: [PATCH 28/29] Update RBProgramNode.extension.st --- Sindarin/RBProgramNode.extension.st | 1 + 1 file changed, 1 insertion(+) diff --git a/Sindarin/RBProgramNode.extension.st b/Sindarin/RBProgramNode.extension.st index c218827..4a9b9f7 100644 --- a/Sindarin/RBProgramNode.extension.st +++ b/Sindarin/RBProgramNode.extension.st @@ -9,6 +9,7 @@ RBProgramNode >> allChildrenPostOrder [ each allChildrenPostOrder do: [ :child | children addLast: child ] ]. children addLast: self. ^ children +] RBProgramNode >> skipWithDebugger: aSindarinDebugger [ From d1a09a9483337c084c2c01d28fce22411e2db00b Mon Sep 17 00:00:00 2001 From: adri09070 <97704417+adri09070@users.noreply.github.com> Date: Mon, 6 Feb 2023 15:21:49 +0100 Subject: [PATCH 29/29] classifying extension methods --- Sindarin/RBBlockNode.extension.st | 1 + Sindarin/RBProgramNode.extension.st | 1 + 2 files changed, 2 insertions(+) diff --git a/Sindarin/RBBlockNode.extension.st b/Sindarin/RBBlockNode.extension.st index 9b28646..fdd3133 100644 --- a/Sindarin/RBBlockNode.extension.st +++ b/Sindarin/RBBlockNode.extension.st @@ -40,6 +40,7 @@ RBBlockNode >> parentOfIdenticalSubtree: subtree [ ifNone: [ nil ] ] +{ #category : #'*Sindarin' } RBBlockNode >> skipWithDebugger: aSindarinDebugger [ aSindarinDebugger skipBlockNode diff --git a/Sindarin/RBProgramNode.extension.st b/Sindarin/RBProgramNode.extension.st index 4a9b9f7..2887116 100644 --- a/Sindarin/RBProgramNode.extension.st +++ b/Sindarin/RBProgramNode.extension.st @@ -11,6 +11,7 @@ RBProgramNode >> allChildrenPostOrder [ ^ children ] +{ #category : #'*Sindarin' } RBProgramNode >> skipWithDebugger: aSindarinDebugger [ aSindarinDebugger step