Merge pull request #1872 from pavel-krivanek/19927-scanFor-should-not…

…-elide-extended-byte-codes 19927-scanFor-should-not-elide-extended-byte-codes
pharo-project · Nov 30, 2018 · 36f7fe2 · 36f7fe2
2 parents e38d5cb + 48f579f
commit 36f7fe2
Show file tree

Hide file tree

Showing 3 changed files with 56 additions and 24 deletions.
diff --git a/src/Debugging-Core/InstructionStream.extension.st b/src/Debugging-Core/InstructionStream.extension.st
@@ -292,16 +292,18 @@ InstructionStream >> previousPc [
 
 { #category : #'*Debugging-Core' }
 InstructionStream >> scanFor: scanBlock [
-	"Answer the index of the first bytecode for which scanBlock
-	 answers true when supplied with that bytecode."
+	"Check all bytecode instructions with scanBlock, answer true if scanBlock answers true.
+	This can be used to, e.g., check whether a method contains 'push closure' bytecodes like this:
+	aMethod scanFor: [ :b | b = 143 ]"
 
-	| method end |
+	| method encoderClass end byte |
 	method := self method.
 	end := method endPC.
+	encoderClass := method encoderClass.
 	[pc <= end] whileTrue: 
-		[(scanBlock value: (method at: pc)) ifTrue: [^true].
-		[self method encoderClass isExtension: (self method at: pc)] whileTrue: [pc := pc + 2].
-		pc := self nextPc: (method at: pc)].
+		[(scanBlock value: (byte := method at: pc)) ifTrue:
+			[^true].
+		 pc := pc + (encoderClass bytecodeSize: byte)].
 	^false
 ]
 

diff --git a/src/Kernel-BytecodeEncoders/BytecodeEncoder.class.st b/src/Kernel-BytecodeEncoders/BytecodeEncoder.class.st
@@ -13,6 +13,29 @@ Class {
 	#category : #'Kernel-BytecodeEncoders'
 }
 
+{ #category : #'instruction stream support' }
+BytecodeEncoder class >> extensionsFor: pc in: aCompiledMethod into: trinaryBlock [
+	"If the bytecode at pc is an extension, or if the bytecode at pc is preceeded by extensions,
+	 then evaluate aTrinaryBlock with the values of extA and extB and number of extension *bytes*.
+	 If the bytecode at pc is neither an extension or extended then evaluate with 0, 0, 0."
+
+	| prevPC |
+	"If there is what appears to be an extension bytecode before this bytecode
+	 then scan for the previous pc to confirm."
+	(pc - 2 >= aCompiledMethod initialPC
+	 and: [self isExtension: (aCompiledMethod at: pc - 2)]) ifTrue:
+		[prevPC := aCompiledMethod pcPreviousTo: pc.
+		 (self nonExtensionPcAt: prevPC in: aCompiledMethod) = pc ifTrue:
+			[^self extensionsAt: prevPC in: aCompiledMethod into: trinaryBlock]].
+	^self extensionsAt: pc in: aCompiledMethod into: trinaryBlock
+]
+
+{ #category : #'instruction stream support' }
+BytecodeEncoder class >> isExtension: byte [
+	"Answer if the bytecode is that of an extension bytecodee (a prefix for other bytecodes to extend their range)."
+	^self subclassResponsibility
+]
+
 { #category : #'bytecode decoding' }
 BytecodeEncoder class >> nonExtensionBytecodeAt: pc in: method [
 	"Answer the actual bytecode at pc in method, skipping past any preceeding extensions."
@@ -23,6 +46,16 @@ BytecodeEncoder class >> nonExtensionBytecodeAt: pc in: method [
 	^bytecode
 ]
 
+{ #category : #'instruction stream support' }
+BytecodeEncoder class >> nonExtensionPcAt: pc in: method [
+	"Answer the pc of the actual bytecode at pc in method, skipping past any preceeding extensions."
+	| thePC bytecode |
+	thePC := pc.
+	[self isExtension: (bytecode := method at: thePC)] whileTrue:
+		[thePC := thePC + (self bytecodeSize: bytecode)].
+	^thePC
+]
+
 { #category : #'bytecode decoding' }
 BytecodeEncoder class >> specialSelectors [	
 	^ #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr: #at: #at:put: #size #next #nextPut: #atEnd #'==' nil "class" #'~~' #value #value: #do: #new #new: #x #y)

diff --git a/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st b/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st
@@ -786,23 +786,20 @@ EncoderForSistaV1 class >> selectorToSendOrItselfFor: anInstructionStream in: me
 	 anInstructionStream instead of, say, nil, is that potentially any existing object
 	 can be used as a selector, but since anInstructionStream postdates the method,
 	 it can't be one of them.
-
-	 The compilcation is that for convenience we assume the pc could be
-	 pointing to the raw send bytecode after its extensions, or at the extension
-	 preceeding the raw send bytecode.
-		96-111		0110 iiii			Send Arithmetic Message #iiii #(#+ #- #< #> #'<=' #'>=' #= #'~=' #* #/ #'\\' #@ #bitShift: #'//' #bitAnd: #bitOr:)
-		112-119	01110 iii			Send Special Message #iii #(#at: #at:put: #size #next #nextPut: #atEnd #'==' class)
-		120		01111000			UNASSIGNED (was: blockCopy:)
-		121		01111001			Send Special Message #value
-		122-123	0111101 i			Send Special Message #i #(#value: #do:)
-		124-127	011111 ii			Send Special Message #ii #(#new #new: #x #y))
-		128-143	1000 iiii			Send Literal Selector #iiii With 0 Argument
-		144-159	1001 iiii			Send Literal Selector #iiii With 1 Arguments
-		160-175	1010 iiii			Send Literal Selector #iiii With 2 Arguments
-	*	224		11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
-	*	225		11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
-	**	234		11101010	iiiiijjj		Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments
-	**	235		11101011	iiiiijjj		Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments"
+	 The complication is that for convenience we allow the pc to point to the
+	 raw send bytecode after its extension(s), or at the extension(s) preceeding it.
+	96-111		0110 iiii			Send Arithmetic Message #iiii (+ - < > <= >= = ~= * / \\ @ bitShift: // bitAnd: bitOr:)
+	112-119	01110 iii			Send Special Message #iii + 0 (at: at:put: size next nextPut: atEnd == class)
+	120-127	01111 iii			Send Special Message #iii + 8 (~~ value value: do: new new: x y)
+	128-143	1000 iiii			Send Literal Selector #iiii With 0 Argument
+	144-159	1001 iiii			Send Literal Selector #iiii With 1 Arguments
+	160-175	1010 iiii			Send Literal Selector #iiii With 2 Arguments
+	*	224	11100000	aaaaaaaa	Extend A (Ext A = Ext A prev * 256 + Ext A)
+	*	225	11100001	bbbbbbbb	Extend B (Ext B = Ext B prev * 256 + Ext B)
+	**	234	11101010	iiiiijjj		Send Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments
+	**	235	11101011	iiiiijjj	ExtendB < 64
+										ifTrue: [Send To Superclass Literal Selector #iiiii (+ Extend A * 32) with jjj (+ Extend B * 8) Arguments]
+										ifFalse: [Send To Superclass of Stacked Class Literal Selector #iiiii (+ Extend A * 32) with jjj (+ (Extend B "
 
 	| byte |
 	byte := method at: pc.
@@ -827,7 +824,7 @@ EncoderForSistaV1 class >> selectorToSendOrItselfFor: anInstructionStream in: me
 	byte > 235 ifTrue:
 		[^anInstructionStream].
 	"they could be extended..."
-	^self extensionsAt: pc in: method into:
+	^self extensionsFor: pc in: method into:
 		[:extA :extB :nExtBytes| | index |
 		 index := ((method at: pc + 1) bitShift: -3) + (extA bitShift: 5).
 		 method literalAt: index + 1]