diff -r de981640a2ec -r 0dd36941955f IRBytecodeGenerator.st --- /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 " +! ! + +!IRBytecodeGenerator methodsFor:'accessing default'! + +defaultStackCounter + + ^IRStackCount + + "Modified: / 11-06-2008 / 13:51:39 / Jan Vrany " +! ! + +!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 " +! + +numArgs: n + + numArgs := n + + "Modified: / 11-06-2008 / 14:39:46 / Jan Vrany " +! + +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 " +! + +popTop + + stack pop. + + self nextPut: #drop + + "Modified: / 11-06-2008 / 14:17:22 / Jan Vrany " +! + +pushDup + + stack push. + + self nextPut: #dup + + "Modified: / 11-06-2008 / 14:15:10 / Jan Vrany " +! + +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 " +! + +pushLiteral: object + + stack push. + + self + nextPut: #pushLit; + nextPut: (self addLiteral: object). + + "Modified: / 11-06-2008 / 14:04:41 / Jan Vrany " +! + +pushLiteralVariable: object + + stack push. + + self + nextPut: #pushGlobalS; + nextPut: (self addLiteral: object) + + "Modified: / 11-06-2008 / 14:13:42 / Jan Vrany " +! + +pushReceiver + + stack push. + + self nextPut: #pushSelf + + "Modified: / 11-06-2008 / 14:14:25 / Jan Vrany " +! + +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 " +! + +pushThisContext + + stack push. + + self nextPut: #pushThisContext + + "Modified: / 11-06-2008 / 14:31:32 / Jan Vrany " +! + +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 " +! + +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 " +! + +returnReceiver + + self saveLastJump: #return. + + code size = 0 ifTrue: [ + lastSpecialReturn := Message selector: #returnReceiver]. + + self nextPut: #retSelf + + "Modified: / 11-06-2008 / 14:29:31 / Jan Vrany " +! + +returnTop + + self saveLastJump: #return. + + self nextPut: #retTop + + "Modified: / 11-06-2008 / 14:04:55 / Jan Vrany " +! + +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 " +! + +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 " +! + +storeInstVar: index + + self + nextPut: #storeInstVar; + nextPut: index. + + "Modified: / 11-06-2008 / 14:49:52 / Jan Vrany " +! + +storeIntoLiteralVariable: object + + stack pop. + self + nextPut: #storeGlobalS; + nextPut: (self addLiteral: object) + + "Modified: / 11-06-2008 / 16:23:06 / Jan Vrany " +! + +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 " +! ! + +!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 " +! ! + +!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 " +! + +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 " +! + +addLiteral: object + + (literals includes: object) + ifFalse:[literals add: object]. + ^ literals identityIndexOf: object + + "Modified: / 11-06-2008 / 13:49:00 / Jan Vrany " +! + +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 " +! + +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 " +! + +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 " +! + +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 " +! + +jumpForward: distance + + + distance = 0 ifTrue: [^ self]. "no-op" + + self + nextPut:#jump; + nextPut:distance + + "Modified: / 11-06-2008 / 15:26:12 / Jan Vrany " +! + +newDummySeqId + + ^ Object new +! + +nextPut: byte + + code add: byte + + "Modified: / 11-06-2008 / 13:56:42 / Jan Vrany " +! + +saveLastJump: message + + jumps at: currentSeqId put: (Array with: code size with: message). + + "Modified: / 11-06-2008 / 15:40:39 / Jan Vrany " +! + +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 " +! ! + +!IRBytecodeGenerator methodsFor:'results'! + +bytecodes + + ^ByteCodeCompiler new + genByteCodeFrom: self symboliccodes; + code. + + "Modified: / 11-06-2008 / 14:01:32 / Jan Vrany " +! + +compiledMethod + + ^ self compiledMethodUsing: Method + + "Modified: / 11-06-2008 / 14:01:51 / Jan Vrany " +! + +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 " +! + +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 " +! + +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 " + "Modified: / 11-06-2008 / 15:52:33 / Jan Vrany " +! ! + +!IRBytecodeGenerator class methodsFor:'documentation'! + +version + ^'$Id$' +! !