Initial support for closures.
--- a/IRBuilder.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRBuilder.st Mon Mar 30 14:47:18 2009 +0000
@@ -1,7 +1,7 @@
"{ Package: 'stx:goodies/newcompiler' }"
Object subclass:#IRBuilder
- instanceVariableNames:'ir tempMap jumpBackTargetStacks jumpAheadStacks currentSequence
+ instanceVariableNames:'ir jumpBackTargetStacks jumpAheadStacks currentSequence
sourceMapNodes sourceMapByteIndex'
classVariableNames:''
poolDictionaries:''
@@ -40,16 +40,9 @@
addTemps: newKeys
- | keys i new |
- keys := ir tempKeys.
- i := keys size - 1. "zero-based (index 0 equals receiver)"
- new := OrderedCollection new.
- newKeys do: [:key |
- tempMap at: key ifAbsentPut: [
- new add: key.
- i := i + 1]
- ].
- ir tempKeys: keys, new.
+ ir addTemps: newKeys
+
+ "Modified: / 30-03-2009 / 11:15:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testJumpAheadTarget: label
@@ -68,7 +61,6 @@
initialize
ir := IRMethod new.
- tempMap := Dictionary new.
jumpAheadStacks := IdentityDictionary new.
jumpBackTargetStacks := IdentityDictionary new.
sourceMapNodes := OrderedCollection new. "stack"
@@ -78,7 +70,7 @@
currentSequence := (IRSequence new orderNumber:1) method:ir.
ir startSequence add:(IRJump new destination: currentSequence)
- "Modified: / 03-11-2008 / 11:52:48 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 11:18:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numRargs: n
@@ -168,11 +160,10 @@
self startNewSequence.
!
-line: line
+line:line
+ self add:(IRInstruction line:line)
- self add: (IRInstruction line: line)
-
- "Created: / 02-12-2008 / 09:00:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 28-03-2009 / 21:02:27 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
popTop
@@ -229,11 +220,11 @@
self add: (IRInstruction pushReceiver)
!
-pushTemp: key
+pushTemp:key
- | index |
- index := tempMap at: key.
- self add: (IRInstruction pushTemp: index)
+ self add: (ir pushTemp: key in: ir level: 0)
+
+ "Modified: / 30-03-2009 / 12:00:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushThisContext
@@ -297,11 +288,11 @@
self add: (IRInstruction storeIntoLiteralVariable: object)
!
-storeTemp: key
+storeTemp:key
- | index |
- index := tempMap at: key.
- self add: (IRInstruction storeTemp: index)
+ self add: (ir storeTemp: key in: ir level: 0)
+
+ "Modified: / 30-03-2009 / 12:00:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
storeThisEnv
@@ -376,8 +367,9 @@
!IRBuilder methodsFor:'results'!
ir
+ ^ ir
- ^ ir
+ "Modified: / 28-03-2009 / 21:01:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilder class methodsFor:'documentation'!
--- a/IRBuilderTest.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRBuilderTest.st Mon Mar 30 14:47:18 2009 +0000
@@ -26,6 +26,129 @@
^arg1 + arg2
"Created: / 02-12-2008 / 09:11:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+mock2
+
+ ^[ testSelector ]
+
+ "
+ decompiling IRBuilderTest>>mock2
+ nA: 0 nV: 0 nT: 2
+
+ 1: 37 04 00 00 makeBlock 4 (7) nv=0 na=0
+ 5: 5A pushInstVar1
+ 6: 00 retTop
+ 7: 08 03 LINE[3]
+ 9: 00 retTop
+ "
+
+ "Created: / 28-03-2009 / 18:47:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 28-03-2009 / 20:16:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+mock3
+ | b |
+ b := 1.
+ ^[ b ]
+
+ "
+ decompiling IRBuilderTest>>mock3
+ nA: 0 nV: 1 nT: 2
+
+ 1: 79 push1
+ 2: 64 storeMethodVar1
+ 3: 37 04 00 00 makeBlock 4 (9) nv=0 na=0
+ 7: 50 pushMethodVar1
+ 8: 00 retTop
+ 9: 08 04 LINE[4]
+ 11:00 retTop
+ "
+
+ "Created: / 28-03-2009 / 20:16:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+mock4
+
+ ^[:arg| arg ]
+
+ "
+ decompiling IRBuilderTest>>mock4
+ nA: 0 nV: 0 nT: 2
+
+ 1: 37 04 00 01 makeBlock 4 (7) nv=0 na=1
+ 5: 8C pushBlockArg1
+ 6: 00 retTop
+ 7: 08 03 LINE[3]
+ 9: 00 retTop
+
+
+
+ "
+
+ "Created: / 28-03-2009 / 20:18:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+mock5
+
+ ^[|temp| temp ]
+
+ "
+ decompiling IRBuilderTest>>mock5
+ nA: 0 nV: 0 nT: 2
+
+ 1: 37 04 01 00 makeBlock 4 (7) nv=1 na=0
+ 5: E8 pushBlockVar1
+ 6: 00 retTop
+ 7: 08 03 LINE[3]
+ 9: 00 retTop
+ "
+
+ "Created: / 28-03-2009 / 20:19:17 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+mock6
+
+ ^[|temp| [ temp ] ]
+
+ "
+ decompiling IRBuilderTest>>mock6
+ nA: 0 nV: 0 nT: 3
+
+ 1: 37 0B 01 00 makeBlock 11 (14) nv=1 na=0
+ 5: 37 06 00 00 makeBlock 6 (13) nv=0 na=0
+ 9: 80 01 01 pushOuterBlockVar 1 lvl: 1
+ 12:00 retTop
+ 13:00 retTop
+ 14:08 03 LINE[3]
+ 16:00 retTop
+
+ "
+
+ "Created: / 28-03-2009 / 20:20:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+mock7
+ | b |
+ b := 1.
+ ^[ ^b ]
+
+ "
+ decompiling IRBuilderTest>>mock7
+ nA: 0 nV: 1 nT: 2
+
+ 1: 79 push1
+ 2: 64 storeMethodVar1
+ 3: 37 06 00 00 makeBlock 6 (11) nv=0 na=0
+ 7: 50 pushMethodVar1
+ 8: 08 04 LINE[4]
+ 10:07 homeRetTop
+ 11:08 04 LINE[4]
+ 13:00 retTop
+
+ "
+
+ "Created: / 28-03-2009 / 20:21:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilderTest methodsFor:'testing'!
@@ -41,699 +164,598 @@
!
testDup
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: 3;
- pushDup;
-
- send: #=;
-
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = true).
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:3;
+ pushDup;
+ send:#'=';
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = true).
!
testInstVar
+ |aCompiledMethod irBuilder|
- | aCompiledMethod irBuilder |
- irBuilder := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushInstVar: 1;
- pushInstVar: 2;
- send: #+;
-
+ irBuilder := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushInstVar:1;
+ pushInstVar:2;
+ send:#'+';
returnTop;
ir.
-
- aCompiledMethod := irBuilder compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: (3@4) arguments: #() ) = 7).
+ aCompiledMethod := irBuilder compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:(3 @ 4) arguments:#()) = 7).
"Modified: / 11-06-2008 / 13:16:41 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testJumpAheadTo
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushTemp: #self ;
-
- jumpAheadTo: #end;
- pushLiteral: 3;
- jumpAheadTarget: #end;
-
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushTemp:#self;
+ jumpAheadTo:#end;
+ pushLiteral:3;
+ jumpAheadTarget:#end;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = nil).
!
testJumpAheadToIf
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushTemp: #self ;
- pushLiteral: true;
-
- "jumpAhaedTo pop the first element of thz stack"
- jumpAheadTo: #end if: true;
- pushLiteral: 3;
- jumpAheadTarget: #end;
-
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushTemp:#self;
+ pushLiteral:true;
+ jumpAheadTo:#end if:true;
+ pushLiteral:3;
+ jumpAheadTarget:#end;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = nil).
!
testJumpBackTo
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushTemp: #self ;
- pushLiteral: false;
- jumpBackTarget: #begin;
-
- "jumpAhaedTo pop the first element of the stack"
- jumpAheadTo: #end if: true;
- pushLiteral: true;
- jumpBackTo: #begin;
- jumpAheadTarget: #end;
-
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushTemp:#self;
+ pushLiteral:false;
+ jumpBackTarget:#begin;
+ jumpAheadTo:#end if:true;
+ pushLiteral:true;
+ jumpBackTo:#begin;
+ jumpAheadTarget:#end;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = nil).
!
testLine1
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- line: 5;
- pushLiteral: true;
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ line:5;
+ pushLiteral:true;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = true).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = true).
"Created: / 02-12-2008 / 09:11:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testLine2
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- line: 5;
- pushLiteral: true;
- pushLiteral: false;
- send: #&;
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ line:5;
+ pushLiteral:true;
+ pushLiteral:false;
+ send:#'&';
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = false).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = false).
"Created: / 02-12-2008 / 09:11:42 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testLiteralArray
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: #(test 4 you);
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = #(test 4 you)).
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:#( #test 4 #you );
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#())
+ = #( #test 4 #you )).
!
testLiteralBoolean
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: true;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = true).
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:true;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = true).
!
testLiteralCharacter
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: $e;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = $e).
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:$e;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = $e).
!
testLiteralFloat
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: 2.0;
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:2.0;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2.0).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = 2.0).
"Modified: / 03-11-2008 / 08:39:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testLiteralInteger
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: 2;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:2;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = 2).
!
testLiteralNil
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: nil;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: 4 arguments: #() ) = nil).
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:nil;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:4 arguments:#()) = nil).
!
testLiteralString
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: 'hello';
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 'hello').
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:'hello';
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = 'hello').
!
testLiteralSymbole
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: #you;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = #you).
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:#you;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = #you).
!
testLiteralVariableClass
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteralVariable: Object binding;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = Object).
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteralVariable:Object binding;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = Object).
!
testLiteralVariableClassVariable
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteralVariable: (ArithmeticValue bindingOf: #ArithmeticSignal);
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteralVariable:(ArithmeticValue bindingOf:#ArithmeticSignal);
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = ArithmeticValue arithmeticSignal).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#())
+ = ArithmeticValue arithmeticSignal).
"Modified: / 11-06-2008 / 11:31:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testLiteralVariableGlobale
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteralVariable: Smalltalk binding;
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteralVariable:Smalltalk binding;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = Smalltalk).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = Smalltalk).
"Modified: / 11-06-2008 / 11:32:07 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testPopTop
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: true ;
-
- pushLiteral: false;
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:true;
+ pushLiteral:false;
popTop;
-
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = true).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = true).
"Modified: / 11-06-2008 / 13:22:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testPushReceiver
+ |iRMethod aCompiledMethod receiver|
- | iRMethod aCompiledMethod receiver |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushReceiver;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- receiver := (5@8).
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: receiver arguments: #() ) == receiver).
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushReceiver;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ receiver := (5 @ 8).
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:receiver arguments:#())
+ == receiver).
!
testPushTempArgument
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 3;
- addTemps: #(self a b); "receiver and args declarations"
- pushTemp: #a;
- pushTemp: #b;
- send: #+;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #(2 8) ) = 10).
-
+ iRMethod := (IRBuilder new)
+ numRargs:3;
+ addTemps:#( #self #a #b );
+ pushTemp:#a;
+ pushTemp:#b;
+ send:#'+';
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:((aCompiledMethod valueWithReceiver:nil arguments:#( 2 8 )) = 10).
!
testPushTempSelf
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushTemp: #self;
- send: #class;
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) == UndefinedObject).
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushTemp:#self;
+ send:#class;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#())
+ == UndefinedObject).
!
testPushTempTemp
-
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self a); "receiver and args declarations"
-
- pushTemp: #a;
+ |iRMethod aCompiledMethod|
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: 5 arguments: #() ) = nil).
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self #a );
+ pushTemp:#a;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:5 arguments:#()) = nil).
!
testPushThisContext
-
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self a); "receiver and args declarations"
-
- pushThisContext;
- send: #receiver;
+ |iRMethod aCompiledMethod|
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: 5 arguments: #() ) = 5).
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self #a );
+ pushThisContext;
+ send:#receiver;
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:5 arguments:#()) = 5).
!
testPushThisEnv
-
- | iRMethod aCompiledMethod receiver |
-
- ^self.
-
+ |iRMethod aCompiledMethod receiver|
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
+ ^ self.
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
pushThisContext;
- pushLiteral: 5;
- pushLiteral: ClosureEnvironment;
- pushLiteral: 1;
- send: #new:;
- send: #privSetInstVar:put:;
+ pushLiteral:5;
+ pushLiteral:ClosureEnvironment;
+ pushLiteral:1;
+ send:#new:;
+ send:#privSetInstVar:put:;
pushThisEnv;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- receiver := Object new.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: receiver arguments: #()) isKindOf: ClosureEnvironment)
-
- "Modified: / 11-06-2008 / 14:47:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ aCompiledMethod := iRMethod compiledCode.
+ receiver := Object new.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:receiver arguments:#())
+ isKindOf:ClosureEnvironment)
!
testSendNumArgs1
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
pushReceiver;
- pushLiteral: 1;
- pushLiteral: 2;
- send: #mock1 numArgs:2;
+ pushLiteral:1;
+ pushLiteral:2;
+ send:#mock1 numArgs:2;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
- self class
- basicAddSelector: #mock1 withMethod: (self class >> #mock1:with:).
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: (aCompiledMethod valueWithReceiver: (IRBuilderTest new) arguments:#())
- = 3.
-
- self class
- basicRemoveSelector: #mock1.
+ aCompiledMethod := iRMethod compiledCode.
+ self class basicAddSelector:#mock1
+ withMethod:(self class >> #mock1:with:).
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ assert:(aCompiledMethod valueWithReceiver:(IRBuilderTest new)
+ arguments:#()) = 3.
+ self class basicRemoveSelector:#mock1.
"Created: / 01-12-2008 / 19:58:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testSendNumArgs2
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
pushReceiver;
- pushLiteral: 1;
- send: #mock1 numArgs:1;
+ pushLiteral:1;
+ send:#mock1 numArgs:1;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
- self class
- basicAddSelector: #mock1 withMethod: (self class >> #mock1:with:).
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self
- should: [(aCompiledMethod valueWithReceiver: (IRBuilderTest new) arguments:#())]
- raise: Error.
-
-
- self class
- basicRemoveSelector: #mock1.
+ aCompiledMethod := iRMethod compiledCode.
+ self class basicAddSelector:#mock1
+ withMethod:(self class >> #mock1:with:).
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ should:[
+ (aCompiledMethod valueWithReceiver:(IRBuilderTest new) arguments:#())
+ ]
+ raise:Error.
+ self class basicRemoveSelector:#mock1.
"Created: / 01-12-2008 / 19:59:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testSendSuper
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
pushReceiver;
- send: #halt toSuperOf: IRBuilderTest;
-
+ send:#halt toSuperOf:IRBuilderTest;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self should: [(aCompiledMethod valueWithReceiver: (IRBuilderTest new) arguments: #())] raise: Error.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self
+ should:[
+ (aCompiledMethod valueWithReceiver:(IRBuilderTest new) arguments:#())
+ ]
+ raise:Error.
"Modified: / 11-06-2008 / 16:09:12 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testStorIntoVariable
-
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
-
- pushLiteral: 4;
- storeIntoLiteralVariable: (IRBuilderTest bindingOf: #TestToPush);
+ |iRMethod aCompiledMethod|
- returnTop;
- ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- aCompiledMethod valueWithReceiver: nil arguments: #().
- self assert: (IRBuilderTest testToPush = 4).
- IRBuilderTest testToPush: nil.
-
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:4;
+ storeIntoLiteralVariable:(IRBuilderTest bindingOf:#TestToPush);
+ returnTop;
+ ir.
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ aCompiledMethod valueWithReceiver:nil arguments:#().
+ self assert:(IRBuilderTest testToPush = 4).
+ IRBuilderTest testToPush:nil.
!
testStoreTemp
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self a); "receiver and args declarations"
-
- pushLiteral: 34;
- storeTemp: #a;
- pushTemp: #a;
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self #a );
+ pushLiteral:34;
+ storeTemp:#a;
+ pushTemp:#a;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 34).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = 34).
"Modified: / 11-06-2008 / 16:24:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testStoreThisEnv
-
- | iRMethod aCompiledMethod |
-
- ^self.
+ |iRMethod aCompiledMethod|
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self a); "receiver and args declarations"
- pushLiteral: ClosureEnvironment;
- pushLiteral: 1;
- send: #new:;
+ ^ self.
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self #a );
+ pushLiteral:ClosureEnvironment;
+ pushLiteral:1;
+ send:#new:;
storeThisEnv;
pushThisContext;
- pushLiteral: 5;
- send: #privGetInstVar:;
+ pushLiteral:5;
+ send:#privGetInstVar:;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) isKindOf: ClosureEnvironment).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#())
+ isKindOf:ClosureEnvironment).
"Modified: / 11-06-2008 / 14:47:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testTwoJumpAheadToIfsToSameTarget
+ |iRMethod aCompiledMethod|
- | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushTemp: #self ;
- pushLiteral: false;
- jumpAheadTo: #end if: true;
- pushLiteral: true;
- jumpAheadTo: #end if: true;
- pushLiteral: 3;
- jumpAheadTarget: #end;
-
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushTemp:#self;
+ pushLiteral:false;
+ jumpAheadTo:#end if:true;
+ pushLiteral:true;
+ jumpAheadTo:#end if:true;
+ pushLiteral:3;
+ jumpAheadTarget:#end;
returnTop;
ir.
-
- aCompiledMethod := iRMethod compiledMethod.
-
- self assert: (aCompiledMethod isKindOf: CompiledMethod).
- self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
+ aCompiledMethod := iRMethod compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = nil).
"Created: / 03-11-2008 / 13:34:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
+!IRBuilderTest methodsFor:'testing - blocks'!
+
+testBlock_blockTempArg
+ |aCompiledMethod irBuilder|
+
+ irBuilder := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushBlockUsingBuilder:[:builder |
+ builder
+ numRargs:1;
+ addTemps:#( #barg1 );
+ pushTemp:#barg1;
+ returnTop
+ ];
+ pushLiteral:22;
+ send:#value:;
+ returnTop;
+ ir.
+ aCompiledMethod := irBuilder compiledCode.
+ self assert:(aCompiledMethod isKindOf:CompiledMethod).
+ self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = 22).
+
+ "Created: / 30-03-2009 / 14:26:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
!IRBuilderTest class methodsFor:'documentation'!
version
--- a/IRBytecodeGenerator.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRBytecodeGenerator.st Mon Mar 30 14:47:18 2009 +0000
@@ -3,7 +3,7 @@
Object subclass:#IRBytecodeGenerator
instanceVariableNames:'seqOrder orderSeq jumps literals lastLiteral currentSeqId
currentSeqNum lastSpecialReturn instrMaps instrMap maxTemp stacks
- stack primNum numArgs properties code seqCode lastLine'
+ stack primNum numArgs numVars properties code seqCode lastLine'
classVariableNames:'BytecodeTable Bytecodes SpecialConstants SpecialSelectors'
poolDictionaries:''
category:'NewCompiler-Bytecode'
@@ -53,6 +53,7 @@
maxTemp := 0.
primNum := 0.
numArgs := 0.
+ numVars := 0.
currentSeqNum := 0.
orderSeq := OrderedDictionary new. "reverse map of seqOrder"
lastLine := 0.
@@ -60,7 +61,7 @@
"starting label in case one is not provided by client"
self label: self newDummySeqId.
- "Modified: / 02-12-2008 / 09:08:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 13:52:44 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numArgs: n
@@ -208,6 +209,34 @@
"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.
@@ -217,24 +246,6 @@
"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.
@@ -353,18 +364,16 @@
"Modified: / 11-06-2008 / 16:23:06 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-storeTemp: index
+storeMethodVar: index
- stack pop.
- maxTemp := index max: maxTemp.
+ stack pop.
+ numVars := index max: numVars.
- index <= numArgs ifTrue:[self error:'Cannot store to method argument!!'].
+ self
+ nextPut:#storeMethodVar;
+ nextPut:index
- self
- nextPut:#storeMethodVar;
- nextPut:index - numArgs
-
- "Modified: / 11-06-2008 / 16:24:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Created: / 30-03-2009 / 13:57:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBytecodeGenerator methodsFor:'mapping'!
@@ -566,31 +575,22 @@
"Created: / 03-11-2008 / 14:20: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
-
+compiledCodeUsing:aCompiledMethodClass
"
- self symboliccodes
- "
-
- | bytecodesAndLiteralArray |
- bytecodesAndLiteralArray := self bytecodesAndLiteralArray.
+ self symboliccodes"
+
+ |bytecodesAndLiteralArray|
- ^(aCompiledMethodClass new: literals size)
- numberOfArgs: numArgs;
- numberOfVars: maxTemp - numArgs ;
- byteCode: bytecodesAndLiteralArray first;
- literals: bytecodesAndLiteralArray second asArray;
+ bytecodesAndLiteralArray := self bytecodesAndLiteralArray.
+ ^ (aCompiledMethodClass new:literals size)
+ numberOfArgs:numArgs;
+ numberOfVars:numVars;
+ byteCode:bytecodesAndLiteralArray first;
+ literals:bytecodesAndLiteralArray second asArray;
yourself
"Created: / 11-06-2008 / 14:02:03 / Jan Vrany <vranyj1@fel.cvut.cz>"
- "Modified: / 03-11-2008 / 14:22:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 13:53:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
literals
@@ -615,7 +615,9 @@
numTemps
- ^ maxTemp
+ ^ numArgs + numVars
+
+ "Modified: / 30-03-2009 / 13:53:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
relativeJumpsToAbsoluteIn: symbolicCode
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/IRClosure.st Mon Mar 30 14:47:18 2009 +0000
@@ -0,0 +1,55 @@
+"{ Package: 'stx:goodies/newcompiler' }"
+
+IRFunction subclass:#IRClosure
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'NewCompiler-IR'
+!
+
+
+!IRClosure methodsFor:'accessing'!
+
+environmentIr
+ ^ environmentIr
+!
+
+environmentIr:something
+ environmentIr := something.
+! !
+
+!IRClosure methodsFor:'accessing - defaults'!
+
+defaultCompiledCodeClass
+ "raise an error: must be redefined in concrete subclass(es)"
+
+ ^Block
+
+ "Modified: / 30-03-2009 / 16:36:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!IRClosure methodsFor:'instructions - helpers'!
+
+tempArgKindForLevel:level
+ "Superclass IRFunction says that I am responsible to implement this method"
+
+ self shouldImplement
+!
+
+tempVarKindForLevel:level
+ "Superclass IRFunction says that I am responsible to implement this method"
+
+ self shouldImplement
+! !
+
+!IRClosure methodsFor:'testing'!
+
+isIRClosure
+ ^ true
+! !
+
+!IRClosure class methodsFor:'documentation'!
+
+version
+ ^'$Id$'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/IRFunction.st Mon Mar 30 14:47:18 2009 +0000
@@ -0,0 +1,444 @@
+"{ Package: 'stx:goodies/newcompiler' }"
+
+Object subclass:#IRFunction
+ instanceVariableNames:'startSequence primitiveNode tempKeys tempMap numRargs properties
+ additionalLiterals maxOrderNumber sourceMap environmentIr
+ compiledCode'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'NewCompiler-IR'
+!
+
+
+!IRFunction methodsFor:'accessing'!
+
+addLiteral: aSymbol
+
+ additionalLiterals add: aSymbol.
+!
+
+addLiterals: anArray
+
+ additionalLiterals addAll: anArray.
+!
+
+addTemps: newKeys
+
+ | keys i new |
+ keys := self tempKeys.
+ i := keys size - 1. "zero-based (index 0 equals receiver)"
+ new := OrderedCollection new.
+ newKeys do:
+ [:key |
+ tempMap at: key ifAbsentPut:
+ [new add: key.
+ i := i + 1]].
+ self tempKeys: keys, new.
+
+ "Modified: / 30-03-2009 / 11:15:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+additionalLiterals
+ ^additionalLiterals.
+!
+
+allInstructions
+ " return irNodes as a flat collection "
+
+ | irInstructions |
+ irInstructions := OrderedCollection new.
+ startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | irInstructions add: bc]].
+ ^irInstructions
+!
+
+allInstructionsMatching: aBlock
+ " return irNodes as a flat collection "
+
+ | irInstructions |
+ irInstructions := OrderedCollection new.
+ startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | (aBlock value: bc) ifTrue: [irInstructions add: bc]]].
+ ^irInstructions
+!
+
+allSendInstructions
+ ^self allInstructionsMatching: [:bc | bc isSend].
+!
+
+allSequences
+
+ ^ startSequence withAllSuccessors
+!
+
+allTempAccessInstructions
+ ^self allInstructionsMatching: [:bc | bc isTempAccess].
+!
+
+allTempReadInstructions
+ ^self allInstructionsMatching: [:bc | bc isTempRead].
+!
+
+allTempWriteInstructions
+ ^self allInstructionsMatching: [:bc | bc isTempStore].
+!
+
+ir
+ ^self.
+!
+
+method
+ ^self.
+!
+
+numArgs
+
+ ^ self numRargs - 1
+!
+
+numRargs
+
+ ^ numRargs
+!
+
+primitiveNode
+
+ ^ primitiveNode
+!
+
+properties
+ ^properties
+!
+
+properties: propDict
+ properties := propDict.
+!
+
+startSequence
+
+ ^ startSequence
+!
+
+tempKeys
+
+ ^ tempKeys
+!
+
+tempMap
+ ^ tempMap
+!
+
+tempNames
+ "All temp names in context order"
+
+ | varNames |
+ varNames _ OrderedCollection new.
+ self tempKeys do: [:var | | name |
+ name _ var asString.
+ "vars are unique but inlined to:do: loop vars may have the same name, so munge the names to make them different"
+ [varNames includes: name] whileTrue: [name _ name, 'X'].
+ varNames add: name.
+ ].
+ ^ varNames asArray
+! !
+
+!IRFunction methodsFor:'accessing - defaults'!
+
+defaultCompiledCodeClass
+ "raise an error: must be redefined in concrete subclass(es)"
+
+ ^ self subclassResponsibility
+! !
+
+!IRFunction methodsFor:'debugging support'!
+
+inspector2TabIRCode
+
+ ^Tools::Inspector2Tab new
+ label: 'IR Code';
+ priority: 75;
+ view: ((ScrollableView for:TextView) contents: self longPrintString; yourself)
+
+ "Created: / 11-06-2008 / 01:05:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!IRFunction methodsFor:'decompiling'!
+
+ast
+
+ ^ IRDecompiler new decompileIR: self
+! !
+
+!IRFunction methodsFor:'initialize'!
+
+initialize
+
+ primitiveNode := PrimitiveNode primitiveNumber: 0.
+ tempKeys := OrderedCollection new.
+ tempMap := Dictionary new.
+ properties := Dictionary new.
+ additionalLiterals := OrderedCollection new.
+
+ "Modified: / 30-03-2009 / 11:16:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+numRargs: n
+
+ numRargs _ n
+!
+
+primitiveNode: aPrimitiveNode
+
+ primitiveNode _ aPrimitiveNode
+!
+
+startSequence: irSequence
+
+ startSequence _ irSequence.
+ irSequence method: self.
+!
+
+tempKeys: objects
+
+ tempKeys _ objects
+! !
+
+!IRFunction methodsFor:'inlining'!
+
+addInstructionsAfter: aCollection
+ | returningSeqs lastInstr |
+ aCollection ifEmpty: [^self].
+ returningSeqs := self allSequences select: [:each | each last isReturn].
+ lastInstr := returningSeqs last last.
+ lastInstr addInstructionsBefore: aCollection.
+
+!
+
+addInstructionsBefore: aCollection
+
+ (self startSequence nextSequence first) addInstructionsBefore: aCollection.
+
+!
+
+methodForInlining
+ ^self removeReturnSelf removeEmptyStart.
+!
+
+removeReturn
+ self allSequences last removeLast.
+!
+
+removeReturnSelf
+ self removeReturn.
+ self allSequences last removeLast.
+! !
+
+!IRFunction methodsFor:'instructions - helpers'!
+
+pushTemp: tempName in: irFunction level: level
+
+ | index kind |
+ index := tempMap
+ at: tempName
+ ifAbsent:
+ [environmentIr
+ ifNil:[self error:'No such temp: ', tempName]
+ ifNotNil:[^environmentIr pushTemp: tempName in: irFunction level: level + 1]].
+ kind := (index <= self numArgs)
+ ifTrue: [self tempArgKindForLevel: level]
+ ifFalse:[index := index - self numArgs.self tempVarKindForLevel: level].
+ ^IRInstruction pushTemp: index kind: kind level: level
+
+ "Created: / 30-03-2009 / 11:54:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 13:59:14 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+storeTemp: tempName in: irFunction level: level
+
+ | index kind |
+ index := tempMap
+ at: tempName
+ ifAbsent:
+ [environmentIr
+ ifNil:[self error:'No such temp: ', tempName]
+ ifNotNil:[^environmentIr storeTemp: tempName in: irFunction level: level + 1]].
+ kind := (index <= self numArgs)
+ ifTrue: [self tempArgKindForLevel: level]
+ ifFalse:[index := index - self numArgs.self tempVarKindForLevel: level].
+ ^IRInstruction storeTemp: index kind: kind level: level
+
+ "Created: / 30-03-2009 / 11:57:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 13:59:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+tempArgKindForLevel: level
+
+ ^self subclassResponsibility
+
+ "Created: / 30-03-2009 / 11:58:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+tempVarKindForLevel: level
+
+ ^self subclassResponsibility
+
+ "Created: / 30-03-2009 / 11:58:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!IRFunction methodsFor:'mapping'!
+
+sourceMap
+ "Return a mapping from bytecode pcs to source code ranges"
+
+ |start map|
+
+ "Besides getting start position, make sure bytecodeIndices are filled in"
+ start := self compiledCode initialPC - 1.
+ map := OrderedCollection new.
+ self allSequences do:[:seq |
+ seq do:[:instr |
+ |node|
+
+ ((node := instr sourceNode) notNil
+ and:[
+ node debugHighlightStart notNil
+ and:[ node debugHighlightStop notNil and:[ instr bytecodeIndex notNil ] ]
+ ])
+ ifTrue:[
+ map add:instr bytecodeIndex + start
+ -> (node debugHighlightStart to:node debugHighlightStop)
+ ]
+ ]
+ ].
+ ^ map
+! !
+
+!IRFunction methodsFor:'optimizing'!
+
+absorbConstantConditionalJumps
+
+ startSequence absorbConstantConditionalJumps: IdentitySet new
+!
+
+absorbJumpsToSingleInstrs
+
+ startSequence absorbJumpToSingleInstr: IdentitySet new
+!
+
+absorbSinglePredecessor
+ | predecessor |
+ startSequence
+ detectSinglePredecessor: (predecessor := IdentityDictionary new)
+ seen: IdentitySet new.
+ startSequence collapseSinglePredecessor: predecessor seen: IdentitySet new
+!
+
+maxOrderNumber
+ maxOrderNumber ifNil: [
+ maxOrderNumber := self startSequence orderNumber.
+ self startSequence withAllSuccessorsDo: [:seq | maxOrderNumber := maxOrderNumber max: seq orderNumber].
+ ].
+ ^ maxOrderNumber.
+!
+
+newSeq
+ maxOrderNumber _ self maxOrderNumber +1.
+ ^ IRSequence new orderNumber:maxOrderNumber
+!
+
+optimize
+ self removeEmptyStart.
+ self absorbJumpsToSingleInstrs.
+ self absorbConstantConditionalJumps.
+ self absorbJumpsToSingleInstrs
+!
+
+removeEmptyStart
+
+ startSequence size = 1 ifTrue: [
+ "startSeq is just unconditional jump, forget it"
+ startSequence _ startSequence last destination].
+! !
+
+!IRFunction methodsFor:'printing'!
+
+longPrintOn: stream
+
+ IRPrinter new
+ indent: 0;
+ stream: stream;
+ interpret: self
+!
+
+longPrintString
+
+ | s |
+ s := String new writeStream.
+ self longPrintOn: s.
+ ^s contents.
+
+ "Created: / 11-06-2008 / 01:05:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!IRFunction methodsFor:'testing'!
+
+isIRClosure
+ ^ false
+!
+
+isIRMethod
+ ^ false
+!
+
+isSend
+ ^false.
+! !
+
+!IRFunction methodsFor:'translating'!
+
+bytecodes
+
+ ^ compiledCode
+ ifNotNil:
+ [compiledCode byteCode]
+ ifNil:
+ [IRTranslator new
+ interpret: self;
+ bytecodes]
+
+ "Created: / 03-11-2008 / 08:38:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+compiledCode
+ ^ compiledCode
+ ifNil:[ self compiledCodeUsing:self defaultCompiledCodeClass ]
+
+ "Created: / 30-03-2009 / 16:34:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+compiledCodeUsing:aCompiledCodeClass
+ ^ compiledCode := (IRTranslator new)
+ interpret:self;
+ compiledCodeUsing:aCompiledCodeClass
+
+ "Created: / 11-06-2008 / 11:06:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+literals
+
+ ^(IRTranslator new
+ interpret: self;
+ literals)
+
+ "Created: / 03-11-2008 / 09:08:23 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+setCompiledCode:aCompiledCode
+ compiledCode := aCompiledCode
+
+ "Created: / 11-06-2008 / 11:05:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
+!IRFunction class methodsFor:'documentation'!
+
+version
+ ^'$Id$'
+! !
--- a/IRInstVarAccess.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRInstVarAccess.st Mon Mar 30 14:47:18 2009 +0000
@@ -18,8 +18,12 @@
!
varname
- name ifNil: [name := self method compiledMethod methodClass allInstVarNames at: self offset].
- ^name.
+ name
+ ifNil:[
+ name := self method compiledCode methodClass allInstVarNames
+ at:self offset
+ ].
+ ^ name.
! !
!IRInstVarAccess class methodsFor:'documentation'!
--- a/IRInstruction.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRInstruction.st Mon Mar 30 14:47:18 2009 +0000
@@ -82,17 +82,44 @@
!
pushReceiver
- ^IRInstruction pushTemp: 0
+ ^IRInstruction pushTemp: 0 kind: #Special
+
+ "Modified: / 30-03-2009 / 14:08:49 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushTemp: index
- ^ IRTempRead new
- number: index.
+ <resource: #obsolete>
+ self obsoleteMethodWarning:'Use pushTemp:kind: instead'.
+
+ ^ IRTempRead new
+ number: index.
+
+ "Modified: / 30-03-2009 / 11:51:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+pushTemp: index kind: kind
+
+ ^ self pushTemp: index kind: kind level: 0
+
+ "Created: / 30-03-2009 / 14:09:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+pushTemp: index kind: kind level: level
+
+ ^ IRTempRead new
+ number: index;
+ kind: kind;
+ level: level;
+ yourself
+
+ "Created: / 30-03-2009 / 13:58:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushThisContext
- ^IRInstruction pushTemp: -2
+ ^IRInstruction pushTemp: -2 kind: #Special
+
+ "Modified: / 30-03-2009 / 14:08:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
remoteReturn
@@ -155,8 +182,24 @@
storeTemp: index
- ^ IRTempStore new
- number: index.
+ <resource: #obsolete>
+ self obsoleteMethodWarning:'Use storeTemp:kind: instead'.
+
+ ^ IRTempStore new
+ number: index.
+
+ "Modified: / 30-03-2009 / 11:52:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+storeTemp: index kind: kind level: level
+
+ ^ IRTempStore new
+ number: index;
+ kind: kind;
+ level: level;
+ yourself
+
+ "Created: / 30-03-2009 / 13:59:39 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRInstruction class methodsFor:'instance creation - old style blocks'!
@@ -224,10 +267,11 @@
!
bytecodeOffset
- | startpc |
- startpc := self method compiledMethod initialPC.
- self bytecodeIndex ifNil: [^startpc].
- ^self bytecodeIndex + startpc - 1.
+ |startpc|
+
+ startpc := self method compiledCode initialPC.
+ self bytecodeIndex ifNil:[ ^ startpc ].
+ ^ self bytecodeIndex + startpc - 1.
!
sourceNode
--- a/IRInterpreter.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRInterpreter.st Mon Mar 30 14:47:18 2009 +0000
@@ -54,7 +54,9 @@
pushLiteralVariable: object
!
-pushTemp: index
+pushTemp: index kind: kind level: level
+
+ "Created: / 30-03-2009 / 14:02:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
remoteReturn
@@ -76,7 +78,9 @@
storeLiteralVariable: index
!
-storeTemp: index
+storeTemp: index kind: kind level: level
+
+ "Created: / 30-03-2009 / 14:05:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRInterpreter methodsFor:'interpret'!
--- a/IRMethod.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRMethod.st Mon Mar 30 14:47:18 2009 +0000
@@ -1,8 +1,7 @@
"{ Package: 'stx:goodies/newcompiler' }"
-Object subclass:#IRMethod
- instanceVariableNames:'startSequence primitiveNode tempKeys numRargs compiledMethod
- properties additionalLiterals maxOrderNumber sourceMap'
+IRFunction subclass:#IRMethod
+ instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'NewCompiler-IR'
@@ -20,343 +19,32 @@
"Created: / 11-06-2008 / 00:52:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
-!IRMethod methodsFor:'accessing'!
-
-addLiteral: aSymbol
-
- additionalLiterals add: aSymbol.
-!
-
-addLiterals: anArray
-
- additionalLiterals addAll: anArray.
-!
-
-addTemps: newKeys
-
- tempKeys addAll: newKeys.
-!
-
-additionalLiterals
- ^additionalLiterals.
-!
-
-allInstructions
- " return irNodes as a flat collection "
-
- | irInstructions |
- irInstructions := OrderedCollection new.
- startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | irInstructions add: bc]].
- ^irInstructions
-!
-
-allInstructionsMatching: aBlock
- " return irNodes as a flat collection "
-
- | irInstructions |
- irInstructions := OrderedCollection new.
- startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | (aBlock value: bc) ifTrue: [irInstructions add: bc]]].
- ^irInstructions
-!
-
-allSendInstructions
- ^self allInstructionsMatching: [:bc | bc isSend].
-!
-
-allSequences
-
- ^ startSequence withAllSuccessors
-!
-
-allTempAccessInstructions
- ^self allInstructionsMatching: [:bc | bc isTempAccess].
-!
-
-allTempReadInstructions
- ^self allInstructionsMatching: [:bc | bc isTempRead].
-!
-
-allTempWriteInstructions
- ^self allInstructionsMatching: [:bc | bc isTempStore].
-!
-
-ir
- ^self.
-!
+!IRMethod methodsFor:'accessing - defaults'!
-method
- ^self.
-!
-
-numArgs
-
- ^ self numRargs - 1
-!
-
-numRargs
-
- ^ numRargs
-!
-
-primitiveNode
-
- ^ primitiveNode
-!
-
-properties
- ^properties
-!
-
-properties: propDict
- properties := propDict.
-!
-
-startSequence
-
- ^ startSequence
-!
-
-tempKeys
-
- ^ tempKeys
-!
-
-tempNames
- "All temp names in context order"
-
- | varNames |
- varNames _ OrderedCollection new.
- self tempKeys do: [:var | | name |
- name _ var asString.
- "vars are unique but inlined to:do: loop vars may have the same name, so munge the names to make them different"
- [varNames includes: name] whileTrue: [name _ name, 'X'].
- varNames add: name.
- ].
- ^ varNames asArray
-! !
-
-!IRMethod methodsFor:'debugging support'!
-
-inspector2TabIRCode
-
- ^Tools::Inspector2Tab new
- label: 'IR Code';
- priority: 75;
- view: ((ScrollableView for:TextView) contents: self longPrintString; yourself)
-
- "Created: / 11-06-2008 / 01:05:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
-! !
-
-!IRMethod methodsFor:'decompiling'!
-
-ast
-
- ^ IRDecompiler new decompileIR: self
+defaultCompiledCodeClass
+ ^ Method
! !
-!IRMethod methodsFor:'initialize'!
-
-initialize
-
- primitiveNode := PrimitiveNode primitiveNumber: 0.
- tempKeys := OrderedCollection new.
- properties := Dictionary new.
- additionalLiterals := OrderedCollection new.
-
- "Modified: / 11-06-2008 / 00:55:19 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
-numRargs: n
+!IRMethod methodsFor:'instructions - helpers'!
- numRargs _ n
-!
-
-primitiveNode: aPrimitiveNode
-
- primitiveNode _ aPrimitiveNode
-!
-
-startSequence: irSequence
-
- startSequence _ irSequence.
- irSequence method: self.
-!
+tempArgKindForLevel:level
-tempKeys: objects
-
- tempKeys _ objects
-! !
-
-!IRMethod methodsFor:'inlining'!
+ ^#MArg
-addInstructionsAfter: aCollection
- | returningSeqs lastInstr |
- aCollection ifEmpty: [^self].
- returningSeqs := self allSequences select: [:each | each last isReturn].
- lastInstr := returningSeqs last last.
- lastInstr addInstructionsBefore: aCollection.
-
-!
-
-addInstructionsBefore: aCollection
-
- (self startSequence nextSequence first) addInstructionsBefore: aCollection.
-
-!
-
-methodForInlining
- ^self removeReturnSelf removeEmptyStart.
-!
-
-removeReturn
- self allSequences last removeLast.
+ "Modified: / 30-03-2009 / 11:58:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-removeReturnSelf
- self removeReturn.
- self allSequences last removeLast.
-! !
-
-!IRMethod methodsFor:'mapping'!
-
-sourceMap
- "Return a mapping from bytecode pcs to source code ranges"
-
- | start map |
- "Besides getting start position, make sure bytecodeIndices are filled in"
- start _ self compiledMethod initialPC - 1.
- map _ OrderedCollection new.
- self allSequences do: [:seq |
- seq do: [:instr | | node |
- ((node _ instr sourceNode) notNil and:
- [node debugHighlightStart notNil and:
- [node debugHighlightStop notNil and:
- [instr bytecodeIndex notNil]]]) ifTrue: [
- map add:
- instr bytecodeIndex + start
- -> (node debugHighlightStart to: node debugHighlightStop)]
- ]
- ].
- ^ map
-! !
-
-!IRMethod methodsFor:'optimizing'!
-
-absorbConstantConditionalJumps
-
- startSequence absorbConstantConditionalJumps: IdentitySet new
-!
-
-absorbJumpsToSingleInstrs
-
- startSequence absorbJumpToSingleInstr: IdentitySet new
-!
+tempVarKindForLevel:level
-absorbSinglePredecessor
- | predecessor |
- startSequence
- detectSinglePredecessor: (predecessor := IdentityDictionary new)
- seen: IdentitySet new.
- startSequence collapseSinglePredecessor: predecessor seen: IdentitySet new
-!
-
-maxOrderNumber
- maxOrderNumber ifNil: [
- maxOrderNumber := self startSequence orderNumber.
- self startSequence withAllSuccessorsDo: [:seq | maxOrderNumber := maxOrderNumber max: seq orderNumber].
- ].
- ^ maxOrderNumber.
-!
-
-newSeq
- maxOrderNumber _ self maxOrderNumber +1.
- ^ IRSequence new orderNumber:maxOrderNumber
-!
+ ^#MVar
-optimize
- self removeEmptyStart.
- self absorbJumpsToSingleInstrs.
- self absorbConstantConditionalJumps.
- self absorbJumpsToSingleInstrs
-!
-
-removeEmptyStart
-
- startSequence size = 1 ifTrue: [
- "startSeq is just unconditional jump, forget it"
- startSequence _ startSequence last destination].
-! !
-
-!IRMethod methodsFor:'printing'!
-
-longPrintOn: stream
-
- IRPrinter new
- indent: 0;
- stream: stream;
- interpret: self
-!
-
-longPrintString
-
- | s |
- s := String new writeStream.
- self longPrintOn: s.
- ^s contents.
-
- "Created: / 11-06-2008 / 01:05:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 11:59:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRMethod methodsFor:'testing'!
-isSend
- ^false.
-! !
-
-!IRMethod methodsFor:'translating'!
-
-bytecodes
-
- ^ compiledMethod
- ifNotNil:
- [compiledMethod byteCode]
- ifNil:
- [IRTranslator new
- interpret: self;
- bytecodes]
-
- "Created: / 03-11-2008 / 08:38:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
-compiledMethod
-
- ^ compiledMethod ifNil: [self compiledMethodUsing: Method]
-
- "Modified: / 11-06-2008 / 11:06:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
-compiledMethodUsing: aCompiledMethodClass
-
- ^ compiledMethod := IRTranslator new
- interpret: self;
- compiledMethodUsing: aCompiledMethodClass
-
- "Created: / 11-06-2008 / 11:06:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
-literals
-
- ^(IRTranslator new
- interpret: self;
- literals)
-
- "Created: / 03-11-2008 / 09:08:23 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
-setCompiledMethod:aCompiledMethod
- compiledMethod := aCompiledMethod
-
- "Created: / 11-06-2008 / 11:05:57 / Jan Vrany <vranyj1@fel.cvut.cz>"
+isIRMethod
+ ^ true
! !
!IRMethod class methodsFor:'documentation'!
--- a/IRPrinter.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRPrinter.st Mon Mar 30 14:47:18 2009 +0000
@@ -125,13 +125,23 @@
object printOn: stream.
!
-pushTemp: index
+pushTemp: index kind: kind level: level
- stream nextPutAll: 'pushTemp: '.
- index printOn: stream.
- index = 0 ifTrue: [stream nextPutAll: ' "receiver"'].
- index = -1 ifTrue: [stream nextPutAll: ' "thisEnv"'].
- index = -2 ifTrue: [stream nextPutAll: ' "thisContext"'].
+ stream
+ nextPutAll: 'push ';
+ nextPutAll: kind;
+ nextPutAll: ': '.
+ index printOn: stream.
+ level == 0 ifFalse:
+ [stream
+ nextPutAll:' level: '.
+ level printOn: stream].
+
+ index = 0 ifTrue: [stream nextPutAll: ' "receiver"'].
+ index = -1 ifTrue: [stream nextPutAll: ' "thisEnv"'].
+ index = -2 ifTrue: [stream nextPutAll: ' "thisContext"'].
+
+ "Created: / 30-03-2009 / 14:04:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
remoteReturn
@@ -166,11 +176,21 @@
"Created: / 01-12-2008 / 19:46:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-storeTemp: index
+storeTemp: index kind: kind level: level
- stream nextPutAll: 'storeTemp: '.
- index printOn: stream.
- index = -1 ifTrue: [stream nextPutAll: ' "thisEnv"'].
+ stream
+ nextPutAll: 'store ';
+ nextPutAll: kind;
+ nextPutAll: ': '.
+ index printOn: stream.
+ level == 0 ifFalse:
+ [stream
+ nextPutAll:' level: '.
+ level printOn: stream].
+
+ index = -1 ifTrue: [stream nextPutAll: ' "thisEnv"'].
+
+ "Created: / 30-03-2009 / 14:05:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRPrinter methodsFor:'interpret'!
--- a/IRTempAccess.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRTempAccess.st Mon Mar 30 14:47:18 2009 +0000
@@ -1,13 +1,39 @@
"{ Package: 'stx:goodies/newcompiler' }"
IRAccess subclass:#IRTempAccess
- instanceVariableNames:''
+ instanceVariableNames:'kind level'
classVariableNames:''
poolDictionaries:''
category:'NewCompiler-IR'
!
+!IRTempAccess methodsFor:'accessing'!
+
+kind
+ ^ kind
+
+ "Modified: / 28-03-2009 / 20:50:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+kind:aSymbol
+
+ self
+ assert:(#(MArg MVar BArg BVar OBArg OBVar Special) includes: aSymbol).
+
+ kind := aSymbol.
+
+ "Modified: / 30-03-2009 / 14:08:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+level
+ ^ level
+!
+
+level:aNumber
+ level := aNumber.
+! !
+
!IRTempAccess methodsFor:'testing'!
isSelf
--- a/IRTempRead.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRTempRead.st Mon Mar 30 14:47:18 2009 +0000
@@ -11,7 +11,9 @@
!IRTempRead methodsFor:'interpret'!
executeOn: interpreter
- interpreter pushTemp: number.
+ interpreter pushTemp: number kind: kind level: level
+
+ "Modified: / 30-03-2009 / 14:02:08 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRTempRead methodsFor:'testing'!
--- a/IRTempStore.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRTempStore.st Mon Mar 30 14:47:18 2009 +0000
@@ -10,9 +10,10 @@
!IRTempStore methodsFor:'interpret'!
-executeOn: interpreter
- interpreter storeTemp: number.
-
+executeOn: interpreter
+ interpreter storeTemp: number kind: kind level: level
+
+ "Modified: / 30-03-2009 / 14:17:59 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRTempStore methodsFor:'testing'!
--- a/IRTransformTest.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRTransformTest.st Mon Mar 30 14:47:18 2009 +0000
@@ -11,53 +11,38 @@
!IRTransformTest methodsFor:'testing'!
testAdd
-
- | iRMethod aCompiledMethod |
-
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: 1;
- returnTop;
- ir.
+ |iRMethod aCompiledMethod|
- (iRMethod allSequences last) last delete.
- (iRMethod allSequences last) last delete.
-
- (iRMethod allSequences last)
- add: (IRInstruction pushLiteral: 2).
-
- (iRMethod allSequences last)
- add: (IRInstruction returnTop).
-
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:1;
+ returnTop;
+ ir.
+ (iRMethod allSequences last) last delete.
+ (iRMethod allSequences last) last delete.
+ (iRMethod allSequences last) add:(IRInstruction pushLiteral:2).
+ (iRMethod allSequences last) add:(IRInstruction returnTop).
+ aCompiledMethod := iRMethod compiledCode.
+ self should:[ (aCompiledMethod valueWithReceiver:nil arguments:#()) = 2 ].
!
testAddBefore
-
- | iRMethod aCompiledMethod ret |
-
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: 1;
- returnTop;
- ir.
+ |iRMethod aCompiledMethod ret|
- (iRMethod allSequences last) last delete.
- (iRMethod allSequences last) last delete.
-
- ret := (IRInstruction returnTop).
-
- (iRMethod allSequences last)
- add: ret.
-
- (iRMethod allSequences last)
- add: (IRInstruction pushLiteral: 2) before: ret.
-
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:1;
+ returnTop;
+ ir.
+ (iRMethod allSequences last) last delete.
+ (iRMethod allSequences last) last delete.
+ ret := (IRInstruction returnTop).
+ (iRMethod allSequences last) add:ret.
+ (iRMethod allSequences last) add:(IRInstruction pushLiteral:2) before:ret.
+ aCompiledMethod := iRMethod compiledCode.
+ self should:[ (aCompiledMethod valueWithReceiver:nil arguments:#()) = 2 ].
!
testAddIntructions
@@ -102,66 +87,53 @@
!
testAddIntructionsBeforeFromLList
-
- | iRMethod aCompiledMethod push llist col |
-
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: 1;
- returnTop;
- ir.
-
- push := (iRMethod allSequences last) at: (iRMethod allSequences size - 1) .
+ |iRMethod aCompiledMethod push llist col|
- llist := LinkedList new.
- llist add: (IRInstruction pushLiteral: 2).
- llist add: (IRInstruction returnTop).
-
- col := llist asOrderedCollection.
-
- (iRMethod allSequences last)
- addInstructions: col before: push.
-
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:1;
+ returnTop;
+ ir.
+ push := (iRMethod allSequences last) at:(iRMethod allSequences size - 1).
+ llist := LinkedList new.
+ llist add:(IRInstruction pushLiteral:2).
+ llist add:(IRInstruction returnTop).
+ col := llist asOrderedCollection.
+ (iRMethod allSequences last) addInstructions:col before:push.
+ aCompiledMethod := iRMethod compiledCode.
+ self should:[ (aCompiledMethod valueWithReceiver:nil arguments:#()) = 2 ].
!
testDelete
-
- | iRMethod aCompiledMethod |
+ |iRMethod aCompiledMethod|
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: 1;
- pushLiteral: 2;
- returnTop;
- ir.
-
- ((iRMethod allSequences last)
- detect: [:each | each isConstant: [:c | c == 2]]) delete.
-
-
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 1].
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:1;
+ pushLiteral:2;
+ returnTop;
+ ir.
+ ((iRMethod allSequences last)
+ detect:[:each | each isConstant:[:c | c == 2 ] ]) delete.
+ aCompiledMethod := iRMethod compiledCode.
+ self should:[ (aCompiledMethod valueWithReceiver:nil arguments:#()) = 1 ].
!
testReplace
- | iRMethod aCompiledMethod |
-
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: 1;
- returnTop;
- ir.
-
- (iRMethod allSequences last at: 1)
- replaceWith: (IRInstruction pushLiteral: 2).
+ |iRMethod aCompiledMethod|
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+ iRMethod := (IRBuilder new)
+ numRargs:1;
+ addTemps:#( #self );
+ pushLiteral:1;
+ returnTop;
+ ir.
+ (iRMethod allSequences last at:1)
+ replaceWith:(IRInstruction pushLiteral:2).
+ aCompiledMethod := iRMethod compiledCode.
+ self should:[ (aCompiledMethod valueWithReceiver:nil arguments:#()) = 2 ].
!
testReplaceInstr
--- a/IRTranslator.st Wed Feb 25 16:49:21 2009 +0000
+++ b/IRTranslator.st Mon Mar 30 14:47:18 2009 +0000
@@ -1,7 +1,7 @@
"{ Package: 'stx:goodies/newcompiler' }"
IRInterpreter subclass:#IRTranslator
- instanceVariableNames:'pending gen currentInstr trailerBytes'
+ instanceVariableNames:'pending gen currentInstr'
classVariableNames:''
poolDictionaries:''
category:'NewCompiler-IR'
@@ -26,13 +26,6 @@
gen := IRBytecodeGenerator new
"Modified: / 17-09-2008 / 12:19:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
-trailer: bytes
-
- trailerBytes := bytes
-
- "Modified: / 17-09-2008 / 12:20:00 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRTranslator methodsFor:'instructions'!
@@ -97,21 +90,31 @@
pushBlock: irMethod
+ self shouldImplement
+
+ "
| meth block |
meth := irMethod compiledMethodWith: trailerBytes.
meth isBlockMethod: true.
block := meth createBlock: nil.
self addPending: (Message selector: #pushLiteral: argument: block)
+ "
- "Modified: / 17-09-2008 / 12:19:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 28-03-2009 / 20:34:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushBlockMethod: irMethod
- | meth |
- meth _ irMethod compiledMethodWith: trailerBytes.
- meth isBlockMethod: true.
- self addPending: (Message selector: #pushLiteral: argument: meth)
+ self shouldImplement
+
+ "
+ | meth |
+ meth _ irMethod compiledMethodWith: trailerBytes.
+ meth isBlockMethod: true.
+ self addPending: (Message selector: #pushLiteral: argument: meth)
+ "
+
+ "Modified: / 28-03-2009 / 20:34:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushDup
@@ -137,23 +140,31 @@
self addPending: (Message selector: #pushLiteralVariable: argument: object)
!
-pushTemp: index
+pushTemp: index kind: kind level: level
- index = 0 ifTrue: [^ self addPending: (Message selector: #pushReceiver)].
+ index = 0 ifTrue: [^ self addPending: (Message selector: #pushReceiver)].
- (self pendingMatches: {
- [:m | m selector == #storePopTemp: and: [m argument = index]]}
- ) ifTrue: [^ self pendingSelector: #storeTemp:].
+ (self pendingMatches: (Array with:
+ [:m | m selector == #storePopTemp: and: [m argument = index]])
+ ) ifTrue: [^ self pendingSelector: #storeTemp:].
+
+ self doPending.
- self doPending.
+ index = -2 ifTrue: [^ gen pushThisContext].
+ index = -1 ifTrue: [
+ self halt:'Not supported'
+ "
+ ^ gen pushThisContext;
+ pushLiteral: MethodContext myEnvFieldIndex;
+ send: #privGetInstVar:"].
- index = -2 ifTrue: [^ gen pushThisContext].
- index = -1 ifTrue: [
- ^ gen pushThisContext;
- pushLiteral: MethodContext myEnvFieldIndex;
- send: #privGetInstVar:].
+ "Bad bad bad!! Type switch"
+ kind == #MArg ifTrue:[^gen pushMethodArg: index].
+ kind == #MVar ifTrue:[^gen pushMethodVar: index].
- gen pushTemp: index.
+ self halt:'Should never be reached'.
+
+ "Created: / 30-03-2009 / 14:06:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
remoteReturn
@@ -234,15 +245,20 @@
self addPending: (Message selector: #storeIntoLiteralVariable: argument: assoc)
!
-storeTemp: index
+storeTemp: index kind: kind level: level
- index = -1 "thisEnv" ifTrue: [
- self doPending.
- ^ gen pushThisContext;
- pushLiteral: MethodContext myEnvFieldIndex;
- send: #privStoreIn:instVar:].
+ index = -1 "thisEnv" ifTrue: [
+ self halt:'Not supported'
+ "
+ self doPending.
+ ^ gen pushThisContext;
+ pushLiteral: MethodContext myEnvFieldIndex;
+ send: #privStoreIn:instVar:"].
- self addPending: (Message selector: #storeTemp: argument: index)
+ kind == #MArg ifTrue:[^self error:'Cannot store to method argument!!'].
+ kind == #MVar ifTrue:[^self addPending: (Message selector: #storeMethodVar: argument: index)].
+
+ "Created: / 30-03-2009 / 14:07:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRTranslator methodsFor:'interpret'!
@@ -279,15 +295,17 @@
!
doPending
- "execute pending instructions"
+ "execute pending instructions"
- | assoc |
- [pending isEmpty] whileFalse: [
- assoc _ pending removeFirst.
- gen mapBytesTo: assoc key "instr".
- assoc value "message" sendTo: gen.
- ].
- gen mapBytesTo: currentInstr.
+ | assoc |
+ [pending isEmpty] whileFalse: [
+ assoc := pending removeFirst.
+ gen mapBytesTo: assoc key "instr".
+ assoc value "message" sendTo: gen.
+ ].
+ gen mapBytesTo: currentInstr.
+
+ "Modified: / 28-03-2009 / 20:33:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pendingMatches: blocks
@@ -328,20 +346,18 @@
"Created: / 03-11-2008 / 09:23:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-compiledMethod
+compiledCodeUsing:aCompiledMethodClass
+ ^ gen compiledCodeUsing:aCompiledMethodClass
- ^ gen compiledMethod
+ "Modified: / 17-09-2008 / 12:18:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+compiledMethod
+ ^ gen compiledCode
"Modified: / 03-11-2008 / 09:22:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-compiledMethodUsing: aCompiledMethodClass
-
- ^ gen compiledMethodUsing: aCompiledMethodClass
-
- "Modified: / 17-09-2008 / 12:18:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
literals
^gen literals
--- a/stx_goodies_newcompiler.st Wed Feb 25 16:49:21 2009 +0000
+++ b/stx_goodies_newcompiler.st Mon Mar 30 14:47:18 2009 +0000
@@ -12,14 +12,14 @@
preRequisites
^ #(
- #'stx:goodies/libtool3' "Tools::Inspector2Tab - referenced by IRMethod>>inspector2TabIRCode "
+ #'stx:goodies/libtool3' "Tools::Inspector2Tab - referenced by IRFunction>>inspector2TabIRCode "
#'stx:goodies/refactoryBrowser/parser' "RBIdentifierToken - referenced by IRDecompiler>>newVar: "
#'stx:goodies/sunit' "TestCase - superclass of IRTransformTest "
#'stx:libbasic' "Link - superclass of IRLine "
#'stx:libbasic2' "OrderedDictionary - referenced by IRBytecodeGenerator>>initialize "
- #'stx:libcomp' "PrimitiveNode - referenced by IRMethod>>initialize "
+ #'stx:libcomp' "PrimitiveNode - referenced by IRFunction>>initialize "
#'stx:libcompat' "Preferences - referenced by IRDecompiler>>removeClosureCreation: "
- #'stx:libwidg' "ScrollableView - referenced by IRMethod>>inspector2TabIRCode "
+ #'stx:libwidg' "ScrollableView - referenced by IRFunction>>inspector2TabIRCode "
)
! !
@@ -31,19 +31,21 @@
IRBuilder
IRBuilderTest
IRBytecodeGenerator
+ IRFunction
IRInstruction
IRInterpreter
- IRMethod
IRSequence
IRStackCount
IRTransformTest
#'stx_goodies_newcompiler'
IRAccess
+ IRClosure
IRConstant
IRDecompiler
IRDup
IRJump
IRLine
+ IRMethod
IRPop
IRPrinter
IRReturn