--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/IRBytecodeGenerator.st Wed Jun 11 14:54:42 2008 +0000
@@ -0,0 +1,610 @@
+"{ Package: 'stx:goodies/newcompiler' }"
+
+Object subclass:#IRBytecodeGenerator
+ instanceVariableNames:'seqOrder orderSeq jumps literals lastLiteral currentSeqId
+ currentSeqNum lastSpecialReturn instrMaps instrMap maxTemp stacks
+ stack primNum numArgs properties code seqCode'
+ classVariableNames:'BytecodeTable Bytecodes SpecialConstants SpecialSelectors'
+ poolDictionaries:''
+ category:'NewCompiler-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 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.
+ currentSeqNum := 0.
+ orderSeq := Dictionary new. "reverse map of seqOrder"
+
+ "starting label in case one is not provided by client"
+ self label: self newDummySeqId.
+
+ "Modified: / 11-06-2008 / 14:43:48 / 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
+
+ literals isEmpty ifFalse: [self error: 'init prim before adding instructions'].
+ aPrimitiveNode spec ifNotNil: [literals add: aPrimitiveNode spec].
+ primNum _ aPrimitiveNode num.
+! !
+
+!IRBytecodeGenerator methodsFor:'instructions'!
+
+goto: seqId
+
+ stacks at: seqId put: (stack linkTo: (stacks at: seqId ifAbsentPut: [nil])).
+
+ self saveLastJump: (Message
+ selector: #from:goto:
+ arguments: {currentSeqId. seqId}).
+ self from: currentSeqId goto: seqId.
+!
+
+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>"
+!
+
+popTop
+
+ stack pop.
+
+ self nextPut: #drop
+
+ "Modified: / 11-06-2008 / 14:17:22 / 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.
+
+ self
+ nextPut: #pushLit;
+ nextPut: (self addLiteral: object).
+
+ "Modified: / 11-06-2008 / 14:04:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+pushLiteralVariable: object
+
+ stack push.
+
+ self
+ nextPut: #pushGlobalS;
+ nextPut: (self addLiteral: object)
+
+ "Modified: / 11-06-2008 / 14:13:42 / 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>"
+!
+
+pushTemp: index
+
+ | instr idx |
+
+ stack push.
+ maxTemp := index max: maxTemp.
+
+ idx := index.
+ instr := index <= numArgs
+ ifTrue:[#pushMethodArg]
+ ifFalse:[idx := idx - numArgs.#pushMethodVar].
+ self
+ nextPut: instr;
+ nextPut: idx
+
+ "Modified: / 11-06-2008 / 14:46:22 / 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.
+
+ self send: #privRemoteReturnTo:.
+!
+
+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
+
+ stack pop: selector numArgs.
+
+
+ self
+ nextPut: #send;
+ nextPut: 0; "lineno"
+ nextPut: (self addLiteral: selector);
+ nextPut: selector numArgs.
+
+ "Modified: / 11-06-2008 / 14:16:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+send: selector toSuperOf: behavior
+
+ stack pop: selector numArgs.
+
+
+ self
+ nextPut: #superSend;
+ nextPut: 0; "lineno"
+ nextPut: (self addLiteral: selector);
+ nextPut: selector numArgs;
+ nextPut: (self addLiteral: behavior superclass)
+
+ "Modified: / 11-06-2008 / 16:10:34 / 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>"
+!
+
+storeTemp: index
+
+ stack pop.
+ maxTemp := index max: maxTemp.
+
+ index <= numArgs ifTrue:[self error:'Cannot store to method argument!!'].
+
+ self
+ nextPut:#storeMethodVar;
+ nextPut:index - numArgs
+
+ "Modified: / 11-06-2008 / 16:24:28 / 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 includes: object)
+ ifFalse:[literals add: object].
+ ^ literals identityIndexOf: object
+
+ "Modified: / 11-06-2008 / 13:49:00 / 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'!
+
+bytecodes
+
+ ^ByteCodeCompiler new
+ genByteCodeFrom: self symboliccodes;
+ code.
+
+ "Modified: / 11-06-2008 / 14:01:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+compiledMethod
+
+ ^ self compiledMethodUsing: Method
+
+ "Modified: / 11-06-2008 / 14:01:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+compiledMethodUsing: aCompiledMethodClass
+
+ ^(aCompiledMethodClass new: literals size)
+ numberOfArgs: numArgs;
+ numberOfVars: maxTemp - numArgs ;
+ byteCode: self bytecodes;
+ literals: literals asArray;
+ yourself
+
+ "Created: / 11-06-2008 / 14:02:03 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+literals
+
+ literals := literals asArray copyWith: MethodProperties new.
+
+ ^ lastLiteral
+ ifNil: [literals copyWith: nil ]
+ ifNotNil: [literals copyWith: lastLiteral]
+!
+
+numArgs
+
+ ^ numArgs
+!
+
+numTemps
+
+ ^ maxTemp
+!
+
+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 |
+ [ orderSeq
+ inject: false
+ into: [:changed :seqId | (self updateJump: seqId) | changed]
+ ] whileTrue.
+
+ stream := (OrderedCollection new: 100) writeStream.
+ orderSeq do: [:seqId |
+ (instrMaps at: seqId) do: [:assoc |
+ assoc key "instr" bytecodeIndex: stream position + assoc value.
+ ].
+ stream nextPutAll: (seqCode at: seqId).
+ ].
+ ^self relativeJumpsToAbsoluteIn:stream contents
+
+ "Created: / 11-06-2008 / 14:00:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 11-06-2008 / 15:52:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!IRBytecodeGenerator class methodsFor:'documentation'!
+
+version
+ ^'$Id$'
+! !