"{ Package: 'stx:goodies/newcompiler' }"

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:'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'!

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>"

! !

!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: {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>"

!

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

    stack push.

    self 

        nextPut: #makeBlock;

        nextPut: nil "Number of block bytecodes. Patched later";

        nextPut: irClosure numVars;

        nextPut: irClosure numArgs.

                        interpret: irClosure;

                        getCode.

    "Patch number of closure bytecodes"

    "Created: / 30-03-2009 / 18:16:10 / 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.

        self 

            nextPut: #pushLitS;

            nextPut: (self addLiteral: object).

    "Modified: / 03-11-2008 / 14:32:04 / 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>"

!

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.

	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 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: / 02-12-2008 / 09:10:31 / 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: / 02-12-2008 / 09:10:37 / 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])).