diff --git a/src/Debugging-Core/EncoderForSistaV1.extension.st b/src/Debugging-Core/EncoderForSistaV1.extension.st new file mode 100644 index 00000000000..3db85f4c432 --- /dev/null +++ b/src/Debugging-Core/EncoderForSistaV1.extension.st @@ -0,0 +1,69 @@ +Extension { #name : 'EncoderForSistaV1' } + +{ #category : '*Debugging-Core' } +EncoderForSistaV1 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 : '*Debugging-Core' } +EncoderForSistaV1 class >> selectorToSendOrItselfFor: anInstructionStream in: method at: pc [ + "If anInstructionStream is at a send bytecode then answer the send's selector, + otherwise answer anInstructionStream itself. The rationale for answering + 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 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. + byte < 96 ifTrue: + [^anInstructionStream]. + byte <= 175 ifTrue: + ["special byte or short send" + ^byte >= 128 + ifTrue: [method literalAt: (byte bitAnd: 15) + 1] + ifFalse: [Smalltalk specialSelectorAt: byte - 95]]. + byte < 234 ifTrue: "need to check for either extension cuz order of extensions is not restricted. so extB could preceed extA" + [(byte >= 224 and: [byte <= 225]) ifTrue: + [^self extensionsAt: pc in: method into: + [:extA :extB :nExtBytes| | byteAfter index | + byteAfter := method at: pc + nExtBytes. + (byteAfter >= 234 and: [byteAfter <= 235]) + ifTrue: + [index := ((method at: pc + nExtBytes + 1) bitShift: -3) + (extA bitShift: 5). + method literalAt: index + 1] + ifFalse: [anInstructionStream]]]. + ^anInstructionStream]. + byte > 235 ifTrue: + [^anInstructionStream]. + "they could be extended..." + ^self extensionsFor: pc in: method into: + [:extA :extB :nExtBytes| | index | + index := ((method at: pc + 1) bitShift: -3) + (extA bitShift: 5). + method literalAt: index + 1] +] diff --git a/src/Debugging-Core/InstructionStream.extension.st b/src/Debugging-Core/InstructionStream.extension.st index e0258ccd851..fb8ee38a5b7 100644 --- a/src/Debugging-Core/InstructionStream.extension.st +++ b/src/Debugging-Core/InstructionStream.extension.st @@ -97,13 +97,6 @@ InstructionStream >> scanFor: scanBlock [ ^false ] -{ #category : '*Debugging-Core' } -InstructionStream >> secondByte [ - "Answer the second byte of the current bytecode." - - ^self method at: pc + 1 -] - { #category : '*Debugging-Core' } InstructionStream >> selectorToSendOrSelf [ "If this instruction is a send, answer the selector, otherwise answer self." diff --git a/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st b/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st index 006c8cc0aa0..11ce6f8e442 100644 --- a/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st +++ b/src/Kernel-BytecodeEncoders/EncoderForSistaV1.class.st @@ -365,23 +365,6 @@ EncoderForSistaV1 class >> extensionsAt: bcpc in: method into: aTrinaryBlock [ Time millisecondsToRun: [1 to: n do: [:i| (byte bitAnd: 16rFE) = 16rE0 ifTrue: []]] }] #(#(297 599) #(702 671))" ] -{ #category : 'instruction stream support' } -EncoderForSistaV1 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 : 'compiled method support' } EncoderForSistaV1 class >> firstSpecialSelectorByte [ ^ 16r5F @@ -805,57 +788,6 @@ EncoderForSistaV1 class >> readsThisContextFor: compiledMethod [ [:instr | instr = 82 ] ] -{ #category : 'bytecode decoding' } -EncoderForSistaV1 class >> selectorToSendOrItselfFor: anInstructionStream in: method at: pc [ - "If anInstructionStream is at a send bytecode then answer the send's selector, - otherwise answer anInstructionStream itself. The rationale for answering - 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 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. - byte < 96 ifTrue: - [^anInstructionStream]. - byte <= 175 ifTrue: - ["special byte or short send" - ^byte >= 128 - ifTrue: [method literalAt: (byte bitAnd: 15) + 1] - ifFalse: [Smalltalk specialSelectorAt: byte - 95]]. - byte < 234 ifTrue: "need to check for either extension cuz order of extensions is not restricted. so extB could preceed extA" - [(byte >= 224 and: [byte <= 225]) ifTrue: - [^self extensionsAt: pc in: method into: - [:extA :extB :nExtBytes| | byteAfter index | - byteAfter := method at: pc + nExtBytes. - (byteAfter >= 234 and: [byteAfter <= 235]) - ifTrue: - [index := ((method at: pc + nExtBytes + 1) bitShift: -3) + (extA bitShift: 5). - method literalAt: index + 1] - ifFalse: [anInstructionStream]]]. - ^anInstructionStream]. - byte > 235 ifTrue: - [^anInstructionStream]. - "they could be extended..." - ^self extensionsFor: pc in: method into: - [:extA :extB :nExtBytes| | index | - index := ((method at: pc + 1) bitShift: -3) + (extA bitShift: 5). - method literalAt: index + 1] -] - { #category : 'compiled method support' } EncoderForSistaV1 class >> sendsToSuperFor: compiledMethod [ "Answer whether the receiver sends any message to super." diff --git a/src/Kernel-BytecodeEncoders/InstructionStream.extension.st b/src/Kernel-BytecodeEncoders/InstructionStream.extension.st new file mode 100644 index 00000000000..13b231bfd2b --- /dev/null +++ b/src/Kernel-BytecodeEncoders/InstructionStream.extension.st @@ -0,0 +1,8 @@ +Extension { #name : 'InstructionStream' } + +{ #category : '*Kernel-BytecodeEncoders' } +InstructionStream >> secondByte [ + "Answer the second byte of the current bytecode." + + ^self method at: pc + 1 +] diff --git a/src/Kernel-BytecodeEncoders/ManifestKernelBytecodeEncoders.class.st b/src/Kernel-BytecodeEncoders/ManifestKernelBytecodeEncoders.class.st new file mode 100644 index 00000000000..49b03cede39 --- /dev/null +++ b/src/Kernel-BytecodeEncoders/ManifestKernelBytecodeEncoders.class.st @@ -0,0 +1,16 @@ +" +Please describe the package using the class comment of the included manifest class. The manifest class also includes other additional metadata for the package. These meta data are used by other tools such as the SmalllintManifestChecker and the critics Browser +" +Class { + #name : 'ManifestKernelBytecodeEncoders', + #superclass : 'PackageManifest', + #category : 'Kernel-BytecodeEncoders-Manifest', + #package : 'Kernel-BytecodeEncoders', + #tag : 'Manifest' +} + +{ #category : 'meta-data - dependency analyser' } +ManifestKernelBytecodeEncoders class >> manuallyResolvedDependencies [ + + ^ #( #'System-Support' ) +]