Reduced dependencies to only stx:libbasic and stx:libcomp.
The latter will wanish as soon as actual bytecode assemby is implemented.
"{ Package: 'ctu:ircompiler' }"
Object subclass:#IRBytecodeGenerator
instanceVariableNames:'seqOrder orderSeq jumps literals lastLiteral currentSeqId
currentSeqNum lastSpecialReturn instrMaps instrMap maxTemp stacks
stack primNum numArgs numVars properties code seqCode lastLine'
classVariableNames:'BytecodeTable Bytecodes SpecialConstants SpecialSelectors'
poolDictionaries:''
category:'IR Compiler-Bytecode'
!
IRBytecodeGenerator comment:'I generate bytecodes in response to ''instructions'' messages being sent to me. I rewrite jumps at the end so their jump offsets are correct (see #bytecodes). For example, to create a compiled method that compares first instVar to first arg and returns ''yes'' or ''no'' (same example as in IRBuilder), do:
BytecodeGenerator new
numArgs: 1;
pushInstVar: 1;
pushTemp: 1;
send: #>;
if: false goto: #else;
pushLiteral: ''yes'';
returnTop;
label: #else;
pushLiteral: ''no'';
returnTop;
compiledMethod
You can send #ir to the compiledMethod to decompile to its IRMethod, and you can send #methodNode to either to decompile to its parse tree.
'
!
!IRBytecodeGenerator class methodsFor:'instance creation'!
new
^ self basicNew initialize.
"Created: / 11-06-2008 / 13:53:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'accessing'!
getCode
"
Private entry for IRBytecodeGenerator>>makeBlock:
"
^code
"Created: / 30-03-2009 / 19:00:07 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
properties: aDictionary
properties := aDictionary.
"Created: / 17-09-2008 / 12:17:49 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
setLiterals: aCollection
"
Private entry for IRBytecodeGenerator>>makeBlock:
"
^literals := aCollection
"Created: / 30-03-2009 / 23:09:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'accessing default'!
defaultStackCounter
^IRStackCount
"Modified: / 11-06-2008 / 13:51:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'initialize'!
initialize
literals := OrderedCollection new.
"The following dicts are keyed by sequence id given by client in label: (and gotos)."
seqOrder := IdentityDictionary new. "seqId -> seq order num"
seqCode := IdentityDictionary new. "seqId -> seq bytecodes"
jumps := IdentityDictionary new. "seqId -> last jump instr"
instrMaps := IdentityDictionary new. "seqId -> (clientInstr -> bytecode pos)"
stacks := IdentityDictionary new. "seqId -> stackCount"
maxTemp := 0.
primNum := 0.
numArgs := 0.
numVars := 0.
currentSeqNum := 0.
orderSeq := OrderedDictionary new. "reverse map of seqOrder"
lastLine := 0.
"starting label in case one is not provided by client"
self label: self newDummySeqId.
"Modified: / 30-03-2009 / 13:52:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numArgs: n
numArgs := n
"Modified: / 11-06-2008 / 14:39:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
primitiveNode: aPrimitiveNode
"There are no primitives in St/X"
"
literals isEmpty ifFalse: [self error: 'init prim before adding instructions'].
aPrimitiveNode spec ifNotNil: [literals add: aPrimitiveNode spec].
primNum _ aPrimitiveNode num.
"
"Modified: / 17-09-2008 / 12:16:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'instructions'!
goto: seqId
stacks at: seqId put: (stack linkTo: (stacks at: seqId ifAbsentPut: [nil])).
self saveLastJump: (Message
selector: #from:goto:
arguments: (Array with: currentSeqId with: seqId)).
self from: currentSeqId goto: seqId.
"Modified: / 13-05-2009 / 10:16:45 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
if: bool goto: seqId
| otherwiseSeqId |
otherwiseSeqId _ self newDummySeqId.
self if: bool goto: seqId otherwise: otherwiseSeqId.
self label: otherwiseSeqId.
!
if: bool goto: seqId1 otherwise: seqId2
stack pop.
stacks at: seqId1 put: (stack linkTo: (stacks at: seqId1 ifAbsentPut: [nil])).
stacks at: seqId2 put: (stack linkTo: (stacks at: seqId2 ifAbsentPut: [nil])).
self saveLastJump: (Message
selector: #from:if:goto:otherwise:
arguments: {currentSeqId. bool. seqId1. seqId2}).
self from: currentSeqId if: bool goto: seqId1 otherwise: seqId2.
!
initializeStackCounter
^ self defaultStackCounter new
!
label: seqId
(currentSeqId notNil and: [(jumps at: currentSeqId) isNil])
ifTrue:
["make previous implicit goto explicit"
self goto: seqId].
lastSpecialReturn := nil.
currentSeqId := seqId.
currentSeqNum := currentSeqNum + 1.
seqOrder at: seqId put: currentSeqNum.
orderSeq at: currentSeqNum ifAbsentPut: [seqId].
code := seqCode at: seqId ifAbsentPut: [OrderedCollection new].
jumps at: seqId ifAbsentPut: [nil].
instrMap := instrMaps at: seqId ifAbsentPut: [OrderedCollection new].
stack := stacks at: seqId ifAbsentPut: [self initializeStackCounter]
"Modified: / 11-06-2008 / 13:58:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
line: line
lastLine = line ifTrue:[^self].
lastLine := line.
(line < 256)
ifTrue:
[self
nextPut: #lineno;
nextPut: line]
ifFalse:
[self
nextPut: #lineno16;
nextPut: line]
"Created: / 02-12-2008 / 09:02:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 02-12-2008 / 10:38:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
makeBlock: irClosure
| pos translator closureCode |
stack push.
pos := code size.
self
nextPut: #makeBlock;
nextPut: nil "Index of block bytecode end. Patched later";
nextPut: irClosure numVars;
nextPut: irClosure numArgs.
translator := IRTranslator new.
translator getGenerator setLiterals: literals.
closureCode := translator
interpret: irClosure;
getCode.
"Patch makeBlock offsets"
closureCode withIndexDo:
[:instr :index|
instr == #makeBlock ifTrue:
[closureCode
at: index + 1
put: (closureCode at: index + 1) + pos + 4]].
code addAll: closureCode.
"Patch number of closure bytecodes"
code at: pos + 2 put: code size + 1.
"Created: / 30-03-2009 / 18:16:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 12-05-2009 / 08:58:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
popTop
stack pop.
self nextPut: #drop
"Modified: / 11-06-2008 / 14:17:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushBlockArg: index
stack push.
self
nextPut: #pushBlockArg;
nextPut: index
"Created: / 30-03-2009 / 19:07:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushBlockVar: index
stack push.
numArgs := index max: numArgs.
self
nextPut: #pushBlockVar;
nextPut: index
"Created: / 30-03-2009 / 19:07:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushDup
stack push.
self nextPut: #dup
"Modified: / 11-06-2008 / 14:15:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushInstVar: index
stack push.
(index between: 1 and: 10)
ifTrue:[self nextPut:('pushInstVar',index printString) asSymbol]
ifFalse:[self nextPut:#pushInstVar; nextPut: index].
"Modified: / 11-06-2008 / 14:19:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushLiteral:object
stack push.
object == nil ifTrue:[^self nextPut: #pushNil].
object == 0 ifTrue:[^self nextPut: #push0].
object == 1 ifTrue:[^self nextPut: #push1].
object == 2 ifTrue:[^self nextPut: #push2].
object == -1 ifTrue:[^self nextPut: #pushMinus1].
object == true ifTrue:[^self nextPut: #pushTrue].
object == false ifTrue:[^self nextPut: #pushFalse].
self
nextPut:#pushLitS;
nextPut:(self addLiteral:object).
"Modified: / 16-05-2009 / 18:16:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushLiteralVariable:object
self
assert: object isSymbol
message: 'Literal variables are identified by symbols!!'.
stack push.
self
nextPut:#pushGlobalS;
nextPut:(self addLiteral:object)
"Modified: / 16-05-2009 / 18:00:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushMethodArg: index
| |
stack push.
numArgs := index max: numArgs.
self
nextPut: #pushMethodArg;
nextPut: index
"Created: / 30-03-2009 / 13:50:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushMethodVar: index
| |
stack push.
numVars := index max: numVars.
self
nextPut: #pushMethodVar;
nextPut: index
"Created: / 30-03-2009 / 14:12:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushReceiver
stack push.
self nextPut: #pushSelf
"Modified: / 11-06-2008 / 14:14:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushThisContext
stack push.
self nextPut: #pushThisContext
"Modified: / 11-06-2008 / 14:31:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
remoteReturn
self
saveLastJump: #return;
nextPut: #homeRetTop
"Modified: / 26-04-2009 / 13:21:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
returnConstant: obj
self saveLastJump: #return.
code size = 0 ifTrue: [
lastSpecialReturn := Message selector: #returnConstant: argument: obj].
obj = true ifTrue:[^self nextPut: #retTrue].
obj = false ifTrue:[^self nextPut: #retFalse].
obj = nil ifTrue:[^self nextPut: #retNil].
obj = 0 ifTrue:[^self nextPut: #ret0].
self pushLiteral: obj.
self returnTop.
"Modified: / 11-06-2008 / 14:07:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
returnInstVar: index
self saveLastJump: #return.
code size = 0 ifTrue: [
lastSpecialReturn := Message selector: #returnInstVar: argument: index].
self pushInstVar: index.
self returnTop.
"Modified: / 11-06-2008 / 13:56:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
returnReceiver
self saveLastJump: #return.
code size = 0 ifTrue: [
lastSpecialReturn := Message selector: #returnReceiver].
self nextPut: #retSelf
"Modified: / 11-06-2008 / 14:29:31 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
returnTop
self saveLastJump: #return.
self nextPut: #retTop
"Modified: / 11-06-2008 / 14:04:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
send: selector numArgs: sendNumArgs
stack pop: sendNumArgs.
self
nextPut: #send;
nextPut: lastLine;
nextPut: (self addLiteral: selector);
nextPut: sendNumArgs.
"Created: / 01-12-2008 / 19:47:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 13-05-2009 / 10:06:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
send: selector numArgs: sendNumArgs toSuperOf: behavior
stack pop: sendNumArgs.
self
nextPut: #superSend;
nextPut: lastLine;
nextPut: (self addLiteral: selector);
nextPut: sendNumArgs;
nextPut: (self addLiteral: behavior superclass)
"Created: / 01-12-2008 / 19:48:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 13-05-2009 / 10:05:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
storeBlockArg: index
stack pop.
self
nextPut:#storeBlockArg;
nextPut:index
"Created: / 30-03-2009 / 19:06:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
storeBlockVar: index
stack pop.
numVars := index max: numVars.
self
nextPut:#storeBlockVar;
nextPut:index
"Created: / 30-03-2009 / 19:03:55 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
storeInstVar: index
self
nextPut: #storeInstVar;
nextPut: index.
"Modified: / 11-06-2008 / 14:49:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
storeIntoLiteralVariable: object
stack pop.
self
nextPut: #storeGlobalS;
nextPut: (self addLiteral: object)
"Modified: / 11-06-2008 / 16:23:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
storeMethodVar: index
stack pop.
numVars := index max: numVars.
self
nextPut:#storeMethodVar;
nextPut:index
"Created: / 30-03-2009 / 13:57:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'mapping'!
mapBytesTo: instr
"Associate next byte with instr"
instrMap add: instr -> (code size + 1)
"Modified: / 11-06-2008 / 13:56:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'old style blocks'!
blockReturnTop
self saveLastJump: #return.
self nextPut: (Bytecodes at: #returnTopFromBlock).
!
fromBlock: curId goto: seqId
| distance from to |
from _ seqOrder at: curId.
to _ seqOrder at: seqId ifAbsent: [^ self].
distance _ (from + 1 to: to - 1) inject: 0 into: [:size :i |
size + (seqCode at: (orderSeq at: i)) size].
distance > 1023 ifTrue: [self error: 'forward jump too big'].
self nextPut: (Bytecodes at: #longUnconditionalJump) first + (distance // 256) + 4.
self nextPut: distance \\ 256.
"Modified: / 11-06-2008 / 13:58:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
jumpOverBlock: seqId
stacks at: seqId put: (stack linkTo: (stacks at: seqId ifAbsentPut: [nil])).
self saveLastJump: (Message
selector: #fromBlock:goto:
arguments: {currentSeqId. seqId}).
self fromBlock: currentSeqId goto: seqId.
! !
!IRBytecodeGenerator methodsFor:'private'!
addLastLiteral: object
lastLiteral ifNil: [^ lastLiteral := object].
(lastLiteral = object)
ifFalse: [self error: 'there can only be one last literal'].
"Modified: / 11-06-2008 / 13:49:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
addLiteral: object
(literals includesIdentical: object)
ifFalse:[literals add: object].
^ literals identityIndexOf: object
"Modified: / 03-11-2008 / 13:49:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
from: fromSeqId goto: toSeqId
| distance from to |
from _ seqOrder at: fromSeqId.
to _ seqOrder at: toSeqId ifAbsent: [^ self].
from + 1 = to ifTrue: [^ self]. "fall through, no jump needed"
from < to ifTrue: [ "jump forward"
distance _ (from + 1 to: to - 1) inject: 0 into: [:size :i |
size + (seqCode at: (orderSeq at: i)) size].
self jumpForward: distance.
] ifFalse: [ "jump backward"
distance _ ((to to: from - 1) inject: 0 into: [:size :i |
size + (seqCode at: (orderSeq at: i)) size])
+ code size.
self jumpBackward: distance.
].
"Modified: / 11-06-2008 / 13:58:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
from: fromSeqId if: bool goto: toSeqId otherwise: otherwiseSeqId
| distance from to otherwise |
from _ seqOrder at: fromSeqId.
to _ seqOrder at: toSeqId ifAbsent: [^ self jump: 0 if: bool]. "not done yet"
otherwise _ seqOrder at: otherwiseSeqId ifAbsent: [^ self jump: 0 if: bool]. "not done yet"
from < to ifFalse: [self errorConditionalJumpBackwards].
from + 1 = otherwise ifFalse: [self errorFallThroughSequenceNotNext].
distance _ (from + 1 to: to - 1)
inject: 0
into: [:size :i | size + (seqCode at: (orderSeq at: i)) size].
self jump: distance if: bool.
"Modified: / 11-06-2008 / 13:58:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
jump: distance if: condition
| |
distance = 0 ifTrue: [
"jumps to fall through, no-op"
^ self popTop].
self
nextPut:(condition ifTrue:[#trueJump] ifFalse:[#falseJump]);
nextPut: distance
"Modified: / 11-06-2008 / 15:49:07 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
jumpBackward: distance
| |
distance = 0 ifTrue: [^ self]. "no-op"
self
nextPut:#jump;
nextPut: distance negated
"
dist _ 1024 - distance - 2.
dist < 0 ifTrue: [self error: 'back jump too big'].
self nextPut: (Bytecodes at: #longUnconditionalJump) first + (dist // 256).
self nextPut: dist \\ 256.
"
"Modified: / 11-06-2008 / 15:48:56 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
jumpForward: distance
distance = 0 ifTrue: [^ self]. "no-op"
self
nextPut:#jump;
nextPut:distance
"Modified: / 11-06-2008 / 15:26:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
newDummySeqId
^ Object new
!
nextPut: byte
code add: byte
"Modified: / 11-06-2008 / 13:56:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
saveLastJump: message
jumps at: currentSeqId put: (Array with: code size with: message).
"Modified: / 11-06-2008 / 15:40:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
updateJump: seqId
"Recalculate final jump bytecodes. Return true if jump bytecodes SIZE has changed, otherwise return false"
| pair s1 |
pair := jumps at: seqId.
pair last == #return ifTrue: [^ false]. "no jump, a return"
code := seqCode at: seqId.
s1 := code size.
code removeLast: (code size - pair first).
pair last sendTo: self.
^ s1 ~= code size
"Modified: / 11-06-2008 / 15:31:49 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'results'!
bytecodesAndLiteralArray
| byteCodeCompiler |
byteCodeCompiler := ByteCodeCompiler new.
byteCodeCompiler literalArray: literals.
byteCodeCompiler genByteCodeFrom: self symboliccodes.
^Array
with: byteCodeCompiler code
with: byteCodeCompiler literalArray.
"Created: / 03-11-2008 / 14:20:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
compiledCodeUsing:aCompiledMethodClass
"
self symboliccodes"
|bytecodesAndLiteralArray|
bytecodesAndLiteralArray := self bytecodesAndLiteralArray.
^ (aCompiledMethodClass new:literals size)
numberOfArgs:numArgs;
numberOfVars:numVars;
stackSize: self stackSize;
byteCode:bytecodesAndLiteralArray first;
literals:bytecodesAndLiteralArray second asArray;
yourself
"Created: / 11-06-2008 / 14:02:03 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 13-05-2009 / 10:42:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
literals
^literals asArray
" old "
" literals := literals asArray copyWith: MethodProperties new.
^ lastLiteral
ifNil: [literals copyWith: nil ]
ifNotNil: [literals copyWith: lastLiteral]"
"Modified: / 03-11-2008 / 13:41:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numArgs
^ numArgs
!
numTemps
^ numArgs + numVars
"Modified: / 30-03-2009 / 13:53:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
relativeJumpsToAbsoluteIn: symbolicCode
symbolicCode withIndexDo:
[:instr :index|
(instr isSymbol and:[#(jump trueJump falseJump) includes: instr]) ifTrue:
[|offset|
offset := symbolicCode at: index + 1.
(offset > 0)
ifTrue:[symbolicCode at: index + 1 put: (index + offset + 2)]
ifFalse:[symbolicCode at: index + 1 put: (index + offset)]]].
^symbolicCode.
"Created: / 11-06-2008 / 15:56:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
stackSize
^ (stacks collect: [:s | s length]) max
!
symboliccodes
| stream basicBlockStartOffset |
[ orderSeq
inject: false
into: [:changed :seqId | (self updateJump: seqId) | changed]
] whileTrue.
stream := (OrderedCollection new: 200) writeStream.
basicBlockStartOffset := 0.
orderSeq do: [:seqId |
(instrMaps at: seqId) do: [:assoc |
assoc key "instr" bytecodeIndex: stream position + assoc value.
].
"Patch makeBlock offsets"
(seqCode at: seqId) withIndexDo:
[:instr :index|
instr == #makeBlock ifTrue:
[(seqCode at: seqId)
at: index + 1
put: ((seqCode at: seqId) at: index + 1) + basicBlockStartOffset]].
stream nextPutAll: (seqCode at: seqId).
basicBlockStartOffset := basicBlockStartOffset + (seqCode at: seqId) size.
].
^self relativeJumpsToAbsoluteIn:stream contents
"Created: / 11-06-2008 / 14:00:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 13-05-2009 / 11:15:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator class methodsFor:'documentation'!
version_CVS
^ '$eader: /cvs/stx/cvut/stx/goodies/newcompiler/IRBytecodeGenerator.st,v 1.3 2009/10/08 12:04:39 fm Exp$'
!
version_SVN
^ '$Id:: $'
! !