Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-cb.38.mcz
==================== Summary ====================
Name: MethodMassage-cb.38
Author: cb
Time: 10 April 2016, 9:37:36.470084 am
UUID: 8c351338-574b-4db5-a2aa-76b0b5a43da3
Ancestors: MethodMassage-eem.37
Added partial support for full closure
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genTrapIfNotInstanceOf: litIndex!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
self literal: (methodClass bindingOf: aSymbol)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector: primitive:
numArgs: numTemps: frameSize: flag: signFlag: trailerData:)
with: #( compiledMethodClass methodClass selector primitive
numArgs numTemps frameSize flag signFlag trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse: [aStream nextPutAll: 'binding: '; store: litOrBinding key].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: (code literals isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: code literals
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue: "kind of crappy that there's no setter..."
[header := header bitOr: (1 << 29)].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings and the methodClass literal.."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isVariableBinding ifFalse:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: aMethod literals
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: EncoderForNewsqueakV4 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
" 16-31 0001 i i i i Push Literal Variable #iiii
32-63 001 i i i i i Push Literal #iiiii
* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A)
* 227 11100011 i i i i i i i i Push Literal Variable #iiiiiiii (+ Extend A * 256)
* 228 11100100 i i i i i i i i Push Literal #iiiiiiii (+ Extend A * 256)
* 233 11101001 i i i i i i i i Store Literal Variable #iiiiiiii (+ Extend A * 256)
* 236 11101100 i i i i i i i i Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)"
| byte |
byte := aCompiledMethod at: pc.
byte <= 63 ifTrue:
[byte >= 32 ifTrue:
[^byte bitAnd: 16r1F].
^byte >= 16 ifTrue:
[byte bitAnd: 16rF]].
(#(227 228 233 236) includes: byte) ifTrue:
[^aCompiledMethod at: pc + 1].
(byte = 224 "Ext A"
and: [#(227 228 233 236) includes: (aCompiledMethod at: pc + 2)]) ifTrue:
[^(aCompiledMethod at: pc + 1) * 256 + (aCompiledMethod at: pc + 3)].
^nil!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForSistaV1 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
" 16-31 0001 i i i i Push Literal Variable #iiii
32-63 001 i i i i i Push Literal #iiiii
* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A)
* 227 11100011 i i i i i i i i Push Literal Variable #iiiiiiii (+ Extend A * 256)
* 228 11100100 i i i i i i i i Push Literal #iiiiiiii (+ Extend A * 256)
* 241 11110001 iiiiiiii Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
* 244 11110100 iiiiiiii Store Literal Variable #iiiiiiii (+ Extend A * 256)"
| byte |
byte := aCompiledMethod at: pc.
byte <= 63 ifTrue:
[byte >= 32 ifTrue:
[^byte bitAnd: 16r1F].
^byte >= 16 ifTrue:
[byte bitAnd: 16rF]].
(#(227 228 241 244) includes: byte) ifTrue:
[^aCompiledMethod at: pc + 1].
(byte = 224 "Ext A"
and: [#(227 228 241 244) includes: (aCompiledMethod at: pc + 2)]) ifTrue:
[^(aCompiledMethod at: pc + 1) * 256 + (aCompiledMethod at: pc + 3)].
^nil!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-cb.39.mcz
==================== Summary ====================
Name: MethodMassage-cb.39
Author: cb
Time: 5 September 2016, 9:53:50.793771 am
UUID: 732f714d-2b28-4714-ac6f-ff3e54736327
Ancestors: MethodMassage-cb.38
Added basic support for disassembling and reassembling full blocks.
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genTrapIfNotInstanceOf: litIndex!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
self literal: (methodClass bindingOf: aSymbol)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector: primitive:
numArgs: numTemps: frameSize: flag: signFlag: trailerData:)
with: #( compiledMethodClass methodClass selector primitive
numArgs numTemps frameSize flag signFlag trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse: [
litOrBinding isCompiledMethod
ifTrue: [ aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this" ]
ifFalse:
[litOrBinding class == AssemblerMethod "Is there a better way of testing this ?"
ifFalse: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifTrue:
[aStream nextPutAll: 'literal: '.
aStream nextPut: $(.
litOrBinding printAsAssemblerOn: aStream.
aStream nextPut: $)]]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: (code literals isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: code literals
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue: "kind of crappy that there's no setter..."
[header := header bitOr: (1 << 29)].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings and the methodClass literal.."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isVariableBinding ifFalse:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (self disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [ self error: 'cannot encode the method' ].
. instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: { litIndex . numCopied. rcvrOnStack . ignoreOuterContext })!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: EncoderForNewsqueakV4 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
" 16-31 0001 i i i i Push Literal Variable #iiii
32-63 001 i i i i i Push Literal #iiiii
* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A)
* 227 11100011 i i i i i i i i Push Literal Variable #iiiiiiii (+ Extend A * 256)
* 228 11100100 i i i i i i i i Push Literal #iiiiiiii (+ Extend A * 256)
* 233 11101001 i i i i i i i i Store Literal Variable #iiiiiiii (+ Extend A * 256)
* 236 11101100 i i i i i i i i Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)"
| byte |
byte := aCompiledMethod at: pc.
byte <= 63 ifTrue:
[byte >= 32 ifTrue:
[^byte bitAnd: 16r1F].
^byte >= 16 ifTrue:
[byte bitAnd: 16rF]].
(#(227 228 233 236) includes: byte) ifTrue:
[^aCompiledMethod at: pc + 1].
(byte = 224 "Ext A"
and: [#(227 228 233 236) includes: (aCompiledMethod at: pc + 2)]) ifTrue:
[^(aCompiledMethod at: pc + 1) * 256 + (aCompiledMethod at: pc + 3)].
^nil!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForSistaV1 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
" 16-31 0001 i i i i Push Literal Variable #iiii
32-63 001 i i i i i Push Literal #iiiii
* 224 11100000 aaaaaaaa Extend A (Ext A = Ext A prev * 256 + Ext A)
* 227 11100011 i i i i i i i i Push Literal Variable #iiiiiiii (+ Extend A * 256)
* 228 11100100 i i i i i i i i Push Literal #iiiiiiii (+ Extend A * 256)
* 241 11110001 iiiiiiii Pop and Store Literal Variable #iiiiiiii (+ Extend A * 256)
* 244 11110100 iiiiiiii Store Literal Variable #iiiiiiii (+ Extend A * 256)"
| byte |
byte := aCompiledMethod at: pc.
byte <= 63 ifTrue:
[byte >= 32 ifTrue:
[^byte bitAnd: 16r1F].
^byte >= 16 ifTrue:
[byte bitAnd: 16rF]].
(#(227 228 241 244) includes: byte) ifTrue:
[^aCompiledMethod at: pc + 1].
(byte = 224 "Ext A"
and: [#(227 228 241 244) includes: (aCompiledMethod at: pc + 2)]) ifTrue:
[^(aCompiledMethod at: pc + 1) * 256 + (aCompiledMethod at: pc + 3)].
^nil!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-eem.40.mcz
==================== Summary ====================
Name: MethodMassage-eem.40
Author: eem
Time: 17 January 2017, 5:25:25.863268 pm
UUID: 0988bac2-f375-4a8b-aafb-9f44ac345a59
Ancestors: MethodMassage-cb.39
Don't create Undeclared bindings for now.
Add support for assembling callInlinePrimitive: trap and branchIfNotInstanceOf:.
Add literalIndexOfBytecodeAt:in: for SustaV1 and NewspeakV4
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
----- Method: BytecodeEmitter>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genTrapIfNotInstanceOf: litIndex!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector: primitive:
numArgs: numTemps: frameSize: flag: signFlag: trailerData:)
with: #( compiledMethodClass methodClass selector primitive
numArgs numTemps frameSize flag signFlag trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse: [
litOrBinding isCompiledMethod
ifTrue: [ aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this" ]
ifFalse:
[litOrBinding class == AssemblerMethod "Is there a better way of testing this ?"
ifFalse: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifTrue:
[aStream nextPutAll: 'literal: '.
aStream nextPut: $(.
litOrBinding printAsAssemblerOn: aStream.
aStream nextPut: $)]]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: (code literals isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: code literals
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue: "kind of crappy that there's no setter..."
[header := header bitOr: (1 << 29)].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings and the methodClass literal.."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isVariableBinding ifFalse:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (self disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [ self error: 'cannot encode the method' ].
. instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: { litIndex . numCopied. rcvrOnStack . ignoreOuterContext })!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-cb.41.mcz
==================== Summary ====================
Name: MethodMassage-cb.41
Author: cb
Time: 20 March 2017, 1:50:25.931404 pm
UUID: ce092e18-e012-4829-b930-39f2fa3e60b4
Ancestors: MethodMassage-eem.40
Various fixes to support sista instructions.
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^ encoder genBranchIfInstanceOf: litIndex distance: distance orNot: false!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeBranchIfInstanceOf: litIndex distance: distance orNot: false!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector: primitive:
numArgs: numTemps: frameSize: flag: signFlag: trailerData:)
with: #( compiledMethodClass methodClass selector primitive
numArgs numTemps frameSize flag signFlag trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse: [
litOrBinding isCompiledMethod
ifTrue: [ aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this" ]
ifFalse:
[litOrBinding class == AssemblerMethod "Is there a better way of testing this ?"
ifFalse: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifTrue:
[aStream nextPutAll: 'literal: '.
aStream nextPut: $(.
litOrBinding printAsAssemblerOn: aStream.
aStream nextPut: $)]]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod newLits |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: ((newLits := self getLiterals: code literals) isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: newLits
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue: "kind of crappy that there's no setter..."
[header := header bitOr: (1 << 29)].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings and the methodClass literal.."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isVariableBinding ifFalse:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (self disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [ self error: 'cannot encode the method' ].
. instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: { litIndex . numCopied. rcvrOnStack . ignoreOuterContext })!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-ClementBera.41.mcz
==================== Summary ====================
Name: MethodMassage-ClementBera.41
Author: ClementBera
Time: 22 March 2017, 3:49:21.866794 pm
UUID: dff6ef4e-bb07-0d00-8b20-a19c0870a75e
Ancestors: MethodMassage-eem.40
improved printing of assemblerMethods.
==================== Snapshot ====================
SystemOrganization addCategory: #MethodMassage!
SystemOrganization addCategory: 'MethodMassage-Coverage'!
SystemOrganization addCategory: 'MethodMassage-Kernel'!
SystemOrganization addCategory: 'MethodMassage-Tests'!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
----- Method: BytecodeEmitter>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genTrapIfNotInstanceOf: litIndex!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector: primitive:
numArgs: numTemps: frameSize: flag: signFlag: trailerData:)
with: #( compiledMethodClass methodClass selector primitive
numArgs numTemps frameSize flag signFlag trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse: [
litOrBinding isCompiledMethod
ifTrue: [ aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this" ]
ifFalse:
[litOrBinding class == AssemblerMethod "Is there a better way of testing this ?"
ifFalse: [
litOrBinding isVariableBinding
ifTrue: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifFalse: [litOrBinding class == SoDeoptMetadata
ifTrue: [ aStream nextPutAll: 'literal: #DeoptMetadata' ]
ifFalse: [
(litOrBinding isCompiledCode
and: [ litOrBinding isCompiledBlock ])
ifFalse: [
self assert: (litOrBinding isBehavior
or: [litOrBinding class == Point
or: [litOrBinding isArray
and: [litOrBinding allSatisfy: [:b | b isBehavior]]]]).
aStream nextPutAll: 'literal: '; print: litOrBinding ]]]]
ifTrue:
[aStream nextPutAll: 'literal: '.
aStream nextPut: $(.
litOrBinding printAsAssemblerOn: aStream.
aStream nextPut: $)]]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: (code literals isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: code literals
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue: "kind of crappy that there's no setter..."
[header := header bitOr: (1 << 29)].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings and the methodClass literal.."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isVariableBinding ifFalse:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals allButLast withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (BytecodeDisassembler new disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #popIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #popIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [ self error: 'cannot encode the method' ].
. instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: { litIndex . numCopied. rcvrOnStack . ignoreOuterContext })!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #pushRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #pushRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #storeIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #storeIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-cb.42.mcz
==================== Summary ====================
Name: MethodMassage-cb.42
Author: cb
Time: 20 March 2017, 2:11:48.55594 pm
UUID: 833c3eea-44e5-46cb-b8d6-6b2b80c29b90
Ancestors: MethodMassage-cb.41
fixed recursive CompiledBlock
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^ encoder genBranchIfInstanceOf: litIndex distance: distance orNot: false!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeBranchIfInstanceOf: litIndex distance: distance orNot: false!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector: primitive:
numArgs: numTemps: frameSize: flag: signFlag: trailerData:)
with: #( compiledMethodClass methodClass selector primitive
numArgs numTemps frameSize flag signFlag trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
"protocol: printing"
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse: [
litOrBinding isCompiledMethod
ifTrue: [ aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this" ]
ifFalse:
[litOrBinding class == AssemblerMethod "Is there a better way of testing this ?"
ifFalse: [
litOrBinding isVariableBinding
ifTrue: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifFalse: [litOrBinding key == #SoDeoptMetadata
ifTrue: [ aStream nextPutAll: 'literal: #DeoptMetadata' ]
ifFalse: [
(litOrBinding isCompiledCode
and: [ litOrBinding isCompiledBlock ])
ifFalse: [
self assert: (litOrBinding isBehavior
or: [litOrBinding class == Point
or: [litOrBinding isArray
and: [litOrBinding allSatisfy: [:b | b isBehavior]]]]).
aStream nextPutAll: 'literal: '; store: litOrBinding ]]]]
ifTrue:
[aStream nextPutAll: 'literal: '.
aStream nextPut: $(.
litOrBinding printAsAssemblerOn: aStream.
aStream nextPut: $)]]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod newLits |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: ((newLits := self getLiterals: code literals) isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: newLits
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue: "kind of crappy that there's no setter..."
[header := header bitOr: (1 << 29)].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings and the methodClass literal.."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isVariableBinding ifFalse:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals allButLast withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (BytecodeDisassembler new disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [ self error: 'cannot encode the method' ].
. instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: { litIndex . numCopied. rcvrOnStack . ignoreOuterContext })!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-eem.43.mcz
==================== Summary ====================
Name: MethodMassage-eem.43
Author: eem
Time: 22 March 2017, 8:04:43.9846 pm
UUID: 666a80de-4b04-4aa9-a981-36ffc347ecc9
Ancestors: MethodMassage-cb.42, MethodMassage-ClementBera.41
Fix nasty bug in emnitMethod that caused class kiterals to be duplicated (Sista uses classes as literals in its trap tests),
Implement support for the RemoteInstanceVariable bytecodes.
Make branchIfInstanceOf:distance: use the riugth sizer.
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^ encoder genBranchIfInstanceOf: litIndex distance: distance orNot: false!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder genPushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder sizePushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector: primitive:
numArgs: numTemps: frameSize: flag: signFlag: trailerData:)
with: #( compiledMethodClass methodClass selector primitive
numArgs numTemps frameSize flag signFlag trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
"protocol: printing"
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse: [
litOrBinding isCompiledMethod
ifTrue: [ aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this" ]
ifFalse:
[litOrBinding class == AssemblerMethod "Is there a better way of testing this ?"
ifFalse: [
litOrBinding isVariableBinding
ifTrue: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifFalse: [litOrBinding key == #SoDeoptMetadata
ifTrue: [ aStream nextPutAll: 'literal: #DeoptMetadata' ]
ifFalse: [
(litOrBinding isCompiledCode
and: [ litOrBinding isCompiledBlock ])
ifFalse: [
self assert: (litOrBinding isBehavior
or: [litOrBinding class == Point
or: [litOrBinding isArray
and: [litOrBinding allSatisfy: [:b | b isBehavior]]]]).
aStream nextPutAll: 'literal: '; store: litOrBinding ]]]]
ifTrue:
[aStream nextPutAll: 'literal: '.
aStream nextPut: $(.
litOrBinding printAsAssemblerOn: aStream.
aStream nextPut: $)]]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod newLits |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: ((newLits := self getLiterals: code literals) isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: newLits
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue: "kind of crappy that there's no setter..."
[header := header bitOr: (1 << 29)].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings, the methodClass literal, and any exotica such as Behaviors and CompiledBlocks."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isLiteral ifTrue:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals allButLast withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (BytecodeDisassembler new disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #popIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #popIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [ self error: 'cannot encode the method' ].
. instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: { litIndex . numCopied. rcvrOnStack . ignoreOuterContext })!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #pushRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #pushRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #storeIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #storeIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-eem.44.mcz
==================== Summary ====================
Name: MethodMassage-eem.44
Author: eem
Time: 23 March 2017, 3:14:49.937959 pm
UUID: bc8aaeb8-5e9e-429b-9001-79e33a0794c1
Ancestors: MethodMassage-eem.43
Add support for importing unknown classes as instances of AssemblerAbsentClassImport. At the same time simplify printLiteralsForAssemblyOn: to avoid having to test for AssemblerMethod literals, making AssemblerMethod implement storeOn: as primAsAssemblerOn:.
Add support for Newspeak access modifiers and the Scorch/Sista no counters flag.
Change the branchjIf[Not]InstanceOf: handling to mirror push/store/pop literal, and don't use the orNot: flag.
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerAbsentClassImport
instanceVariableNames: 'className'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
----- Method: AssemblerAbsentClassImport class>>className: (in category 'instance creation') -----
className: nameOfAnAbsentClass
^self new className: nameOfAnAbsentClass; yourself!
----- Method: AssemblerAbsentClassImport>>className (in category 'accessing') -----
className
^className!
----- Method: AssemblerAbsentClassImport>>className: (in category 'accessing') -----
className: anObject
className := anObject.
!
----- Method: AssemblerAbsentClassImport>>forTheMetaclass (in category 'converting') -----
forTheMetaclass
^(className endsWith: ' class')
ifTrue: [self]
ifFalse: [self class className: className, ' class']!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^ encoder genBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>branchIfInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder genBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>branchIfNotInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfNotInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder genBranchIfNotInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder genPushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>branchIfInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder sizeBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>branchIfNotInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfNotInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder sizeBranchIfNotInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder sizePushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag noCountersFlag accessModifier trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:accessModifier:noCounters:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean accessModifier: accessModifierBits noCounters: noCountersBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new
literals: literalSequence
instructions: instructionSequence
numArgs: nArgs
numTemps: nTemps
frameSize: frameSizeNum
primitive: primitiveIndex
flag: flagBoolean
signFlag: signFlagBoolean
accessModifier: accessModifierBits
noCounters: noCountersBoolean
trailer: methodTrailer
methodClass: class
selector: aSelector
compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>accessModifier (in category 'accessing') -----
accessModifier
^ accessModifier
!
----- Method: AssemblerMethod>>accessModifier: (in category 'accessing') -----
accessModifier: anObject
accessModifier := anObject.
!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>importLiteral: (in category 'assembling') -----
importLiteral: classNameOrArrayOfClassNames
"Add as a literal the resolution of classNameOrArrayOfClassNames to class(es) present in the system or AbsentClassImport(s) as appropriate."
^self literal: (self resolveImportLiteral: classNameOrArrayOfClassNames)!
----- Method: AssemblerMethod>>importStringFor: (in category 'printing') -----
importStringFor: behaviorOrArrayOfBehaviors
^behaviorOrArrayOfBehaviors isBehavior
ifTrue: [behaviorOrArrayOfBehaviors name printString]
ifFalse: [(behaviorOrArrayOfBehaviors collect: [:behavior| behavior name]) printString]!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:accessModifier:noCounters:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean accessModifier: accessModifierBits noCounters: noCountersBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
noCountersFlag := noCountersBoolean.
accessModifier := accessModifierBits.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass"
^ methodClass!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>noCountersFlag (in category 'accessing') -----
noCountersFlag
^ noCountersFlag
!
----- Method: AssemblerMethod>>noCountersFlag: (in category 'accessing') -----
noCountersFlag: anObject
noCountersFlag := anObject.
!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector:
primitive: numArgs: numTemps: frameSize:
flag: signFlag: noCountersFlag: accessModifier:
trailerData:)
with: #(compiledMethodClass methodClass selector
primitive numArgs numTemps frameSize
flag signFlag noCountersFlag accessModifier
trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse:
[litOrBinding isVariableBinding
ifTrue: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifFalse:
[litOrBinding isCompiledCode
ifTrue: [aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this"]
ifFalse:
[(litOrBinding isBehavior or: [litOrBinding isArray and: [litOrBinding allSatisfy: [:b | b isBehavior]]])
ifTrue: [aStream nextPutAll: 'importLiteral: '; nextPutAll: (self importStringFor: litOrBinding)]
ifFalse:
[aStream nextPutAll: 'literal: '; store: litOrBinding ]]]]. "N.B. This handles nested AssemblerMethods for nested CompiledBlocks."
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>resolveImportLiteral: (in category 'assembling') -----
resolveImportLiteral: classNameOrArrayOfClassNames
"Resolve classNameOrArrayOfClassNames to class(es) present in the system or AssemblerAbsentClassImport(s) as appropriate."
classNameOrArrayOfClassNames isArray ifTrue:
[^classNameOrArrayOfClassNames collect:
[:className|
self resolveImportLiteral: className]].
(classNameOrArrayOfClassNames last == $s
and: [classNameOrArrayOfClassNames endsWith: ' class']) ifTrue:
[| import |
import := self resolveImportLiteral: (classNameOrArrayOfClassNames allButLast: 6).
^import isBehavior
ifTrue: [import class]
ifFalse: [import forTheMetaclass]].
^(Smalltalk classNamed: classNameOrArrayOfClassNames)
ifNotNil: [:aClass| aClass]
ifNil: [AssemblerAbsentClassImport className: classNameOrArrayOfClassNames]!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>storeOn: (in category 'printing') -----
storeOn: aStream
"Store the receiver by using printAsAssemblerOn:.
N.B. This is relied upon in the printLiteralsForAssemblyOn: method to deal with nested blocks."
self printAsAssemblerOn: aStream!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod newLits |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: ((newLits := self getLiterals: code literals) isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: newLits
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue:
[header := header bitOr: 1 << 29].
code accessModifierBits ifNotNil:
[:bits| header := header bitOr: bits << 28].
code noCountersFlag ifTrue:
[header := header bitOr: 1 << 15].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings, the methodClass literal, and any exotica such as Behaviors and CompiledBlocks."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isLiteral ifTrue:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>branchIfInstanceOf:distance: (in category 'instruction decoding') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #branchIfInstanceOfLiteralAtIndex:distance:
arguments: {litIndex. distance})!
----- Method: BytecodeDisassembler>>branchIfNotInstanceOf:distance: (in category 'instruction decoding') -----
branchIfNotInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #branchIfNotInstanceOfLiteralAtIndex:distance:
arguments: {litIndex. distance})!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
accessModifier: ([method accessModifierBits] on: MessageNotUnderstood do: [:ex| nil])
noCounters: ([method hasNoCountersFlag] on: MessageNotUnderstood do: [:ex| [method hasNoCounterBit] on: MessageNotUnderstood do: [:ex2| nil]])
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals allButLast withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (BytecodeDisassembler new disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:
argument: (labels at: instrs pc + offset))]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
labelling
ifTrue:
[labels at: instrs pc + offset put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { labels at: instrs pc + offset. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #popIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #popIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [ self error: 'cannot encode the method' ].
. instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: { litIndex . numCopied. rcvrOnStack . ignoreOuterContext })!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #pushRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #pushRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #storeIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #storeIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: EncoderForSistaV1 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: method
"16-31 0001 iiii Push Literal Variable #iiii
32-63 001 iiiii Push Literal #iiiii
* 227 11100011 iiiiiiii Push Literal Variable #iiiiiiii (+ Extend A * 256)
* 228 11100100 iiiiiiii Push Literal #iiiiiiii (+ Extend A * 256)
** 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0 and <= 127)
** 254 11111110 kkkkkkkk jjjjjjjj branch If Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ (Extend B bitAnd: 127) * 256, where Extend B >= 128 and <= 255)
"
^self extensionsAt: pc in: method into:
[:extA :extB :nExts| | byte |
byte := method at: pc + nExts.
byte < 64
ifTrue:
[byte < 32
ifTrue: [byte > 15 ifTrue: [byte bitAnd: 16rF]]
ifFalse: [byte bitAnd: 16r1F]]
ifFalse:
[(byte >= 227 and: [byte <= 228 or: [byte = 254]]) ifTrue:
[extA * 256 + (method at: pc + nExts + 1)]]]!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-eem.45.mcz
==================== Summary ====================
Name: MethodMassage-eem.45
Author: eem
Time: 23 March 2017, 5:34:20.379712 pm
UUID: 7372cd19-d847-4212-8217-844196380435
Ancestors: MethodMassage-eem.44
Fix labels with branchIf[Not]InstanceOf:distance: bytecodes.
Default the methodClass of generated methods to Object if nil (because of absent class imports).
The noCountersFlag is false unless it's true.
Support pushFullClosure:numCopied: and its long form.
Don't set the selector/properties in CompiledBlocks.
Print labels in disassembler branchIf[Not]InstanceOf: bytecodes.
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerAbsentClassImport
instanceVariableNames: 'className'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
----- Method: AssemblerAbsentClassImport class>>className: (in category 'instance creation') -----
className: nameOfAnAbsentClass
^self new className: nameOfAnAbsentClass; yourself!
----- Method: AssemblerAbsentClassImport>>className (in category 'accessing') -----
className
^className!
----- Method: AssemblerAbsentClassImport>>className: (in category 'accessing') -----
className: anObject
className := anObject.
!
----- Method: AssemblerAbsentClassImport>>forTheMetaclass (in category 'converting') -----
forTheMetaclass
^(className endsWith: ' class')
ifTrue: [self]
ifFalse: [self class className: className, ' class']!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^ encoder genBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>branchIfInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder genBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>branchIfNotInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfNotInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder genBranchIfNotInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosureAtIndex: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder genPushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>branchIfInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder sizeBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>branchIfNotInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfNotInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder sizeBranchIfNotInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosureAtIndex: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder sizePushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag noCountersFlag accessModifier trailer methodClass selector compiledMethodClass fixLabels encoder'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 8/7/2014 11:51' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method;s trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:accessModifier:noCounters:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean accessModifier: accessModifierBits noCounters: noCountersBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new
literals: literalSequence
instructions: instructionSequence
numArgs: nArgs
numTemps: nTemps
frameSize: frameSizeNum
primitive: primitiveIndex
flag: flagBoolean
signFlag: signFlagBoolean
accessModifier: accessModifierBits
noCounters: noCountersBoolean
trailer: methodTrailer
methodClass: class
selector: aSelector
compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>accessModifier (in category 'accessing') -----
accessModifier
^ accessModifier
!
----- Method: AssemblerMethod>>accessModifier: (in category 'accessing') -----
accessModifier: anObject
accessModifier := anObject.
!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>branchIfInstanceOf:distance: (in category 'assembling') -----
branchIfInstanceOf: behaviorOrArrayOfBehavior distance: label
self checkLabel: label.
instructions addLast: (Message
selector: #branchIfInstanceOf:distance:
arguments: {behaviorOrArrayOfBehavior. label})!
----- Method: AssemblerMethod>>branchIfNotInstanceOf:distance: (in category 'assembling') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: label
self checkLabel: label.
instructions addLast: (Message
selector: #branchIfNotInstanceOf:distance:
arguments: {behaviorOrArrayOfBehavior. label})!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>importLiteral: (in category 'assembling') -----
importLiteral: classNameOrArrayOfClassNames
"Add as a literal the resolution of classNameOrArrayOfClassNames to class(es) present in the system or AbsentClassImport(s) as appropriate."
^self literal: (self resolveImportLiteral: classNameOrArrayOfClassNames)!
----- Method: AssemblerMethod>>importStringFor: (in category 'printing') -----
importStringFor: behaviorOrArrayOfBehaviors
^behaviorOrArrayOfBehaviors isBehavior
ifTrue: [behaviorOrArrayOfBehaviors name printString]
ifFalse: [(behaviorOrArrayOfBehaviors collect: [:behavior| behavior name]) printString]!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:accessModifier:noCounters:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean accessModifier: accessModifierBits noCounters: noCountersBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
noCountersFlag := noCountersBoolean.
accessModifier := accessModifierBits.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass. Default to Object if nil (and if we're compiling a CompiledMehtod, not a CompiledBlock)"
^methodClass ifNil: [(compiledMethodClass includesBehavior: CompiledMethod) ifTrue: [Object]]!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>noCountersFlag (in category 'accessing') -----
noCountersFlag
^noCountersFlag == true "nil & false => false"!
----- Method: AssemblerMethod>>noCountersFlag: (in category 'accessing') -----
noCountersFlag: anObject
noCountersFlag := anObject.
!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: methodClass: selector:
primitive: numArgs: numTemps: frameSize:
flag: signFlag: noCountersFlag: accessModifier:
trailerData:)
with: #(compiledMethodClass methodClass selector
primitive numArgs numTemps frameSize
flag signFlag noCountersFlag accessModifier
trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space; print: val; nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse:
[litOrBinding isVariableBinding
ifTrue: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifFalse:
[litOrBinding isCompiledCode
ifTrue: [aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this"]
ifFalse:
[(litOrBinding isBehavior or: [litOrBinding isArray and: [litOrBinding allSatisfy: [:b | b isBehavior]]])
ifTrue: [aStream nextPutAll: 'importLiteral: '; nextPutAll: (self importStringFor: litOrBinding)]
ifFalse:
[aStream nextPutAll: 'literal: '; store: litOrBinding ]]]]. "N.B. This handles nested AssemblerMethods for nested CompiledBlocks."
aStream nextPut: $;]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushFullClosureAtIndex:numCopied: (in category 'assembling-shorthand') -----
pushFullClosureAtIndex: litIndex numCopied: numCopied
instructions addLast: (Message
selector: #pushFullClosureAtIndex:numCopied:
arguments: {litIndex. numCopied})!
----- Method: AssemblerMethod>>pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembling') -----
pushFullClosureAtIndex: litIndex numCopied: numCopied receiverOnStack: receiverOnStack ignoreOuterContext: ignoreOuterContext
instructions addLast: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: {litIndex. numCopied. receiverOnStack. ignoreOuterContext})!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>resolveImportLiteral: (in category 'assembling') -----
resolveImportLiteral: classNameOrArrayOfClassNames
"Resolve classNameOrArrayOfClassNames to class(es) present in the system or AssemblerAbsentClassImport(s) as appropriate."
classNameOrArrayOfClassNames isArray ifTrue:
[^classNameOrArrayOfClassNames collect:
[:className|
self resolveImportLiteral: className]].
(classNameOrArrayOfClassNames last == $s
and: [classNameOrArrayOfClassNames endsWith: ' class']) ifTrue:
[| import |
import := self resolveImportLiteral: (classNameOrArrayOfClassNames allButLast: 6).
^import isBehavior
ifTrue: [import class]
ifFalse: [import forTheMetaclass]].
^(Smalltalk classNamed: classNameOrArrayOfClassNames)
ifNotNil: [:aClass| aClass]
ifNil: [AssemblerAbsentClassImport className: classNameOrArrayOfClassNames]!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>storeOn: (in category 'printing') -----
storeOn: aStream
"Store the receiver by using printAsAssemblerOn:.
N.B. This is relied upon in the printLiteralsForAssemblyOn: method to deal with nested blocks."
self printAsAssemblerOn: aStream!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
^method!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod newLits |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: ((newLits := self getLiterals: code literals) isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: newLits
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue:
[header := header bitOr: 1 << 29].
code accessModifier ifNotNil:
[:bits| header := header bitOr: bits << 28].
code noCountersFlag ifTrue:
[header := header bitOr: 1 << 15].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings, the methodClass literal, and any exotica such as Behaviors and CompiledBlocks."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isLiteral ifTrue:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method isCompiledMethod ifTrue:
[method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>branchIfInstanceOf:distance: (in category 'instruction decoding') -----
branchIfInstanceOf: aLiteral distance: distance
(self labelOrNilIfLabellingFor: distance) ifNotNil:
[:label| | litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #branchIfInstanceOfLiteralAtIndex:distance:
arguments: {litIndex. label})]!
----- Method: BytecodeDisassembler>>branchIfNotInstanceOf:distance: (in category 'instruction decoding') -----
branchIfNotInstanceOf: aLiteral distance: distance
(self labelOrNilIfLabellingFor: distance) ifNotNil:
[:label| | litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #branchIfNotInstanceOfLiteralAtIndex:distance:
arguments: {litIndex. label})]!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
accessModifier: ([method accessModifierBits] on: MessageNotUnderstood do: [:ex| nil])
noCounters: ([method hasNoCountersFlag] on: MessageNotUnderstood do: [:ex| [method hasNoCounterBit] on: MessageNotUnderstood do: [:ex2| nil]])
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals allButLast withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (BytecodeDisassembler new disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
(self labelOrNilIfLabellingFor: offset) ifNotNil:
[:label|
instructions
at: thePC
put: (Message
selector: #jump:
argument: label)]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
(self labelOrNilIfLabellingFor: offset) ifNotNil:
[:label|
instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { label. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>labelOrNilIfLabellingFor: (in category 'private') -----
labelOrNilIfLabellingFor: offset
"If labelling, just set a flag at the target and answer nil.
If done labelling answer the relevant label."
^labelling
ifTrue: [labels at: instrs pc + offset put: true. nil]
ifFalse: [labels at: instrs pc + offset]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #popIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #popIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [self error: 'cannot encode the method'].
instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:
arguments: {litIndex. numCopied})!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [self error: 'cannot encode the method'].
instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: {litIndex. numCopied. rcvrOnStack. ignoreOuterContext})!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #pushRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #pushRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #storeIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #storeIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: EncoderForSistaV1 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: method
"16-31 0001 iiii Push Literal Variable #iiii
32-63 001 iiiii Push Literal #iiiii
* 227 11100011 iiiiiiii Push Literal Variable #iiiiiiii (+ Extend A * 256)
* 228 11100100 iiiiiiii Push Literal #iiiiiiii (+ Extend A * 256)
** 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0 and <= 127)
** 254 11111110 kkkkkkkk jjjjjjjj branch If Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ (Extend B bitAnd: 127) * 256, where Extend B >= 128 and <= 255)
"
^self extensionsAt: pc in: method into:
[:extA :extB :nExts| | byte |
byte := method at: pc + nExts.
byte < 64
ifTrue:
[byte < 32
ifTrue: [byte > 15 ifTrue: [byte bitAnd: 16rF]]
ifFalse: [byte bitAnd: 16r1F]]
ifFalse:
[(byte >= 227 and: [byte <= 228 or: [byte = 254]]) ifTrue:
[extA * 256 + (method at: pc + nExts + 1)]]]!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0
Eliot Miranda uploaded a new version of MethodMassage to project VM Maker:
http://source.squeak.org/VMMaker/MethodMassage-eem.46.mcz
==================== Summary ====================
Name: MethodMassage-eem.46
Author: eem
Time: 24 March 2017, 9:25:05.972886 am
UUID: 438f7791-9e81-400c-9203-a039deeab49c
Ancestors: MethodMassage-eem.45
Add checking for expected header, initialPC and endPC for verifiying that ab import worked cofrrectly.
Add import name resolution for the method class.
Have AssemblerAbsentClassImports print themselves informatively.
Avoid #'Symbol' style printing of symbols.
==================== Snapshot ====================
SystemOrganization addCategory: #'MethodMassage-Coverage'!
SystemOrganization addCategory: #'MethodMassage-Kernel'!
SystemOrganization addCategory: #'MethodMassage-Tests'!
Object subclass: #AssemblerAbsentClassImport
instanceVariableNames: 'className'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
----- Method: AssemblerAbsentClassImport class>>className: (in category 'instance creation') -----
className: nameOfAnAbsentClass
^self new className: nameOfAnAbsentClass; yourself!
----- Method: AssemblerAbsentClassImport>>className (in category 'accessing') -----
className
^className!
----- Method: AssemblerAbsentClassImport>>className: (in category 'accessing') -----
className: anObject
className := anObject.
!
----- Method: AssemblerAbsentClassImport>>forTheMetaclass (in category 'converting') -----
forTheMetaclass
^(className endsWith: ' class')
ifTrue: [self]
ifFalse: [self class className: className, ' class']!
----- Method: AssemblerAbsentClassImport>>printOn: (in category 'printing') -----
printOn: aStream
super printOn: aStream.
className ifNotNil:
[aStream nextPutAll: ' className: '; store: className]!
Object subclass: #AssemblerEncoderInterface
instanceVariableNames: 'assembler encoder'
classVariableNames: 'SpecialSelectors'
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerEncoderInterface commentStamp: 'eem 2/22/2013 13:10' prior: 0!
An AssemblerEncoderInterface is an abstract superclass for the interfaces between a BytecodeAssembler and a BytecodeEncoder. These interfaces convert the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) to the sizing and emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables
assembler: <BytecodeAssembler>
encoder: <BytecodeEncoder>!
----- Method: AssemblerEncoderInterface class>>assembler:encoder: (in category 'instance creation') -----
assembler: anAssembler encoder: anEncoder
^self new assembler: anAssembler encoder: anEncoder!
----- Method: AssemblerEncoderInterface class>>copySizeCodeToEmitterCode (in category 'class initialization') -----
copySizeCodeToEmitterCode
"AssemblerEncoderInterface copySizeCodeToEmitterCode"
BytecodeSizer selectorsAndMethodsDo:
[:s :m| | emitterMethod |
((m literals includes: #shouldBeImplemented) not
and: [(emitterMethod := BytecodeEmitter compiledMethodAt: s) literals includes: #shouldBeImplemented]) ifTrue:
[BytecodeEmitter
compile:
(m getSourceFromFile asString
copyReplaceAll: 'encoder size'
with: 'encoder gen')
classified: #assembly]]!
----- Method: AssemblerEncoderInterface class>>createCodeSkeletons (in category 'class initialization') -----
createCodeSkeletons
"BytecodeSizer createCodeSkeletons"
"BytecodeEmitter createCodeSkeletons"
InstructionClient selectorsAndMethodsDo:
[:s :m|
Parser new
initPattern: m getSourceFromFile asString
notifying: nil
return:
[:tuple|
[:sel :args :precedence|
self compile:
(String streamContents:
[:strm|
precedence = 1
ifTrue: [strm nextPutAll: sel]
ifFalse:
[sel keywords with: args do:
[:kw :arg|
strm nextPutAll: kw; space; nextPutAll: arg; space].
strm skip: -1].
strm crtab; nextPutAll: 'self shouldBeImplemented'])
classified: #assembly.
] valueWithArguments: tuple]]!
----- Method: AssemblerEncoderInterface class>>initialize (in category 'class initialization') -----
initialize
"AssemblerEncoderInterface initialize"
SpecialSelectors := IdentityDictionary new.
1 to: Smalltalk specialSelectorSize do:
[:i | SpecialSelectors at: (Smalltalk specialSelectorAt: i) put: i]!
----- Method: AssemblerEncoderInterface>>assembler (in category 'accessing') -----
assembler
"Answer the value of assembler"
^ assembler!
----- Method: AssemblerEncoderInterface>>assembler: (in category 'accessing') -----
assembler: anObject
"Set the value of assembler"
assembler := anObject!
----- Method: AssemblerEncoderInterface>>assembler:encoder: (in category 'initialize-release') -----
assembler: anAssembler encoder: anEncoder
assembler := anAssembler.
encoder := anEncoder!
----- Method: AssemblerEncoderInterface>>encoder (in category 'accessing') -----
encoder
"Answer the value of encoder"
^ encoder!
----- Method: AssemblerEncoderInterface>>encoder: (in category 'accessing') -----
encoder: anObject
"Set the value of encoder"
encoder := anObject!
AssemblerEncoderInterface subclass: #BytecodeEmitter
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeEmitter commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeEmitter converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding emitting messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeEmitter>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeEmitter>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder genReturnTopToCaller!
----- Method: BytecodeEmitter>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^ encoder genBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>branchIfInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder genBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder genBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeEmitter>>branchIfNotInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfNotInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder genBranchIfNotInstanceOf: litIndex distance: distance!
----- Method: BytecodeEmitter>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder genCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder genCallPrimitive: primitiveIndex!
----- Method: BytecodeEmitter>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder genSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>doDup (in category 'assembly') -----
doDup
^encoder genDup!
----- Method: BytecodeEmitter>>doPop (in category 'assembly') -----
doPop
^encoder genPop!
----- Method: BytecodeEmitter>>extA: (in category 'assembly') -----
extA: anInteger
^encoder genUnsignedSingleExtendA: anInteger!
----- Method: BytecodeEmitter>>extB: (in category 'assembly') -----
extB: anInteger
^encoder genUnsignedSingleExtendB: anInteger!
----- Method: BytecodeEmitter>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJump: offset!
----- Method: BytecodeEmitter>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
condition
ifTrue: [encoder genBranchPopTrue: offset]
ifFalse: [encoder genBranchPopFalse: offset]!
----- Method: BytecodeEmitter>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^encoder genJumpLong: offset!
----- Method: BytecodeEmitter>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^condition
ifTrue: [encoder genBranchPopTrueLong: offset]
ifFalse: [encoder genBranchPopFalseLong: offset]!
----- Method: BytecodeEmitter>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder genReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeEmitter>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder genReturnReceiver!
----- Method: BytecodeEmitter>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder genReturnTop!
----- Method: BytecodeEmitter>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder genStorePopLiteralVar: litIndex!
----- Method: BytecodeEmitter>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStorePopInstVarLong: offset]
ifFalse: [encoder genStorePopInstVar: offset]!
----- Method: BytecodeEmitter>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStorePopRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
encoder genStorePopTemp: offset!
----- Method: BytecodeEmitter>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder genPushThisContext!
----- Method: BytecodeEmitter>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^encoder genPushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize!
----- Method: BytecodeEmitter>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder genPushNClosureTemps: numTemps!
----- Method: BytecodeEmitter>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder genPushConsArray: numElements!
----- Method: BytecodeEmitter>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
([encoder genPushSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: nil]) ifNotNil:
[^self].
litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteral: litIndex!
----- Method: BytecodeEmitter>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder genPushLiteral: literalIndex!
----- Method: BytecodeEmitter>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeEmitter>>pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosureAtIndex: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder genPushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeEmitter>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder genPushLiteralVar: litIndex!
----- Method: BytecodeEmitter>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder genPushNewArray: numElements!
----- Method: BytecodeEmitter>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder genPushReceiver!
----- Method: BytecodeEmitter>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genPushInstVarLong: offset]
ifFalse: [encoder genPushInstVar: offset]!
----- Method: BytecodeEmitter>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder genPushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genPushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder genPushSpecialLiteral: aLiteral!
----- Method: BytecodeEmitter>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder genPushTemp: offset!
----- Method: BytecodeEmitter>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder genSendSpecial: specialSelectorIndex numArgs: nArgs].
^encoder genSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder genSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeEmitter>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder genSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder genSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeEmitter>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder genStoreLiteralVar: litIndex!
----- Method: BytecodeEmitter>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder genStoreInstVarLong: offset]
ifFalse: [encoder genStoreInstVar: offset]!
----- Method: BytecodeEmitter>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder genStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeEmitter>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder genStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeEmitter>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder genStoreTemp: offset!
----- Method: BytecodeEmitter>>trap (in category 'assembly') -----
trap
^encoder genTrap!
AssemblerEncoderInterface subclass: #BytecodeSizer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeSizer commentStamp: 'eem 2/22/2013 11:18' prior: 0!
A BytecodeSizer converts the assembly messages (see CompiledMethod>>abstractBytecodeMessages and InstructionStream interpretNextInstructionFor: et al) and sends them to the corresponding sizing messages implemented by BytecodeEncoder's subclasses.
Instance Variables: see superclass!
----- Method: BytecodeSizer>>blockReturnConstant: (in category 'assembly') -----
blockReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteralToCaller: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self blockReturnTop]!
----- Method: BytecodeSizer>>blockReturnTop (in category 'assembly') -----
blockReturnTop
^encoder sizeReturnTopToCaller!
----- Method: BytecodeSizer>>branchIfInstanceOf:distance: (in category 'assembly') -----
branchIfInstanceOf: aLiteral distance: distance
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>branchIfInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder sizeBranchIfInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>branchIfNotInstanceOf:distance: (in category 'assembly') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: jumpDistance
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeBranchIfNotInstanceOf: litIndex distance: jumpDistance!
----- Method: BytecodeSizer>>branchIfNotInstanceOfLiteralAtIndex:distance: (in category 'assembly') -----
branchIfNotInstanceOfLiteralAtIndex: litIndex distance: distance
^encoder sizeBranchIfNotInstanceOf: litIndex distance: distance!
----- Method: BytecodeSizer>>callInlinePrimitive: (in category 'assembly') -----
callInlinePrimitive: primitiveIndex
^encoder sizeCallInlinePrimitive: primitiveIndex!
----- Method: BytecodeSizer>>callPrimitive: (in category 'assembly') -----
callPrimitive: primitiveIndex
^encoder sizeCallPrimitive: primitiveIndex!
----- Method: BytecodeSizer>>directedSuperSend:numArgs: (in category 'assembly') -----
directedSuperSend: selector numArgs: nArgs
^encoder sizeSendDirectedSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>doDup (in category 'assembly') -----
doDup
^encoder sizeDup!
----- Method: BytecodeSizer>>doPop (in category 'assembly') -----
doPop
^encoder sizePop!
----- Method: BytecodeSizer>>extA: (in category 'assembly') -----
extA: anInteger
^encoder sizeUnsignedSingleExtendA: anInteger!
----- Method: BytecodeSizer>>extB: (in category 'assembly') -----
extB: anInteger
^encoder sizeUnsignedSingleExtendB: anInteger!
----- Method: BytecodeSizer>>jump: (in category 'assembly') -----
jump: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset
ifNotNil: [encoder sizeJump: offset]
ifNil: ["If this is a backward jump that is as-yet unsized, answer the long backward jump size.
c.f. e.g. MessageNode>>#sizeCodeForWhile:value:"
offsetOrLabel value <= assembler index ifTrue:
[encoder sizeJumpLong: -1]]!
----- Method: BytecodeSizer>>jump:if: (in category 'assembly') -----
jump: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrue: offset]
ifFalse: [encoder sizeBranchPopFalse: offset]]!
----- Method: BytecodeSizer>>jumpLong: (in category 'assembly') -----
jumpLong: offsetOrLabel
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[encoder sizeJumpLong: offset]!
----- Method: BytecodeSizer>>jumpLong:if: (in category 'assembly') -----
jumpLong: offsetOrLabel if: condition
| offset |
offset := (assembler isLabel: offsetOrLabel)
ifTrue: [assembler spanToLabel: offsetOrLabel]
ifFalse: [offsetOrLabel].
^offset ifNotNil:
[condition
ifTrue: [encoder sizeBranchPopTrueLong: offset]
ifFalse: [encoder sizeBranchPopFalseLong: offset]]!
----- Method: BytecodeSizer>>methodReturnConstant: (in category 'assembly') -----
methodReturnConstant: aLiteral
"Rubbish way of handling special constants."
^[encoder sizeReturnSpecialLiteral: aLiteral]
on: Error
do: [:ex| ex return: (self pushLiteral: aLiteral) + self methodReturnTop]!
----- Method: BytecodeSizer>>methodReturnReceiver (in category 'assembly') -----
methodReturnReceiver
^encoder sizeReturnReceiver!
----- Method: BytecodeSizer>>methodReturnTop (in category 'assembly') -----
methodReturnTop
^encoder sizeReturnTop!
----- Method: BytecodeSizer>>popIntoLiteralVariable: (in category 'assembly') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoLiteralVariableAtIndex: (in category 'assembly') -----
popIntoLiteralVariableAtIndex: litIndex
^encoder sizeStorePopLiteralVar: litIndex!
----- Method: BytecodeSizer>>popIntoReceiverVariable: (in category 'assembly') -----
popIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStorePopInstVarLong: offset]
ifFalse: [encoder sizeStorePopInstVar: offset]!
----- Method: BytecodeSizer>>popIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
popIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of popIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStorePopRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>popIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>popIntoTemporaryVariable: (in category 'assembly') -----
popIntoTemporaryVariable: offset
^encoder sizeStorePopTemp: offset!
----- Method: BytecodeSizer>>pushActiveContext (in category 'assembly') -----
pushActiveContext
^encoder sizePushThisContext!
----- Method: BytecodeSizer>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembly') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSizeOrLabel
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
| blockSize |
blockSize := (assembler isLabel: blockSizeOrLabel)
ifTrue: [assembler spanToBlockLabel: blockSizeOrLabel]
ifFalse: [blockSizeOrLabel].
^blockSize ifNotNil:
[encoder sizePushClosureCopyNumCopiedValues: numCopied numArgs: numArgs jumpSize: blockSize]!
----- Method: BytecodeSizer>>pushClosureTemps: (in category 'assembly') -----
pushClosureTemps: numTemps
^encoder sizePushNClosureTemps: numTemps!
----- Method: BytecodeSizer>>pushConsArrayWithElements: (in category 'assembly') -----
pushConsArrayWithElements: numElements
^encoder sizePushConsArray: numElements!
----- Method: BytecodeSizer>>pushConstant: (in category 'assembly') -----
pushConstant: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
["rubbish way of handling special literals"
[(encoder sizePushSpecialLiteral: aLiteral) ifNotNil:
[:size| ^size]]
on: Error
do: [:ex| ].
litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteral: litIndex!
----- Method: BytecodeSizer>>pushConstantAtIndex: (in category 'assembly') -----
pushConstantAtIndex: literalIndex
^encoder sizePushLiteral: literalIndex!
----- Method: BytecodeSizer>>pushFullClosure:numCopied: (in category 'assembly') -----
pushFullClosure: compiledBlockLiteralIndex numCopied: numCopied
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied!
----- Method: BytecodeSizer>>pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembly') -----
pushFullClosureAtIndex: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
^encoder sizePushFullClosure: compiledBlockLiteralIndex numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext!
----- Method: BytecodeSizer>>pushLiteralVariable: (in category 'assembly') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushLiteralVariableAtIndex: (in category 'assembly') -----
pushLiteralVariableAtIndex: litIndex
^encoder sizePushLiteralVar: litIndex!
----- Method: BytecodeSizer>>pushNewArrayOfSize: (in category 'assembly') -----
pushNewArrayOfSize: numElements
^encoder sizePushNewArray: numElements!
----- Method: BytecodeSizer>>pushReceiver (in category 'assembly') -----
pushReceiver
^encoder sizePushReceiver!
----- Method: BytecodeSizer>>pushReceiverVariable: (in category 'assembly') -----
pushReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizePushInstVarLong: offset]
ifFalse: [encoder sizePushInstVar: offset]!
----- Method: BytecodeSizer>>pushRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
pushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"For symmetry with pop/storeIntoRemoteTemp:inVectorAt:."
^encoder sizePushRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>pushRemoteTemp:inVectorAt: (in category 'assembly') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizePushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>pushSpecialConstant: (in category 'assembly') -----
pushSpecialConstant: aLiteral
^encoder sizePushSpecialLiteral: aLiteral!
----- Method: BytecodeSizer>>pushTemporaryVariable: (in category 'assembly') -----
pushTemporaryVariable: offset
^encoder sizePushTemp: offset!
----- Method: BytecodeSizer>>send:super:numArgs: (in category 'assembly') -----
send: selector super: supered numArgs: nArgs
supered ifFalse:
[(SpecialSelectors at: selector ifAbsent: []) ifNotNil:
[:specialSelectorIndex|
^encoder sizeSpecialSend: specialSelectorIndex numArgs: nArgs].
^encoder sizeSend: (encoder sharableLitIndex: selector) numArgs: nArgs].
^encoder sizeSendSuper: (encoder sharableLitIndex: selector) numArgs: nArgs!
----- Method: BytecodeSizer>>sendToAbsentDynamicSuperclass:numArgs: (in category 'assembly') -----
sendToAbsentDynamicSuperclass: selector numArgs: numArgs
^encoder sizeSendAbsentDynamicSuper: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>sendToAbsentImplicitReceiver:numArgs: (in category 'assembly') -----
sendToAbsentImplicitReceiver: selector numArgs: numArgs
^encoder sizeSendAbsentImplicit: (encoder sharableLitIndex: selector) numArgs: numArgs!
----- Method: BytecodeSizer>>storeIntoLiteralVariable: (in category 'assembly') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := encoder litIndexOrNilFor: aLiteral.
litIndex ifNil:
[litIndex := encoder litIndex: aLiteral].
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoLiteralVariableAtIndex: (in category 'assembly') -----
storeIntoLiteralVariableAtIndex: litIndex
^encoder sizeStoreLiteralVar: litIndex!
----- Method: BytecodeSizer>>storeIntoReceiverVariable: (in category 'assembly') -----
storeIntoReceiverVariable: offsetOrName
| offset |
offset := offsetOrName isInteger
ifTrue: [offsetOrName]
ifFalse: [assembler offsetForInstVarName: offsetOrName].
"handle context inst var access"
^(assembler shouldUseLongAccessForInstVarOffset: offset)
ifTrue: [encoder sizeStoreInstVarLong: offset]
ifFalse: [encoder sizeStoreInstVar: offset]!
----- Method: BytecodeSizer>>storeIntoRemoteInstanceVariable:inObjectAt: (in category 'assembly') -----
storeIntoRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex
"Variation of storeIntoRemoteTemp:inVectorAt: that implies an immutability check."
^encoder sizeStoreRemoteInstanceVariable: tempIndex inObjectAt: InstVarIndex!
----- Method: BytecodeSizer>>storeIntoRemoteTemp:inVectorAt: (in category 'assembly') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
^encoder sizeStoreRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex!
----- Method: BytecodeSizer>>storeIntoTemporaryVariable: (in category 'assembly') -----
storeIntoTemporaryVariable: offset
^encoder sizeStoreTemp: offset!
----- Method: BytecodeSizer>>trap (in category 'assembly') -----
trap
^encoder sizeTrap!
----- Method: BytecodeSizer>>trapIfNotInstanceOf: (in category 'assembly') -----
trapIfNotInstanceOf: behaviorOrArrayOfBehavior
| litIndex |
litIndex := encoder litIndexOrNilFor: behaviorOrArrayOfBehavior.
litIndex ifNil:
[litIndex := encoder litIndex: behaviorOrArrayOfBehavior].
^encoder sizeTrapIfNotInstanceOf: litIndex!
Object subclass: #AssemblerMethod
instanceVariableNames: 'literals instructions numArgs numTemps frameSize primitive flag signFlag noCountersFlag accessModifier trailer methodClass selector compiledMethodClass fixLabels encoder header initialPC endPC'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!AssemblerMethod commentStamp: 'eem 3/24/2017 08:26' prior: 0!
An AssemblerMethod is a holder for a sequence of literals and a sequence of instructions which can represent a disassembled method, or a method being assembled. AssemblerMethod supports three modes of operation.
The first mode is transcription, CompiledMethod -> AssemblerMethod -> CompiledMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
replica := assembler assemble.
self assert: original = replica
The second mode is to construct an AssemblerMethod and assemble it. e.g.
EncoderForSistaV1 assembler
pushReceiver;
trapIfNotInstanceOf: {SmallInteger. Character. LargePositiveInteger. LargeNegativeInteger.
Integer. Fraction. Magnitude};
pushReceiver;
methodReturnTop;
assemble
AssemblerMethod new
methodClass: Object;
selector: #printOn:;
numArgs: 1;
numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble
A third mode, useful for storage, inter-image transporation ,etc, is AssemblerMethod -> executable string -> AssemblerMethod.
e.g.
| original "CompiledMethod"
assembler "AssemblerMethod"
assemblerText "String"
replica "CompiledMethod" |
original := Object >> #printOn:.
assembler := original disassemble.
assemblerText := assembler assemblerString.
replica := (Compiler evaluate: assemblerText) assemble.
self assert: original = replica
Instance Variables
accessModifier: <nil|0,1,2,3>
compiledMethodClass: <nil|CompiledCode>
encoder: <BytecodeEncoder>
endPC: <nil|Integer>
fixLabels: <UndefinedObject|Boolean>
flag: <Boolean>
frameSize: <Integer>
header: <nil|Integer>
initialPC: <nil|Integer>
instructions: <SequenceableCollection>
literals: <SequenceableCollection>
methodClass: <Behavior>
noCountersFlag: <nil|Boolean>
numArgs: <Integer>
numTemps: <Integer>
primitive: <Integer>
signFlag: <Boolean>
trailer: <CompiledMethodTrailer>
accessModifier
- if not nil this is the values of the two bits of flags that specify Newspeak access control in the method header
compiledMethodClass
- if not nil this is the class to use to create a method from this assembly
encoder
- the encoder to use to encode literals during assembly
endPC
- this is the expected endPC of the resulting method. If not nil it will be checked against the actual endPC
fixLabels
- if nil, the AssemblerMethod is being used in transcription mode and branch offsets should be integers.
if a boolean then it indicates whether instructions contains one or more instructions that need their branches fixing up.
flag
- the value of the method's header flag (see CompiledMethod>>flag)
frameSize
- the size of the method's frame (see CompiledMethod>>frameSize)
header
- this is the expected header of the resulting method. If not nil it will be checked against the actual header
initialPC
- this is the expected initialPC of the resulting method. If not nil it will be checked against the actual initialPC
instructions
- the sequence of Message and LookupKey objects making up the method's instructions
literals
- the sequence of objects making up the method's literals
methodClass
- the target class for the method (see CompiledMethod>>methodClass)
noCountersFlag
- if not nil this is the value of the Sista JIT-without-performance-counters flag
numArgs
- the method's argument count (see CompiledMethod>>numArgs)
numTemps
- the method's temporary count (see CompiledMethod>>numTemps)
primitive
- the method's primitive (see CompiledMethod>>primitive)
signFlag
- the value of the method's signFlag (see CompiledMethod>>signFlag)
trailer
- the method's trailer (see CompiledMethod>>trailer)
!
----- Method: AssemblerMethod class>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:accessModifier:noCounters:trailer:methodClass:selector:compiledMethodClass: (in category 'instance creation') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean accessModifier: accessModifierBits noCounters: noCountersBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
^self new
literals: literalSequence
instructions: instructionSequence
numArgs: nArgs
numTemps: nTemps
frameSize: frameSizeNum
primitive: primitiveIndex
flag: flagBoolean
signFlag: signFlagBoolean
accessModifier: accessModifierBits
noCounters: noCountersBoolean
trailer: methodTrailer
methodClass: class
selector: aSelector
compiledMethodClass: classOfCompiledMethod!
----- Method: AssemblerMethod>>accessModifier (in category 'accessing') -----
accessModifier
^ accessModifier
!
----- Method: AssemblerMethod>>accessModifier: (in category 'accessing') -----
accessModifier: anObject
accessModifier := anObject.
!
----- Method: AssemblerMethod>>assemble (in category 'assembling') -----
assemble
| assembler |
assembler := BytecodeAssembler new.
encoder ifNotNil: [assembler encoder: encoder].
^assembler assemble: self!
----- Method: AssemblerMethod>>assemblerString (in category 'printing') -----
assemblerString
^String streamContents: [:s| self printAsAssemblerOn: s]!
----- Method: AssemblerMethod>>binding: (in category 'assembling') -----
binding: aSymbol
"For now, if the binding is not found, answer a fake binding rather than enter into Undeclared."
self literal: ((methodClass bindingOf: aSymbol) ifNil:
[Transcript cr; print: 'warning: ', aSymbol, ' is unbound'.
aSymbol -> nil])!
----- Method: AssemblerMethod>>branchIfInstanceOf:distance: (in category 'assembling') -----
branchIfInstanceOf: behaviorOrArrayOfBehavior distance: label
self checkLabel: label.
instructions addLast: (Message
selector: #branchIfInstanceOf:distance:
arguments: {behaviorOrArrayOfBehavior. label})!
----- Method: AssemblerMethod>>branchIfNotInstanceOf:distance: (in category 'assembling') -----
branchIfNotInstanceOf: behaviorOrArrayOfBehavior distance: label
self checkLabel: label.
instructions addLast: (Message
selector: #branchIfNotInstanceOf:distance:
arguments: {behaviorOrArrayOfBehavior. label})!
----- Method: AssemblerMethod>>callInlinePrimitive: (in category 'assembling') -----
callInlinePrimitive: primNumber
instructions addLast: (Message
selector: #callPrimitive:
argument: primNumber + 32768)!
----- Method: AssemblerMethod>>checkLabel: (in category 'private') -----
checkLabel: label
fixLabels ifNotNil:
[label isInteger
ifTrue: [self error: 'one cannot use integers as labels in assembler mode. integers are interpreted as branch distances']
ifFalse: [fixLabels := true]]!
----- Method: AssemblerMethod>>compiledMethodClass (in category 'accessing') -----
compiledMethodClass
"Answer the value of compiledMethodClass"
^ compiledMethodClass!
----- Method: AssemblerMethod>>compiledMethodClass: (in category 'accessing') -----
compiledMethodClass: anObject
"Set the value of compiledMethodClass"
compiledMethodClass := anObject!
----- Method: AssemblerMethod>>directedSuperSend: (in category 'assembling-shorthand') -----
directedSuperSend: aSelector
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>doesNotUnderstand: (in category 'assembling') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions addLast: aMessage!
----- Method: AssemblerMethod>>dup (in category 'assembling-shorthand') -----
dup
"For compatibility with InstructionPrinter output"
^self doDup!
----- Method: AssemblerMethod>>encoder (in category 'accessing') -----
encoder
^encoder!
----- Method: AssemblerMethod>>encoder: (in category 'accessing') -----
encoder: anObject
encoder := anObject!
----- Method: AssemblerMethod>>endPC (in category 'accessing') -----
endPC
^ endPC
!
----- Method: AssemblerMethod>>endPC: (in category 'accessing') -----
endPC: anObject
endPC := anObject!
----- Method: AssemblerMethod>>extA: (in category 'assembling') -----
extA: anInteger
instructions addLast: (Message selector: #extA: argument: anInteger)!
----- Method: AssemblerMethod>>extB: (in category 'assembling') -----
extB: anInteger
instructions addLast: (Message selector: #extB: argument: anInteger)!
----- Method: AssemblerMethod>>fixLabelsIfNecessary (in category 'private') -----
fixLabelsIfNecessary
| map |
fixLabels ~~ true ifTrue: [^self].
map := Dictionary new.
instructions do:
[:inst|
(self isLabel: inst) ifTrue:
[map at: inst key put: inst]].
instructions do:
[:inst|
((self isLabel: inst) not
and: [#(jump: jump:if: jumpLong: jumpLong:if:
pushClosureCopyNumCopiedValues:numArgs:blockSize:) includes: inst selector]) ifTrue:
[inst selector first = $j
ifTrue:
[inst arguments first isInteger ifFalse:
[inst arguments at: 1 put: (map at: inst arguments first)]]
ifFalse:
[inst arguments last isInteger ifFalse:
[inst arguments at: inst numArgs put: (map at: inst arguments last)]]]].
fixLabels := false!
----- Method: AssemblerMethod>>flag (in category 'accessing') -----
flag
"Answer the value of flag"
^ flag!
----- Method: AssemblerMethod>>flag: (in category 'accessing') -----
flag: anObject
"Set the value of flag"
flag := anObject!
----- Method: AssemblerMethod>>frameSize (in category 'accessing') -----
frameSize
"Answer the value of frameSize"
^ frameSize!
----- Method: AssemblerMethod>>frameSize: (in category 'accessing') -----
frameSize: anObject
"Set the value of frameSize"
frameSize := anObject!
----- Method: AssemblerMethod>>header (in category 'accessing') -----
header
^ header
!
----- Method: AssemblerMethod>>header: (in category 'accessing') -----
header: anObject
header := anObject!
----- Method: AssemblerMethod>>importLiteral: (in category 'assembling') -----
importLiteral: classNameOrArrayOfClassNames
"Add as a literal the resolution of classNameOrArrayOfClassNames to class(es) present in the system or AbsentClassImport(s) as appropriate."
^self literal: (self resolveImportLiteral: classNameOrArrayOfClassNames)!
----- Method: AssemblerMethod>>importMethodClass (in category 'accessing') -----
importMethodClass
"Answer the name of methodClass."
^methodClass ifNotNil: [methodClass name]!
----- Method: AssemblerMethod>>importMethodClass: (in category 'assembling') -----
importMethodClass: className
"Set the methodClass to the resolution of className to the class present in the system or an AbsentClassImport as appropriate."
^self methodClass: (self resolveImportLiteral: className)!
----- Method: AssemblerMethod>>importStringFor: (in category 'printing') -----
importStringFor: behaviorOrArrayOfBehaviors
^behaviorOrArrayOfBehaviors isBehavior
ifTrue: [behaviorOrArrayOfBehaviors name storeString]
ifFalse: [(behaviorOrArrayOfBehaviors collect: [:behavior| behavior name]) printString]!
----- Method: AssemblerMethod>>initialPC (in category 'accessing') -----
initialPC
^ initialPC
!
----- Method: AssemblerMethod>>initialPC: (in category 'accessing') -----
initialPC: anObject
initialPC := anObject!
----- Method: AssemblerMethod>>initialize (in category 'initialize-release') -----
initialize
fixLabels := false.
compiledMethodClass := CompiledMethod.
instructions := OrderedCollection new.
literals := OrderedCollection new.
frameSize := thisContext method frameSize. "should be small"
flag := signFlag := false.
numArgs := numTemps := primitive := 0!
----- Method: AssemblerMethod>>instructions (in category 'accessing') -----
instructions
"Answer the value of instructions"
self fixLabelsIfNecessary.
^instructions!
----- Method: AssemblerMethod>>instructions: (in category 'accessing') -----
instructions: anObject
"Set the value of instructions"
instructions := anObject!
----- Method: AssemblerMethod>>isLabel: (in category 'private') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: AssemblerMethod>>jump: (in category 'assembling') -----
jump: label
self checkLabel: label.
instructions addLast: (Message
selector: #jump:
argument: label)!
----- Method: AssemblerMethod>>jump:if: (in category 'assembling') -----
jump: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jump:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpFalse: (in category 'assembling-shorthand') -----
jumpFalse: label
"For compatibility with InstructionPrinter output"
^self jump: label if: false!
----- Method: AssemblerMethod>>jumpLong: (in category 'assembling') -----
jumpLong: label
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:
argument: label)!
----- Method: AssemblerMethod>>jumpLong:if: (in category 'assembling') -----
jumpLong: label if: cond
self checkLabel: label.
instructions addLast: (Message
selector: #jumpLong:if:
arguments: {label. cond})!
----- Method: AssemblerMethod>>jumpTrue: (in category 'assembling-shorthand') -----
jumpTrue: label
"For compatibility with InstructionPrinter output"
^self jump: label if: true!
----- Method: AssemblerMethod>>label: (in category 'assembling') -----
label: aString
instructions addLast: aString -> nil!
----- Method: AssemblerMethod>>labels (in category 'accessing') -----
labels
^instructions select: [:ea| ea isVariableBinding]!
----- Method: AssemblerMethod>>literal: (in category 'assembling') -----
literal: aLiteral
literals addLast: aLiteral!
----- Method: AssemblerMethod>>literals (in category 'accessing') -----
literals
"Answer the value of literals"
^ literals!
----- Method: AssemblerMethod>>literals: (in category 'accessing') -----
literals: anObject
"Set the value of literals"
literals := anObject!
----- Method: AssemblerMethod>>literals:instructions:numArgs:numTemps:frameSize:primitive:flag:signFlag:accessModifier:noCounters:trailer:methodClass:selector:compiledMethodClass: (in category 'initialize-release') -----
literals: literalSequence instructions: instructionSequence numArgs: nArgs numTemps: nTemps frameSize: frameSizeNum primitive: primitiveIndex flag: flagBoolean signFlag: signFlagBoolean accessModifier: accessModifierBits noCounters: noCountersBoolean trailer: methodTrailer methodClass: class selector: aSelector compiledMethodClass: classOfCompiledMethod
literals := literalSequence.
instructions := instructionSequence.
numArgs := nArgs.
numTemps := nTemps.
frameSize := frameSizeNum.
primitive := primitiveIndex.
flag := flagBoolean.
signFlag := signFlagBoolean.
noCountersFlag := noCountersBoolean.
accessModifier := accessModifierBits.
trailer := methodTrailer.
methodClass := class.
selector := aSelector.
compiledMethodClass := classOfCompiledMethod!
----- Method: AssemblerMethod>>methodClass (in category 'accessing') -----
methodClass
"Answer the value of methodClass. Default to Object if nil (and if we're compiling a CompiledMehtod, not a CompiledBlock)"
^methodClass ifNil:
[(compiledMethodClass notNil
and: [compiledMethodClass includesBehavior: CompiledMethod]) ifTrue:
[Object]]!
----- Method: AssemblerMethod>>methodClass: (in category 'accessing') -----
methodClass: anObject
"Set the value of methodClass"
methodClass := anObject!
----- Method: AssemblerMethod>>noCountersFlag (in category 'accessing') -----
noCountersFlag
^noCountersFlag == true "nil & false => false"!
----- Method: AssemblerMethod>>noCountersFlag: (in category 'accessing') -----
noCountersFlag: anObject
noCountersFlag := anObject.
!
----- Method: AssemblerMethod>>numArgs (in category 'accessing') -----
numArgs
"Answer the value of numArgs"
^ numArgs!
----- Method: AssemblerMethod>>numArgs: (in category 'accessing') -----
numArgs: anObject
"Set the value of numArgs"
numArgs := anObject!
----- Method: AssemblerMethod>>numTemps (in category 'accessing') -----
numTemps
"Answer the value of numTemps"
^ numTemps!
----- Method: AssemblerMethod>>numTemps: (in category 'accessing') -----
numTemps: anObject
"Set the value of numTemps"
numTemps := anObject!
----- Method: AssemblerMethod>>pop (in category 'assembling-shorthand') -----
pop
"For compatibility with InstructionPrinter output"
^self doPop!
----- Method: AssemblerMethod>>popIntoLiteralVariableAtIndex: (in category 'assembling') -----
popIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>popIntoTemp: (in category 'assembling-shorthand') -----
popIntoTemp: n
"For compatibility with InstructionPrinter output"
^self popIntoTemporaryVariable: n!
----- Method: AssemblerMethod>>primitive (in category 'accessing') -----
primitive
"Answer the value of primitive"
^ primitive!
----- Method: AssemblerMethod>>primitive: (in category 'accessing') -----
primitive: anObject
"Set the value of primitive"
primitive := anObject!
----- Method: AssemblerMethod>>printAccessorsForAssemblyOn: (in category 'printing') -----
printAccessorsForAssemblyOn: aStream
| dummy |
dummy := self class new.
"Generate all the accessors; for now don't handle the trailer"
#( compiledMethodClass: importMethodClass: selector:
primitive: numArgs: numTemps: frameSize:
flag: signFlag: noCountersFlag: accessModifier:
trailerData:)
with: #(compiledMethodClass importMethodClass selector
primitive numArgs numTemps frameSize
flag signFlag noCountersFlag accessModifier
trailerData)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
val ~= (dummy perform: getter) ifTrue:
[aStream crtab; nextPutAll: setter; space.
val isSymbol ifTrue: [aStream store: val] ifFalse: [aStream print: val].
aStream nextPut: $;]]]!
----- Method: AssemblerMethod>>printAsAssemblerOn: (in category 'printing') -----
printAsAssemblerOn: aStream
aStream nextPut: $(; print: self class; nextPutAll: ' new'.
self printAccessorsForAssemblyOn: aStream.
self printVerifiersForAssemblyOn: aStream.
self printLiteralsForAssemblyOn: aStream.
self printInstructionsForAssemblyOn: aStream.
aStream crtab; nextPutAll: #yourself; nextPut: $)!
----- Method: AssemblerMethod>>printInstructionsForAssemblyOn: (in category 'printing') -----
printInstructionsForAssemblyOn: aStream
instructions do:
[:messageOrLabel|
aStream crtab.
(self isLabel: messageOrLabel)
ifTrue:
[aStream nextPutAll: 'label: '; print: messageOrLabel key]
ifFalse:
[messageOrLabel numArgs = 0
ifTrue: [aStream nextPutAll: messageOrLabel selector]
ifFalse:
[messageOrLabel selector keywords with: messageOrLabel arguments do:
[:kwd :arg|
aStream nextPutAll: kwd; space.
aStream print: ((kwd = 'jump:' or: [kwd = 'blockSize:'])
ifTrue: [self assert: (self isLabel: arg).
arg key]
ifFalse: [arg]); space].
aStream skip: -1]].
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printLiteralsForAssemblyOn: (in category 'printing') -----
printLiteralsForAssemblyOn: aStream
| literalsToDefine |
literalsToDefine := literals copy asOrderedCollection.
(literalsToDefine last isVariableBinding
and: [literalsToDefine last value = methodClass]) ifTrue:
[literalsToDefine removeLast.
self assert: (literalsToDefine last == selector
or: [literalsToDefine last isMethodProperties
and: [literalsToDefine last selector == selector]]).
literalsToDefine removeLast].
literalsToDefine do:
[:litOrBinding|
aStream crtab.
litOrBinding isLiteral
ifTrue: [aStream nextPutAll: 'literal: '; print: litOrBinding]
ifFalse:
[litOrBinding isVariableBinding
ifTrue: [aStream nextPutAll: 'binding: '; store: litOrBinding key]
ifFalse:
[litOrBinding isCompiledCode
ifTrue: [aStream nextPutAll: 'literal: '; print: nil "a post-process pass will fix this"]
ifFalse:
[(litOrBinding isBehavior or: [litOrBinding isArray and: [litOrBinding allSatisfy: [:b | b isBehavior]]])
ifTrue: [aStream nextPutAll: 'importLiteral: '; nextPutAll: (self importStringFor: litOrBinding)]
ifFalse:
[aStream nextPutAll: 'literal: '; store: litOrBinding ]]]]. "N.B. This handles nested AssemblerMethods for nested CompiledBlocks."
aStream nextPut: $;]!
----- Method: AssemblerMethod>>printVerifiersForAssemblyOn: (in category 'printing') -----
printVerifiersForAssemblyOn: aStream
#( header: endPC: initialPC:)
with: #(header endPC initialPC)
do: [:setter :getter|
(self perform: getter) ifNotNil:
[:val|
aStream crtab; nextPutAll: setter; space.
val storeOn: aStream base: (getter == #header ifTrue: [16] ifFalse: [10]).
aStream nextPut: $;]]!
----- Method: AssemblerMethod>>push: (in category 'assembling-shorthand') -----
push: aLiteral
"Convenience for pushLiteral:. Won't work unless an encoder has been set."
"For compatibility with InstructionPrinter output"
^(encoder isSpecialLiteralForPush: aLiteral)
ifTrue: [self pushSpecialConstant: aLiteral]
ifFalse: [self pushConstant: aLiteral]!
----- Method: AssemblerMethod>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'assembling') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"N.B. If blockSizeOrLabel is a label it is expected be a label after the
last return in the block and before the bytecode following the block."
self checkLabel: blockSize.
instructions addLast: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: {numCopied. numArgs. blockSize})!
----- Method: AssemblerMethod>>pushConstantAtIndex: (in category 'assembling') -----
pushConstantAtIndex: litIndex
instructions addLast: (Message
selector: #pushConstantAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushFullClosureAtIndex:numCopied: (in category 'assembling-shorthand') -----
pushFullClosureAtIndex: litIndex numCopied: numCopied
instructions addLast: (Message
selector: #pushFullClosureAtIndex:numCopied:
arguments: {litIndex. numCopied})!
----- Method: AssemblerMethod>>pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext: (in category 'assembling') -----
pushFullClosureAtIndex: litIndex numCopied: numCopied receiverOnStack: receiverOnStack ignoreOuterContext: ignoreOuterContext
instructions addLast: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: {litIndex. numCopied. receiverOnStack. ignoreOuterContext})!
----- Method: AssemblerMethod>>pushLiteralVariableAtIndex: (in category 'assembling') -----
pushLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>pushSpecialConstant: (in category 'assembling') -----
pushSpecialConstant: aConstant
instructions addLast: (Message
selector: #pushSpecialConstant:
argument: aConstant)!
----- Method: AssemblerMethod>>pushTemp: (in category 'assembling-shorthand') -----
pushTemp: n
"For compatibility with InstructionPrinter output"
^self pushTemporaryVariable: n!
----- Method: AssemblerMethod>>recordVerificationInfoFrom: (in category 'initialize-release') -----
recordVerificationInfoFrom: aMethod
"Record header, initialPC and endPC from aMethod for checking."
header := aMethod header.
endPC := aMethod endPC.
initialPC := aMethod initialPC!
----- Method: AssemblerMethod>>resolveImportLiteral: (in category 'assembling') -----
resolveImportLiteral: classNameOrArrayOfClassNames
"Resolve classNameOrArrayOfClassNames to class(es) present in the system or AssemblerAbsentClassImport(s) as appropriate."
classNameOrArrayOfClassNames isArray ifTrue:
[^classNameOrArrayOfClassNames collect:
[:className|
self resolveImportLiteral: className]].
(classNameOrArrayOfClassNames last == $s
and: [classNameOrArrayOfClassNames endsWith: ' class']) ifTrue:
[| import |
import := self resolveImportLiteral: (classNameOrArrayOfClassNames allButLast: 6).
^import isBehavior
ifTrue: [import class]
ifFalse: [import forTheMetaclass]].
^(Smalltalk classNamed: classNameOrArrayOfClassNames)
ifNotNil: [:aClass| aClass]
ifNil: [AssemblerAbsentClassImport className: classNameOrArrayOfClassNames]!
----- Method: AssemblerMethod>>selector (in category 'accessing') -----
selector
"Answer the value of selector"
^ selector!
----- Method: AssemblerMethod>>selector: (in category 'accessing') -----
selector: anObject
"Set the value of selector"
selector := anObject!
----- Method: AssemblerMethod>>send: (in category 'assembling-shorthand') -----
send: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: false numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>sendToAbsentImplicitReceiver: (in category 'assembling-shorthand') -----
sendToAbsentImplicitReceiver: aSelector
self sendToAbsentImplicitReceiver: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>signFlag (in category 'accessing') -----
signFlag
"Answer the value of signFlag"
^ signFlag!
----- Method: AssemblerMethod>>signFlag: (in category 'accessing') -----
signFlag: anObject
"Set the value of signFlag"
signFlag := anObject!
----- Method: AssemblerMethod>>storeIntoLiteralVariableAtIndex: (in category 'assembling') -----
storeIntoLiteralVariableAtIndex: litIndex
instructions addLast: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: AssemblerMethod>>storeOn: (in category 'printing') -----
storeOn: aStream
"Store the receiver by using printAsAssemblerOn:.
N.B. This is relied upon in the printLiteralsForAssemblyOn: method to deal with nested blocks."
self printAsAssemblerOn: aStream!
----- Method: AssemblerMethod>>superSend: (in category 'assembling-shorthand') -----
superSend: aSelector
"For compatibility with InstructionPrinter output"
self send: aSelector super: true numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>superSend:above: (in category 'assembling-shorthand') -----
superSend: aSelector above: classOrBinding
self pushLiteral: (classOrBinding isVariableBinding
ifTrue: [classOrBinding]
ifFalse: [classOrBinding binding]).
self directedSuperSend: aSelector numArgs: aSelector numArgs!
----- Method: AssemblerMethod>>trailer (in category 'accessing') -----
trailer
^trailer ifNil: [CompiledMethodTrailer empty]!
----- Method: AssemblerMethod>>trailer: (in category 'accessing') -----
trailer: anObject
"Set the value of trailer"
trailer := anObject!
----- Method: AssemblerMethod>>trailerData (in category 'accessing') -----
trailerData
^trailer ifNotNil: [trailer rawData]!
----- Method: AssemblerMethod>>trailerData: (in category 'accessing') -----
trailerData: aByteArray
self trailer: (CompiledMethodTrailer new method: aByteArray)!
Object subclass: #BytecodeAssembler
instanceVariableNames: 'code sizes encoder method index shouldNegateInstVarOffsetsMask'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
!BytecodeAssembler commentStamp: 'eem 2/22/2013 11:12' prior: 0!
A BytecodeAssembler is something that converts an AssemblerMethod into a CompiledMethod.
Instance Variables
code: <AssemblerMethod>
encoder: <BytecodeEncoder>
sizes: <SequenceableCollection>
code
- the input assembly method
encoder
- the encoder that generates instructions
sizes
- the size of each corresponding bytecode in code's instructions!
----- Method: BytecodeAssembler>>assemble: (in category 'assembly-public') -----
assemble: ass "<AssemblerMethod>"
code := ass.
sizes := Array new: code instructions size.
self createEncoder.
self nilLabelTargets.
self sizePasses.
self createMethod.
self emitPass.
self verify: ass.
^method!
----- Method: BytecodeAssembler>>assert:equals:entity: (in category 'private') -----
assert: expected equals: actual entity: entityName
expected ~= actual ifTrue:
[self error: 'method ', entityName, ' should be ', (entityName = 'header' ifTrue: [expected hex] ifFalse: [expected printString]),
' but is ', (entityName = 'header' ifTrue: [actual hex] ifFalse: [actual printString])]!
----- Method: BytecodeAssembler>>assert:or:equals:entity: (in category 'private') -----
assert: expected or: anticipated equals: actual entity: entityName
(expected ~= actual
and: [anticipated ~= actual]) ifTrue:
[^self
assert: ((expected - actual) abs <= (anticipated - actual) abs
ifTrue: [expected]
ifFalse: [anticipated])
equals: actual
entity: entityName]!
----- Method: BytecodeAssembler>>code (in category 'accessing') -----
code
^code!
----- Method: BytecodeAssembler>>createEncoder (in category 'instance initialization') -----
createEncoder
"The signFlag defines the bytecode set of a method.
So create a dummy method with its sign flag to that of
code's, and instantiate the dummy method's encoderClass."
| dummyMethod newLits |
encoder ifNil:
[dummyMethod := CompiledMethod
newMethod: 0
header: (code signFlag ifTrue: [SmallInteger minVal] ifFalse: [0]).
encoder := dummyMethod encoderClass new].
encoder
initClass: code methodClass
literalStream: ((newLits := self getLiterals: code literals) isEmpty ifFalse:
[self
ensureLiteralsIncludeMethodClass: newLits
isQuick: (self isQuickPrimitiveIndex: code primitive)]).
^encoder!
----- Method: BytecodeAssembler>>createMethod (in category 'assembly') -----
createMethod
| header size |
header := encoder
computeMethodHeaderForNumArgs: code numArgs
numTemps: code numTemps
numLits: encoder allLiterals size
primitive: code primitive.
code flag ifTrue:
[header := header bitOr: 1 << 29].
code accessModifier ifNotNil:
[:bits| header := header bitOr: bits << 28].
code noCountersFlag ifTrue:
[header := header bitOr: 1 << 15].
size := sizes size = 0 ifTrue: [0] ifFalse: [self totalSizeFrom: 1 to: sizes size].
method := code trailer
createMethod: size
class: code compiledMethodClass
header: header.
method needsFrameSize: code frameSize - method numTemps!
----- Method: BytecodeAssembler>>emitPass (in category 'assembly') -----
emitPass
| literals nLits emitter |
literals := encoder allLiterals.
nLits := literals size.
emitter := BytecodeEmitter assembler: self encoder: encoder.
1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
encoder streamToMethod: method.
code instructions withIndexDo:
[:messageOrLabel :i|
(self isLabel: messageOrLabel) ifFalse:
[index := i.
messageOrLabel sentTo: emitter]].
"Need to create distinct literals for all literals in the method
*except* variable bindings, the methodClass literal, and any exotica such as Behaviors and CompiledBlocks."
1 to: method numLiterals - 2 do:
[:litIndex| | lit |
lit := method literalAt: litIndex.
lit isLiteral ifTrue:
[method
literalAt: litIndex
put: (lit isArray ifTrue: [lit deepCopy] ifFalse: [lit copy])]].
"Need to create a distinct additional method state if it has one.
Avoid setting selector if already set (method penultimateLiteral notNil and not a metod properties)"
method isCompiledMethod ifTrue:
[method penultimateLiteral
ifNil: [method selector: code selector]
ifNotNil:
[:plit|
plit isMethodProperties ifTrue:
[method
penultimateLiteral: plit copy;
selector: code selector]]]
!
----- Method: BytecodeAssembler>>encoder: (in category 'assembly-public') -----
encoder: aBytecodeEncoder
encoder := aBytecodeEncoder!
----- Method: BytecodeAssembler>>ensureLiteralsIncludeMethodClass:isQuick: (in category 'private') -----
ensureLiteralsIncludeMethodClass: literals isQuick: isQuick
"Check whether literals includes the methodClass association (and hence by implication the penultimate literal).
If not, add a suitable one. In the assembly case the literal will be missing."
literals size > 0 ifTrue:
[| last |
isQuick ifTrue: "support Newspeak accessors"
[self assert: literals size = 2.
^literals].
last := literals last.
(last isVariableBinding
and: [last value = code methodClass
and: [last key == nil or: [last == code methodClass binding]]]) ifTrue:
[^literals]].
^literals, { code selector. code methodClass ifNotNil: [:class| class binding] }!
----- Method: BytecodeAssembler>>getLiterals: (in category 'instance initialization') -----
getLiterals: literals
| newLits |
newLits := Array new: literals size.
literals withIndexDo: [:lit :i |
newLits at: i put: (lit class == AssemblerMethod
ifTrue: [lit assemble]
ifFalse: [lit])].
^ newLits!
----- Method: BytecodeAssembler>>index (in category 'accessing') -----
index
"For the sizer."
^index!
----- Method: BytecodeAssembler>>isLabel: (in category 'testing') -----
isLabel: aMessageOrLookupKey
^aMessageOrLookupKey isVariableBinding!
----- Method: BytecodeAssembler>>isQuickPrimitiveIndex: (in category 'testing') -----
isQuickPrimitiveIndex: anInteger
^anInteger between: 256 and: 519!
----- Method: BytecodeAssembler>>nilLabelTargets (in category 'assembly') -----
nilLabelTargets
code instructions do:
[:messageOrLabel|
(self isLabel: messageOrLabel) ifTrue:
[messageOrLabel value: nil]]!
----- Method: BytecodeAssembler>>shouldUseLongAccessForInstVarOffset: (in category 'testing') -----
shouldUseLongAccessForInstVarOffset: offset
"compute the mask of which inst var offsets need to be negated.
This is true of inst vars of contexts only."
shouldNegateInstVarOffsetsMask ifNotNil:
[:snivo| ^(snivo bitAnd: (1 bitShift: offset)) ~= 0].
"The order in which this is done means that if the first offset is +ve all others will be too."
shouldNegateInstVarOffsetsMask := 0.
code methodClass instVarNamesAndOffsetsDo:
[:n :o|
o >= 0 ifTrue:
[^(shouldNegateInstVarOffsetsMask bitAnd: (1 bitShift: offset)) ~= 0].
o < 0 ifTrue:
[shouldNegateInstVarOffsetsMask := shouldNegateInstVarOffsetsMask + (1 bitShift: -1 - o)]].
^true!
----- Method: BytecodeAssembler>>sizePasses (in category 'assembly') -----
sizePasses
| sizer instructions lastForwardJump i limit messageOrLabel |
sizer := BytecodeSizer assembler: self encoder: encoder.
"Forward pass that sizes all except forward jumps."
i := 0.
limit := (instructions := code instructions) size.
[(i := i + 1) <= limit] whileTrue:
[messageOrLabel := instructions at: i.
sizes
at: i
put: ((self isLabel: messageOrLabel)
ifTrue: [0]
ifFalse: [index := i.
(messageOrLabel sentTo: sizer)
ifNil: [lastForwardJump := i. nil]
ifNotNil: [:size| size]])].
lastForwardJump ifNil: [^self].
"Backward pass that sizes forward jumps."
i := lastForwardJump + 1.
[(i := i - 1) >= 1] whileTrue:
[(sizes at: i) ifNil:
[index := i.
sizes
at: i
put: ((instructions at: i) sentTo: sizer)]]!
----- Method: BytecodeAssembler>>spanToBlockLabel: (in category 'assembly') -----
spanToBlockLabel: label "<Association>"
"N.B. Block labels are expected to follow the last bytecode
in the block and preceed the bytecode following the block."
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
self assert: (labelIndex > 1
and: [(self isLabel: (code instructions at: labelIndex - 1)) not
and: [#(blockReturnTop blockReturnConstant:
methodReturnTop methodReturnConstant: methodReturnReceiver)
includes: (code instructions at: labelIndex - 1) selector]]).
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex - 1]!
----- Method: BytecodeAssembler>>spanToLabel: (in category 'assembly') -----
spanToLabel: label "<Association>"
| labelIndex |
labelIndex := label value.
labelIndex ifNil:
[labelIndex := code instructions identityIndexOf: label.
label value: labelIndex].
^(sizes at: labelIndex) ifNotNil:
[self totalSizeFrom: index + 1 to: labelIndex]!
----- Method: BytecodeAssembler>>totalSizeFrom:to: (in category 'assembly') -----
totalSizeFrom: startPC to: targetPC
| sum |
sum := 0.
^(sizes at: targetPC) ifNotNil:
[startPC <= targetPC
ifTrue:
[startPC to: targetPC do:
[:i| sum := sum + (sizes at: i)]]
ifFalse:
[targetPC to: startPC - 1 do:
[:i|
"If a nil is found it will be for a forward branch in the first pass, and
the total size will be being requested by a backward branch. Simply
answer anything negative. All negative branches are long."
(sizes at: i)
ifNil: [^-1]
ifNotNil: [:size| sum := sum - size]]].
sum]!
----- Method: BytecodeAssembler>>verify: (in category 'private') -----
verify: assemblerMethod
"If the assemblerMethod contains verification info, check it against the method."
assemblerMethod header ifNotNil:
[:expectedHeader|
self assert: expectedHeader equals: method header entity: 'header'].
assemblerMethod initialPC ifNotNil:
[:expectedInitialPC| | alternatePCdelta | "the 32-bit pc if 64-bits or vice verce"
alternatePCdelta := Smalltalk wordSize = 8 ifTrue: [expectedInitialPC - 1] ifFalse: [(expectedInitialPC - 1) negated].
self assert: expectedInitialPC
or: expectedInitialPC + alternatePCdelta
equals: method initialPC
entity: 'initialPC'.
self assert: expectedInitialPC
or: expectedInitialPC + alternatePCdelta
equals: method initialPC
entity: 'endPC']!
Object subclass: #BytecodeCoverer
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BytecodeCoverer class>>unusedBytecodeSendsEnabled (in category 'utilities') -----
unusedBytecodeSendsEnabled
^(Smalltalk specialObjectsArray at: 58 ifAbsent: []) == #unusedBytecode!
----- Method: BytecodeCoverer>>checkUnusedBytecodeSendsEnabled (in category 'private') -----
checkUnusedBytecodeSendsEnabled
self class unusedBytecodeSendsEnabled ifFalse:
[self error: 'unusedBytecode sends are not enabled. continuting will likely crash the VM']!
----- Method: BytecodeCoverer>>coverMethod: (in category 'covering') -----
coverMethod: aMethod
| labels basicBlockStarts unusedBytecode |
self checkUnusedBytecodeSendsEnabled.
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
basicBlockStarts := Dictionary new.
unusedBytecode := aMethod encoderClass unusedBytecode.
self assert: unusedBytecode notNil.
labels do:
[:assoc| | pc |
pc := assoc value.
basicBlockStarts at: pc put: (aMethod at: pc).
aMethod at: pc put: unusedBytecode].
aMethod
propertyValueAt: #coverage put: basicBlockStarts;
voidCogVMState!
----- Method: BytecodeCoverer>>uncoverMethod: (in category 'covering') -----
uncoverMethod: aMethod
| coverage |
coverage := aMethod propertyValueAt: #coverage.
coverage ifNil: [^self].
coverage keysAndValuesDo:
[:pc :bytecode|
aMethod at: pc put: bytecode].
aMethod removeProperty: #coverage.
(aMethod penultimateLiteral isMethodProperties
and: [aMethod penultimateLiteral isEmpty]) ifTrue:
[aMethod penultimateLiteral: aMethod selector]!
Object subclass: #BytecodeDisassembler
instanceVariableNames: 'instructions labels labelling instrs thePC method'
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Kernel'!
BytecodeDisassembler subclass: #BasicBlockLabellingDisassembler
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Coverage'!
----- Method: BasicBlockLabellingDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Override to add a label for the start of the basic block that follows the jump."
super jump: offset if: condition.
labelling ifTrue:
[labels at: instrs pc put: true]!
----- Method: BasicBlockLabellingDisassembler>>label (in category 'disassembly') -----
label
"Override to add a label for the first bytecode pc.
Be careful to skip any initial callPrimitive bytecode."
method isQuick ifFalse:
[| startPC primCode|
startPC := (method primitive ~= 0
and: [(primCode := method encoderClass callPrimitiveCode) notNil])
ifTrue: [method initialPC + ((InstructionStream on: method) bytecodeSize: primCode)]
ifFalse: [method initialPC].
labels at: startPC put: true].
super label!
----- Method: BasicBlockLabellingDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
"Override to add a label for the start of a block."
labelling ifTrue:
[labels at: instrs pc put: true].
super pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize!
----- Method: BytecodeDisassembler>>branchIfInstanceOf:distance: (in category 'instruction decoding') -----
branchIfInstanceOf: aLiteral distance: distance
(self labelOrNilIfLabellingFor: distance) ifNotNil:
[:label| | litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #branchIfInstanceOfLiteralAtIndex:distance:
arguments: {litIndex. label})]!
----- Method: BytecodeDisassembler>>branchIfNotInstanceOf:distance: (in category 'instruction decoding') -----
branchIfNotInstanceOf: aLiteral distance: distance
(self labelOrNilIfLabellingFor: distance) ifNotNil:
[:label| | litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #branchIfNotInstanceOfLiteralAtIndex:distance:
arguments: {litIndex. label})]!
----- Method: BytecodeDisassembler>>disassemble: (in category 'disassembly') -----
disassemble: aMethod
| endPC |
method := aMethod.
labels := Array new: aMethod size + 1 withAll: false.
instructions := Array new: aMethod size + 1.
instrs := InstructionStream on: aMethod.
endPC := aMethod endPC.
labelling := true.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
self label.
labelling := false.
instrs pc: aMethod initialPC.
[(thePC := instrs pc) <= endPC] whileTrue:
[instrs interpretNextInstructionFor: self].
^(AssemblerMethod
literals: (self disassembleLiterals: aMethod literals)
instructions: self instructionSequence
numArgs: aMethod numArgs
numTemps: aMethod numTemps
frameSize: aMethod frameSize
primitive: aMethod primitive
flag: aMethod flag
signFlag: aMethod signFlag
accessModifier: ([method accessModifierBits] on: MessageNotUnderstood do: [:ex| nil])
noCounters: ([method hasNoCountersFlag] on: MessageNotUnderstood do: [:ex| [method hasNoCounterBit] on: MessageNotUnderstood do: [:ex2| nil]])
trailer: aMethod trailer
methodClass: aMethod methodClass
selector: aMethod selector
compiledMethodClass: aMethod class)
recordVerificationInfoFrom: aMethod;
yourself
"BytecodeDisassembler new disassemble: BytecodeDisassembler >> #jump:if:"!
----- Method: BytecodeDisassembler>>disassembleLiterals: (in category 'disassembly') -----
disassembleLiterals: literals
literals allButLast withIndexDo: [ :lit :index |
lit class == CompiledBlock
ifTrue: [ literals at: index put: (BytecodeDisassembler new disassemble: lit) ] ].
^ literals!
----- Method: BytecodeDisassembler>>doesNotUnderstand: (in category 'disassembly') -----
doesNotUnderstand: aMessage
(BytecodeSizer includesSelector: aMessage selector) ifFalse:
[^super doesNotUnderstand: aMessage].
aMessage lookupClass: nil.
instructions at: thePC put: aMessage!
----- Method: BytecodeDisassembler>>instructionSequence (in category 'disassembly') -----
instructionSequence
^Array streamContents:
[:s|
labels with: instructions do:
[:label :inst|
inst ifNotNil:
[label ~~ false ifTrue:
[s nextPut: label].
s nextPut: inst]]]!
----- Method: BytecodeDisassembler>>jump: (in category 'instruction decoding') -----
jump: offset
"Print the Unconditional Jump bytecode."
(self labelOrNilIfLabellingFor: offset) ifNotNil:
[:label|
instructions
at: thePC
put: (Message
selector: #jump:
argument: label)]!
----- Method: BytecodeDisassembler>>jump:if: (in category 'instruction decoding') -----
jump: offset if: condition
"Disassemble the Conditional Jump bytecode."
(self labelOrNilIfLabellingFor: offset) ifNotNil:
[:label|
instructions
at: thePC
put: (Message
selector: #jump:if:
arguments: { label. condition })]!
----- Method: BytecodeDisassembler>>label (in category 'disassembly') -----
label
"N.B. A Label is an Association so that later its pc can be sorted in its value field."
| n |
n := 0.
labels doWithIndex:
[:l :i|
l ifTrue:
[labels at: i put: (Association new key: 'L', (n := n + 1) printString value: i)]]!
----- Method: BytecodeDisassembler>>labelOrNilIfLabellingFor: (in category 'private') -----
labelOrNilIfLabellingFor: offset
"If labelling, just set a flag at the target and answer nil.
If done labelling answer the relevant label."
^labelling
ifTrue: [labels at: instrs pc + offset put: true. nil]
ifFalse: [labels at: instrs pc + offset]!
----- Method: BytecodeDisassembler>>popIntoLiteralVariable: (in category 'instruction decoding') -----
popIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #popIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>popIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
popIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #popIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #popIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>pushClosureCopyNumCopiedValues:numArgs:blockSize: (in category 'instruction decoding') -----
pushClosureCopyNumCopiedValues: numCopied numArgs: numArgs blockSize: blockSize
labelling
ifTrue:
[labels at: instrs pc + blockSize put: true]
ifFalse:
[instructions
at: thePC
put: (Message
selector: #pushClosureCopyNumCopiedValues:numArgs:blockSize:
arguments: { numCopied. numArgs. labels at: instrs pc + blockSize })]!
----- Method: BytecodeDisassembler>>pushConstant: (in category 'instruction decoding') -----
pushConstant: aLiteral
instructions
at: thePC
put: ((method encoderClass literalIndexOfBytecodeAt: thePC in: method)
ifNil: [Message
selector: #pushSpecialConstant:
argument: aLiteral]
ifNotNil:
[:index|
Message
selector: #pushConstantAtIndex:
argument: index])!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [self error: 'cannot encode the method'].
instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:
arguments: {litIndex. numCopied})!
----- Method: BytecodeDisassembler>>pushFullClosure:numCopied:receiverOnStack:ignoreOuterContext: (in category 'instruction decoding') -----
pushFullClosure: compiledBlock numCopied: numCopied receiverOnStack: rcvrOnStack ignoreOuterContext: ignoreOuterContext
| litIndex |
litIndex := method literals indexOf: compiledBlock.
litIndex ifNil: [self error: 'cannot encode the method'].
instructions
at: thePC
put: (Message
selector: #pushFullClosureAtIndex:numCopied:receiverOnStack:ignoreOuterContext:
arguments: {litIndex. numCopied. rcvrOnStack. ignoreOuterContext})!
----- Method: BytecodeDisassembler>>pushLiteralVariable: (in category 'instruction decoding') -----
pushLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #pushLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>pushRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
pushRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #pushRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #pushRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: BytecodeDisassembler>>storeIntoLiteralVariable: (in category 'instruction decoding') -----
storeIntoLiteralVariable: aLiteral
| litIndex |
litIndex := method encoderClass literalIndexOfBytecodeAt: thePC in: method.
litIndex ifNil: [self error: 'could not decode literal index'].
instructions
at: thePC
put: (Message
selector: #storeIntoLiteralVariableAtIndex:
argument: litIndex)!
----- Method: BytecodeDisassembler>>storeIntoRemoteTemp:inVectorAt: (in category 'instruction decoding') -----
storeIntoRemoteTemp: remoteTempIndex inVectorAt: tempVectorIndex
instructions
at: thePC
put: (tempVectorIndex >= 128
ifTrue:
[Message
selector: #storeIntoRemoteInstanceVariable:inObjectAt:
arguments: { remoteTempIndex. tempVectorIndex - 128 }]
ifFalse:
[Message
selector: #storeIntoRemoteTemp:inVectorAt:
arguments: { remoteTempIndex. tempVectorIndex }])!
----- Method: CompiledMethod>>assemblerString (in category '*MethodMassage-disassembly') -----
assemblerString
^self disassemble assemblerString!
----- Method: CompiledMethod>>disassemble (in category '*MethodMassage-disassembly') -----
disassemble
^BytecodeDisassembler new disassemble: self!
----- Method: CompiledMethod>>indexOfDifferenceWith: (in category '*MethodMassage-debugging') -----
indexOfDifferenceWith: method
"Answer whether the receiver implements the same code as the argument, method.
Here ``same code'' means that if the receiver's source is compiled with the same
compiler it should produce the same sequence of bytecodes and literals, same
trailer and same properties. Hence this definition of #= (only one of many plausible
definitions) can be used to quickly identify changes in the compiler's output."
| numLits |
method isCompiledMethod ifFalse: [^1].
self size = method size ifFalse: [^-2].
self header = method header ifFalse: [^-3]. "N.B. includes numLiterals comparison."
self initialPC to: self endPC do:
[:i | (self at: i) = (method at: i) ifFalse: [^i]].
numLits := self numLiterals.
1 to: numLits do:
[:i| | lit1 lit2 |
lit1 := self literalAt: i.
lit2 := method literalAt: i.
(lit1 == lit2 or: [lit1 literalEqual: lit2]) ifFalse:
[(i = 1 and: [#(117 120) includes: self primitive])
ifTrue:
[lit1 isArray
ifTrue:
[(lit2 isArray and: [lit1 allButLast = lit2 allButLast]) ifFalse:
[^i]]
ifFalse: "ExternalLibraryFunction"
[(lit1 analogousCodeTo: lit2) ifFalse:
[^i]]]
ifFalse:
[i = (numLits - 1)
ifTrue: "properties"
[(self properties analogousCodeTo: method properties)
ifFalse: [^i]]
ifFalse: "last literal (methodClassAssociation) of class-side methods is not unique"
[(i = numLits
and: [lit1 isVariableBinding
and: [lit2 isVariableBinding
and: [lit1 key == lit2 key
and: [lit1 value == lit2 value]]]]) ifFalse:
[^i]]]]].
^0!
----- Method: MethodContext>>unusedBytecode (in category '*MethodMassage-coverage') -----
unusedBytecode
"Handle unusedBytecode by replacing the bytecode with the
correct one found in the coverage property and continuing.
Continue via wait/signal since return would push a result."
| coverage semaphore process originalBytecode |
self assert: (method at: pc) = method encoderClass unusedBytecode.
coverage := method propertyValueAt: #coverage.
self assert: coverage notNil.
originalBytecode := coverage at: pc ifAbsent: [nil].
self assert: originalBytecode notNil.
semaphore := Semaphore new.
process := Processor activeProcess.
[method at: pc put: originalBytecode.
coverage removeKey: pc ifAbsent: [].
process suspendedContext unwindTo: self.
process suspendedContext: self.
semaphore signal] fork.
semaphore wait!
----- Method: BytecodeEncoder class>>assembler (in category '*MethodMassage-assembly') -----
assembler
"Answer an assembler for a method that uses the receiver's instruction set."
^AssemblerMethod new
encoder: self new;
yourself!
----- Method: BytecodeEncoder>>litIndexOrNilFor: (in category '*MethodMassage-literal access') -----
litIndexOrNilFor: aLiteral
| index |
index := aLiteral isVariableBinding
ifTrue: [literalStream originalContents identityIndexOf: aLiteral ifAbsent: [^nil]]
ifFalse: [literalStream originalContents indexOf: aLiteral ifAbsent: [^nil]].
^index <= literalStream position ifTrue:
[index - 1]!
----- Method: CompiledMethodTrailer>>rawData (in category '*MethodMassage-raw data') -----
rawData
^(ByteArray new: size)
replaceFrom: 1
to: size
with: method
startingAt: method size - size + 1!
----- Method: EncoderForSistaV1 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: method
"16-31 0001 iiii Push Literal Variable #iiii
32-63 001 iiiii Push Literal #iiiii
* 227 11100011 iiiiiiii Push Literal Variable #iiiiiiii (+ Extend A * 256)
* 228 11100100 iiiiiiii Push Literal #iiiiiiii (+ Extend A * 256)
** 254 11111110 kkkkkkkk jjjjjjjj branch If Not Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0 and <= 127)
** 254 11111110 kkkkkkkk jjjjjjjj branch If Instance Of Behavior/Array Of Behavior literal kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ (Extend B bitAnd: 127) * 256, where Extend B >= 128 and <= 255)
"
^self extensionsAt: pc in: method into:
[:extA :extB :nExts| | byte |
byte := method at: pc + nExts.
byte < 64
ifTrue:
[byte < 32
ifTrue: [byte > 15 ifTrue: [byte bitAnd: 16rF]]
ifFalse: [byte bitAnd: 16r1F]]
ifFalse:
[(byte >= 227 and: [byte <= 228 or: [byte = 254]]) ifTrue:
[extA * 256 + (method at: pc + nExts + 1)]]]!
----- Method: Encoder>>initClass:literalStream: (in category '*MethodMassage-instance initialization') -----
initClass: targetBehavior literalStream: literalsOrNil
cue := CompilationCue class: targetBehavior.
class := targetBehavior.
optimizedSelectors := Set new.
literalsOrNil
ifNil:
[literalStream := WriteStream on: (Array new: 32).
addedSelectorAndMethodClassLiterals := false]
ifNotNil:
[literalStream := (WriteStream on: literalsOrNil asArray from: 1 to: literalsOrNil size) setToEnd.
addedSelectorAndMethodClassLiterals := true]!
----- Method: EncoderForV3 class>>literalIndexOfBytecodeAt:in: (in category '*MethodMassage-disassembly') -----
literalIndexOfBytecodeAt: pc in: aCompiledMethod
"32-63 001iiiii Push Literal Constant #iiiii
64-95 010iiiii Push Literal Variable #iiiii
128 10000000 jjkkkkkk Push (Receiver Variable, Temporary Location, Literal Constant, Literal Variable) [jj] #kkkkkk
129 10000001 jjkkkkkk Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
130 10000010 jjkkkkkk Pop and Store (Receiver Variable, Temporary Location, Illegal, Literal Variable) [jj] #kkkkkk
132 10000100 iiijjjjj kkkkkkkk (Send, Send Super, Push Receiver Variable, Push Literal Constant, Push Literal Variable, Store Receiver Variable, Store-Pop Receiver Variable, Store Literal Variable)[iii] #kkkkkkkk jjjjj (for sends jjjjj = numArgs)"
| byte type |
byte := aCompiledMethod at: pc.
byte <= 95 ifTrue:
[^byte >= 32 ifTrue:
[byte bitAnd: 16r1F]].
(byte between: 128 and: 130) ifTrue:
[^(aCompiledMethod at: pc + 1) bitAnd: 16r3F].
byte = 132 ifTrue:
[type := (aCompiledMethod at: pc + 1) bitShift: -5.
(type = 3 or: [type = 4 or: [type = 7]]) ifTrue:
[^aCompiledMethod at: pc + 2]].
^nil!
TestCase subclass: #BytecodeAssemblerTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeAssemblerTests class>>fixupMethodClassBindings (in category 'utilities') -----
fixupMethodClassBindings
"Work-around the Monticello bug that results in not sharing the binding in Smalltalk as a method's methodClassAssociation."
"self fixupMethodClassBindings"
self systemNavigation allSelect:
[:m|
(m methodClass isMeta not
and: [m methodClassAssociation key isNil]) ifTrue:
[m methodClassAssociation: m methodClass binding].
false]!
----- Method: BytecodeAssemblerTests>>contextPartMethodWithMostOf: (in category 'test support') -----
contextPartMethodWithMostOf: binaryBlock
^(Array streamContents: [:s| ContextPart withAllSubclassesDo: [:sc| s nextPutAll: sc methodDict values]])
inject: ContextPart methodDict anyOne
into:
[:m1 :m2|
((1 to: m1 methodClass instSize) select: [:i| binaryBlock value: m1 value: i]) size >=
((1 to: m2 methodClass instSize) select: [:i| binaryBlock value: m2 value: i]) size
ifTrue: [m1]
ifFalse: [m2]]!
----- Method: BytecodeAssemblerTests>>defaultTimeout (in category 'accessing') -----
defaultTimeout
"Answer the default timeout to use for tests in this test case.
The timeout is a value in seconds."
^30 "seconds"!
----- Method: BytecodeAssemblerTests>>expectedFailures (in category 'testing') -----
expectedFailures
((thisContext method respondsTo: #usesAlternateBytecodeSet)
or: [thisContext method respondsTo: #bytecodeSetName]) ifTrue:
[^#()].
^#(testDuplicateNewsqueakV4Methods)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerFor: (in category 'test support') -----
testAsAssemblerFor: aMethod
"self new testAsAssemblerFor: self >> #testAsAssemblerFor:"
| assemblerMethod assembler reassembledMethod |
assemblerMethod := BytecodeDisassembler new disassemble: aMethod.
assembler := String streamContents: [:s| assemblerMethod printAsAssemblerOn: s].
self shouldnt: [reassembledMethod := Compiler evaluate: assembler]
raise: Error.
self assert: assemblerMethod compiledMethodClass equals: reassembledMethod compiledMethodClass.
self assert: assemblerMethod flag equals: reassembledMethod flag.
self assert: assemblerMethod frameSize equals: reassembledMethod frameSize.
self assert: assemblerMethod methodClass equals: reassembledMethod methodClass.
self assert: assemblerMethod numArgs equals: reassembledMethod numArgs.
self assert: assemblerMethod numTemps equals: reassembledMethod numTemps.
self assert: assemblerMethod primitive equals: reassembledMethod primitive.
self assert: assemblerMethod selector equals: reassembledMethod selector.
self assert: assemblerMethod signFlag equals: reassembledMethod signFlag.
1 to: reassembledMethod literals size do:
[:i|
self assert: (assemblerMethod literals at: i)
equals: (reassembledMethod literals at: i)].
assemblerMethod instructions
ifNil: [self assert: reassembledMethod instructions isNil]
ifNotNil:
[:insts|
self assert: insts size equals: reassembledMethod instructions size.
"Nil the labels' values for analogousCodeTo: comparison below; the values
are usefully the bytecode pcs of the labels, but this fails the comparisons."
insts do: [:inst| inst isVariableBinding ifTrue: [inst value: nil]].
insts
with: reassembledMethod instructions
do: [:old :new|
old isVariableBinding
ifTrue: [self assert: old key = new key]
ifFalse: [self assert: (old analogousCodeTo: new)]]].
self assert: aMethod equals: (BytecodeAssembler new assemble: reassembledMethod)!
----- Method: BytecodeAssemblerTests>>testAsAssemblerForThisPackage (in category 'tests') -----
testAsAssemblerForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testAsAssemblerFor: m]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsFor: (in category 'test support') -----
testBasicBlockLabelsFor: aMethod
"self new testBasicBlockLabelsFor: self >> #testBasicBlockLabelsFor:"
| labels stream endPC nextPC |
labels := (BasicBlockLabellingDisassembler new disassemble: aMethod) labels.
aMethod isQuick ifTrue:
[^self assert: labels isEmpty].
self assert: (labels select: [:l| aMethod initialPC = l value]) size = 1.
aMethod embeddedBlockClosures do:
[:closure|
self assert: (labels select: [:l| closure startpc = l value]) size = 1].
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[nextPC := stream nextPc: (aMethod at: stream pc).
(stream willJumpIfTrue or: [stream willJumpIfFalse]) ifTrue:
["A conditional jump should have a label following it."
self assert: (labels select: [:l| stream followingPc = l value]) size = 1].
stream interpretJump ifNotNil:
[:dist| "There shoud be a label at the target, and, if it is conditional, also one following the jump."
self assert: (labels select: [:l| stream pc + dist = l value]) size = 1].
stream pc: nextPC]!
----- Method: BytecodeAssemblerTests>>testBasicBlockLabelsForThisPackage (in category 'tests') -----
testBasicBlockLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testDisassembleBytecodeAssemblerMethods (in category 'tests') -----
testDisassembleBytecodeAssemblerMethods
self testDisassembleMethodsFor: BytecodeAssembler!
----- Method: BytecodeAssemblerTests>>testDisassembleMethodsFor: (in category 'test support') -----
testDisassembleMethodsFor: aBehavior
aBehavior selectors asArray sort do:
[:sel| | method |
method := aBehavior compiledMethodAt: sel.
self shouldnt: [BytecodeDisassembler new disassemble: method]
raise: Error]!
----- Method: BytecodeAssemblerTests>>testDuplicateAllInstructionStreamMethods (in category 'tests') -----
testDuplicateAllInstructionStreamMethods
InstructionStream withAllSuperclasses, InstructionStream allSubclasses do:
[:isc|
self testDuplicateMethodsFor: isc
if: [:method| true]]!
----- Method: BytecodeAssemblerTests>>testDuplicateBytecodeAssemblerMethods (in category 'tests') -----
testDuplicateBytecodeAssemblerMethods
self testDuplicateMethodsFor: BytecodeAssembler
if: [:method| true]!
----- Method: BytecodeAssemblerTests>>testDuplicateMethodsFor:if: (in category 'test support') -----
testDuplicateMethodsFor: aBehavior if: methodSelectBlock
aBehavior selectors asArray sort do:
[:sel| | method disassembly assembly |
method := aBehavior compiledMethodAt: sel.
(methodSelectBlock value: method) ifTrue:
[disassembly := BytecodeDisassembler new disassemble: method.
assembly := BytecodeAssembler new assemble: disassembly.
"method indexOfDifferenceWith: assembly"
self assert: method equals: assembly]]!
----- Method: BytecodeAssemblerTests>>testDuplicateNewsqueakV4Methods (in category 'tests') -----
testDuplicateNewsqueakV4Methods
Smalltalk allClasses do:
((thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method usesAlternateBytecodeSet].
self testDuplicateMethodsFor: class class
if: [:method| method usesAlternateBytecodeSet]]]
ifFalse:
[[:class|
self testDuplicateMethodsFor: class
if: [:method| method bytecodeSetName = 'NewsqueakV4'].
self testDuplicateMethodsFor: class class
if: [:method| method bytecodeSetName = 'NewsqueakV4']]])!
----- Method: BytecodeAssemblerTests>>testDuplicateSqueakV3Methods (in category 'tests') -----
testDuplicateSqueakV3Methods
"AndreasProfiler spyOn: [self new testDuplicateSqueakV3Methods]"
| filter |
filter := (thisContext method respondsTo: #usesAlternateBytecodeSet)
ifTrue: [[:method| method usesAlternateBytecodeSet not]]
ifFalse: [[:method| true]].
Smalltalk allClasses do:
[:class|
self testDuplicateMethodsFor: class if: filter.
self testDuplicateMethodsFor: class class if: filter]!
----- Method: BytecodeAssemblerTests>>testLabelsFor: (in category 'test support') -----
testLabelsFor: aMethod
"self new testLabelsFor: self >> #testLabelsFor:"
| labels stream endPC |
labels := (BytecodeDisassembler new disassemble: aMethod) labels.
stream := InstructionStream on: aMethod.
endPC := aMethod endPC.
[stream pc <= endPC] whileTrue:
[stream interpretJump
ifNotNil: [:dist| self assert: (labels select: [:l| stream pc + dist = l value]) size = 1]
ifNil: [stream pc: (stream nextPc: (aMethod at: stream pc))]]!
----- Method: BytecodeAssemblerTests>>testLabelsForThisPackage (in category 'tests') -----
testLabelsForThisPackage
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testLabelsFor: m]!
----- Method: BytecodeAssemblerTests>>testManualAssembly (in category 'tests') -----
testManualAssembly
self
assert:
(AssemblerMethod new
methodClass: Object; selector: #printOn:; numArgs: 1; numTemps: 2;
pushReceiver;
send: #class;
send: #name;
popIntoTemporaryVariable: 1;
pushTemporaryVariable: 0;
doDup;
pushTemporaryVariable: 1;
send: #first;
send: #isVowel;
jump: 'L1' if: false;
pushConstant: 'an ';
jump: 'L2';
label: 'L1';
pushConstant: 'a ';
label: 'L2';
send: #nextPutAll:;
doPop;
pushTemporaryVariable: 1;
send: #nextPutAll:;
doPop;
methodReturnReceiver;
assemble) decompile printString
equals: (Object >>#printOn:) decompile printString!
TestCase subclass: #BytecodeCoverageTests
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'MethodMassage-Tests'!
----- Method: BytecodeCoverageTests>>coverTestBasicBlockLabelsForMethod (in category 'tests support') -----
coverTestBasicBlockLabelsForMethod
(PackageOrganizer default packageOfClass: self class) actualMethodsDo:
[:m| self testBasicBlockLabelsFor: m]!
----- Method: BytecodeCoverageTests>>setUp (in category 'initialize-release') -----
setUp
self class recompile: #testBasicBlockLabelsFor: from: BytecodeAssemblerTests!
----- Method: BytecodeCoverageTests>>tearDown (in category 'initialize-release') -----
tearDown
self class removeSelectorSilently: #testBasicBlockLabelsFor:!
----- Method: BytecodeCoverageTests>>testCoverageOfTestBasicBlockLabelsForMethod (in category 'tests') -----
testCoverageOfTestBasicBlockLabelsForMethod
"[| me |
me := self new.
[me setUp; testCoverageOfTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
"[| me |
me := self new.
[me setUp; coverTestBasicBlockLabelsForMethod]
ensure: [me tearDown]] timeToRun"
| theMethod |
theMethod := self class >> #testBasicBlockLabelsFor:.
BytecodeCoverer new coverMethod: theMethod.
self assert: (theMethod propertyValueAt: #coverage) notNil.
self assert: (theMethod propertyValueAt: #coverage) notEmpty.
self coverTestBasicBlockLabelsForMethod.
self assert: (theMethod propertyValueAt: #coverage) isEmpty!
1
0