Move to caret integration to Pharo11

Sindarin/Context.extension.st

@@ -0,0 +1,18 @@
+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 willSendOrReturnOrStoreOrCreateBlock or: [ stream willJump ] ] ] 
+		whileFalse: [ 
+			context := stream interpretNextInstructionFor: self.
+			context == self ifFalse: [ "Caused by mustBeBoolean handling" 
+				^ context ] ]
+]

Sindarin/DebugSession.extension.st

@@ -4,3 +4,28 @@ 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
+]
+
+{ #category : #'*Sindarin' }
+DebugSession >> suspendedContext: aContext [ 
+
+	interruptedContext := aContext
+]

Sindarin/InstructionStream.extension.st

@@ -0,0 +1,38 @@
+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."
+
+	^ 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
+]
+
+{ #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 ] ] ]
+]

Sindarin/NodeNotInASTError.class.st

@@ -0,0 +1,8 @@
+"
+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,
+	#category : #'Sindarin-Exceptions'
+}

Sindarin/NotValidPcError.class.st

@@ -0,0 +1,8 @@
+"
+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,
+	#category : #'Sindarin-Exceptions'
+}

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 ]
+]

Sindarin/Process.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #Process }
+
+{ #category : #'*Sindarin' }
+Process >> stepToSendOrReturnOrJump [
+
+	^Processor activeProcess
+		evaluate: [suspendedContext := suspendedContext stepToSendOrReturnOrJump]
+		onBehalfOf: self
+]

Sindarin/RBAssignmentNode.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #RBAssignmentNode }
+
+{ #category : #'*Sindarin' }
+RBAssignmentNode >> skipWithDebugger: aSindarinDebugger [
+
+	aSindarinDebugger skipAssignmentNodeCompletely 
+]

Sindarin/RBBlockNode.extension.st

@@ -0,0 +1,47 @@
+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 [
+
+	^ self allChildren reversed
+		  detect: [ :e | e == subtree ]
+		  ifFound: [ :e | e parent ]
+		  ifNone: [ nil ]
+]
+
+{ #category : #'*Sindarin' }
+RBBlockNode >> skipWithDebugger: aSindarinDebugger [
+
+	aSindarinDebugger skipBlockNode 
+]

Sindarin/RBMessageNode.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #RBMessageNode }
+
+{ #category : #'*Sindarin' }
+RBMessageNode >> skipWithDebugger: aSindarinDebugger [
+
+	aSindarinDebugger skipMessageNode 
+]

Sindarin/RBMethodNode.extension.st

@@ -0,0 +1,57 @@
+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 [
+
+	^ 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' }
+RBMethodNode >> parentOfIdenticalSubtree: subtree [
+
+	^ self allChildren reversed
+		  detect: [ :e | e == 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
+]

Sindarin/RBProgramNode.extension.st

@@ -0,0 +1,18 @@
+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
+]
+
+{ #category : #'*Sindarin' }
+RBProgramNode >> skipWithDebugger: aSindarinDebugger [
+
+	aSindarinDebugger step
+]

Sindarin/RBReturnNode.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #RBReturnNode }
+
+{ #category : #'*Sindarin' }
+RBReturnNode >> skipWithDebugger: aSindarinDebugger [
+
+	aSindarinDebugger skipReturnNode
+]