First simple block works. See IRBuilderTest>>testBlock_blockTempArg.
More tests are comming.
--- a/IRBuilder.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRBuilder.st Mon Mar 30 17:49:01 2009 +0000
@@ -14,18 +14,53 @@
!IRBuilder class methodsFor:'instance creation'!
+for: anIRFunction
+ ^ self basicNew initializeFor: anIRFunction.
+
+ "Created: / 30-03-2009 / 18:28:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+forClosure
+ ^ self basicNew initializeFor: IRClosure new.
+
+ "Created: / 30-03-2009 / 18:28:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+forMethod
+ ^ self basicNew initializeFor: IRMethod new.
+
+ "Created: / 30-03-2009 / 18:28:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
new
- ^ self basicNew initialize.
+ ^ self forMethod
"Created: / 11-06-2008 / 00:51:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 18:28:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilder methodsFor:'accessing'!
+closureBuilder
+
+ ^IRBuilder forClosure
+ environmentIr: ir;
+ yourself
+
+ "Created: / 30-03-2009 / 18:29:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
currentSequence
^currentSequence
!
+environmentIr: anIRFunction
+
+ ir environmentIr: anIRFunction
+
+ "Created: / 30-03-2009 / 18:30:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
properties: aDict
ir properties: aDict
! !
@@ -60,7 +95,14 @@
!
initialize
- ir := IRMethod new.
+
+ ^self initializeFor: IRMethod new.
+
+ "Modified: / 30-03-2009 / 18:27:31 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+initializeFor: anIRFunction
+ ir := anIRFunction.
jumpAheadStacks := IdentityDictionary new.
jumpBackTargetStacks := IdentityDictionary new.
sourceMapNodes := OrderedCollection new. "stack"
@@ -70,7 +112,7 @@
currentSequence := (IRSequence new orderNumber:1) method:ir.
ir startSequence add:(IRJump new destination: currentSequence)
- "Modified: / 30-03-2009 / 11:18:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Created: / 30-03-2009 / 18:27:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numRargs: n
@@ -171,14 +213,25 @@
self add: IRInstruction popTop
!
-pushBlock: irMethod
+pushBlock: irClosure
- self add: (IRInstruction pushBlock: irMethod)
+ self
+ assert: irClosure isIRClosure
+ message: 'Argument must be an instance of irClosure'.
+
+ self add: (IRInstruction pushBlock: irClosure)
+
+ "Modified: / 30-03-2009 / 16:49:07 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-pushBlockMethod: irMethod
+pushBlockUsingBuilder: oneArgBlock
- self add: (IRInstruction pushBlockMethod: irMethod)
+ | closureBuilder |
+ closureBuilder := self closureBuilder.
+ oneArgBlock value: closureBuilder.
+ ^self pushBlock: closureBuilder ir
+
+ "Created: / 30-03-2009 / 18:32:02 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushDup
--- a/IRBuilderTest.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRBuilderTest.st Mon Mar 30 17:49:01 2009 +0000
@@ -149,6 +149,13 @@
"
"Created: / 28-03-2009 / 20:21:51 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+mock8
+
+ ^([:arg| arg ] value: 22)
+
+ "Created: / 30-03-2009 / 19:21:48 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilderTest methodsFor:'testing'!
@@ -749,11 +756,16 @@
send:#value:;
returnTop;
ir.
+ "
+ irBuilder ir
+ "
+
aCompiledMethod := irBuilder compiledCode.
self assert:(aCompiledMethod isKindOf:CompiledMethod).
- self assert:((aCompiledMethod valueWithReceiver:nil arguments:#()) = 22).
+ self assert:((aCompiledMethod valueWithReceiver:1 arguments:#()) = 22).
"Created: / 30-03-2009 / 14:26:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 19:16:25 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRBuilderTest class methodsFor:'documentation'!
--- a/IRBytecodeGenerator.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRBytecodeGenerator.st Mon Mar 30 17:49:01 2009 +0000
@@ -23,6 +23,17 @@
!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.
@@ -158,6 +169,30 @@
"Modified: / 02-12-2008 / 10:38:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
+makeBlock: irClosure
+
+ | closureCode |
+
+ stack push.
+
+ self
+ nextPut: #makeBlock;
+ nextPut: nil "Number of block bytecodes. Patched later";
+ nextPut: irClosure numVars;
+ nextPut: irClosure numArgs.
+
+ closureCode := (IRTranslator new)
+ interpret: irClosure;
+ getCode.
+
+ "Patch number of closure bytecodes"
+ code at: code size - 2 put: (closureCode size + 5).
+ code addAll: closureCode.
+
+ "Created: / 30-03-2009 / 18:16:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 19:39:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
popTop
stack pop.
@@ -167,6 +202,28 @@
"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.
@@ -345,6 +402,29 @@
"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
--- a/IRClosure.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRClosure.st Mon Mar 30 17:49:01 2009 +0000
@@ -33,7 +33,11 @@
tempArgKindForLevel:level
"Superclass IRFunction says that I am responsible to implement this method"
- self shouldImplement
+ ^level isZero
+ ifTrue: [#BArg]
+ ifFalse:[#OBArg]
+
+ "Modified: / 30-03-2009 / 18:36:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
tempVarKindForLevel:level
--- a/IRConstant.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRConstant.st Mon Mar 30 17:49:01 2009 +0000
@@ -41,10 +41,9 @@
type == nil ifTrue:[^interpreter pushLiteral: constant].
type == #block ifTrue:[^interpreter pushBlock: constant].
- type == #blockMethod ifTrue:[^interpreter pushBlockMethod: constant].
self shouldNeverBeReached.
- "Modified: / 11-06-2008 / 01:03:20 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 16:50:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRConstant methodsFor:'testing'!
--- a/IRFunction.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRFunction.st Mon Mar 30 17:49:01 2009 +0000
@@ -10,6 +10,14 @@
!
+!IRFunction class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize.
+
+ "Created: / 11-06-2008 / 00:52:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
!IRFunction methodsFor:'accessing'!
addLiteral: aSymbol
@@ -26,7 +34,10 @@
| keys i new |
keys := self tempKeys.
- i := keys size - 1. "zero-based (index 0 equals receiver)"
+ i := keys size -
+ (self isIRMethod
+ ifTrue:[1 "zero-based (index 0 equals receiver - self)"]
+ ifFalse:[0]).
new := OrderedCollection new.
newKeys do:
[:key |
@@ -35,7 +46,7 @@
i := i + 1]].
self tempKeys: keys, new.
- "Modified: / 30-03-2009 / 11:15:22 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 18:46:36 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
additionalLiterals
@@ -91,7 +102,9 @@
numArgs
- ^ self numRargs - 1
+ ^ self numRargs
+
+ "Modified: / 30-03-2009 / 18:47:59 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
numRargs
@@ -99,6 +112,13 @@
^ numRargs
!
+numVars
+
+ ^ self tempKeys size - self numRargs
+
+ "Created: / 30-03-2009 / 18:37:47 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
primitiveNode
^ primitiveNode
--- a/IRInstruction.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRInstruction.st Mon Mar 30 17:49:01 2009 +0000
@@ -51,13 +51,6 @@
type: #block
!
-pushBlockMethod: irMethod
-
- ^ IRConstant new
- constant: irMethod;
- type: #blockMethod
-!
-
pushDup
^ IRDup new
@@ -87,17 +80,6 @@
"Modified: / 30-03-2009 / 14:08:49 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
-pushTemp: 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
@@ -180,17 +162,6 @@
association: object
!
-storeTemp: 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
--- a/IRMethod.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRMethod.st Mon Mar 30 17:49:01 2009 +0000
@@ -11,12 +11,13 @@
!
-!IRMethod class methodsFor:'instance creation'!
+!IRMethod methodsFor:'accessing'!
+
+numArgs
-new
- ^ self basicNew initialize.
+ ^ self numRargs - 1
- "Created: / 11-06-2008 / 00:52:34 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Created: / 30-03-2009 / 18:48:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRMethod methodsFor:'accessing - defaults'!
--- a/IRPrinter.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRPrinter.st Mon Mar 30 17:49:01 2009 +0000
@@ -78,22 +78,15 @@
stream nextPutAll: 'popTop'
!
-pushBlock: irMethod
+pushBlock: irClosure
- stream nextPutAll: 'pushBlock:'.
- IRPrinter new
- indent: indent + 1;
- stream: stream;
- interpret: irMethod removeEmptyStart.
-!
+ stream nextPutAll: 'pushBlock:'.
+ IRPrinter new
+ indent: indent + 1;
+ stream: stream;
+ interpret: irClosure removeEmptyStart.
-pushBlockMethod: irMethod
-
- stream nextPutAll: 'pushBlockMethod:'.
- IRPrinter new
- indent: indent + 1;
- stream: stream;
- interpret: irMethod removeEmptyStart.
+ "Modified: / 30-03-2009 / 16:51:49 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushDup
@@ -156,24 +149,28 @@
send: selector numArgs: numArgs
- stream nextPutAll: 'send: '.
- selector printOn: stream.
+ stream
+ nextPutAll: 'send: ';
+ nextPutAll: selector storeString.
stream nextPutAll: ' numArgs: '.
numArgs printOn: stream.
"Created: / 01-12-2008 / 19:41:52 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 18:43:26 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
send: selector numArgs: numArgs toSuperOf: behavior
- stream nextPutAll: 'send: '.
- selector printOn: stream.
+ stream
+ nextPutAll: 'send: ';
+ nextPutAll: selector storeString.
stream nextPutAll: ' numArgs: '.
numArgs printOn: stream.
stream nextPutAll: ' toSuperOf: '.
behavior printOn: stream.
"Created: / 01-12-2008 / 19:46:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 18:44:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
storeTemp: index kind: kind level: level
--- a/IRTransformTest.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRTransformTest.st Mon Mar 30 17:49:01 2009 +0000
@@ -46,44 +46,48 @@
!
testAddIntructions
-
- | iRMethod aCompiledMethod |
+
+ | iRMethod aCompiledMethod |
+
+ iRMethod := IRBuilder new
+ numRargs: 1;
+ addTemps: #(self); "receiver and args declarations"
+ pushLiteral: 1;
+ returnTop;
+ ir.
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: 1;
- returnTop;
- ir.
+ (iRMethod allSequences last) last delete.
+ (iRMethod allSequences last) last delete.
- (iRMethod allSequences last) last delete.
- (iRMethod allSequences last) last delete.
+ (iRMethod allSequences last)
+ addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)}.
- (iRMethod allSequences last)
- addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)}.
+ aCompiledMethod := iRMethod compiledCode.
+ self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+ "Modified: / 30-03-2009 / 19:40:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testAddIntructionsBefore
-
- | iRMethod aCompiledMethod push |
+
+ | iRMethod aCompiledMethod push |
+
+ iRMethod := IRBuilder new
+ numRargs: 1;
+ addTemps: #(self); "receiver and args declarations"
+ pushLiteral: 1;
+ returnTop;
+ ir.
- 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 allSequences last)
+ addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)} before: push.
- push := (iRMethod allSequences last) at: (iRMethod allSequences size - 1) .
+ aCompiledMethod := iRMethod compiledCode.
+ self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
- (iRMethod allSequences last)
- addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)} before: push.
-
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+ "Modified: / 30-03-2009 / 19:40:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
testAddIntructionsBeforeFromLList
@@ -137,21 +141,23 @@
!
testReplaceInstr
-
- | iRMethod aCompiledMethod |
+
+ | iRMethod aCompiledMethod |
- iRMethod := IRBuilder new
- numRargs: 1;
- addTemps: #(self); "receiver and args declarations"
- pushLiteral: 1;
- returnTop;
- ir.
-
- (iRMethod allSequences last at: 1)
- replaceWithInstructions: {(IRInstruction pushLiteral: 2)}.
+ iRMethod := IRBuilder new
+ numRargs: 1;
+ addTemps: #(self); "receiver and args declarations"
+ pushLiteral: 1;
+ returnTop;
+ ir.
+
+ (iRMethod allSequences last at: 1)
+ replaceWithInstructions: {(IRInstruction pushLiteral: 2)}.
- aCompiledMethod := iRMethod compiledMethod.
- self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+ aCompiledMethod := iRMethod compiledCode.
+ self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
+
+ "Modified: / 30-03-2009 / 19:40:30 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRTransformTest class methodsFor:'documentation'!
--- a/IRTranslator.st Mon Mar 30 14:47:18 2009 +0000
+++ b/IRTranslator.st Mon Mar 30 17:49:01 2009 +0000
@@ -19,6 +19,15 @@
"Created: / 11-06-2008 / 09:24:01 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
+!IRTranslator methodsFor:'accessing'!
+
+getCode
+
+ ^gen getCode
+
+ "Created: / 30-03-2009 / 19:08:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
+! !
+
!IRTranslator methodsFor:'initialize'!
initialize
@@ -26,6 +35,17 @@
gen := IRBytecodeGenerator new
"Modified: / 17-09-2008 / 12:19:10 / Jan Vrany <vranyj1@fel.cvut.cz>"
+!
+
+setGenerator: aByteCodeGenerator
+
+ "
+ Private method for IRByteCodeGenerator>>makeBlock:
+ "
+
+ gen := aByteCodeGenerator
+
+ "Created: / 30-03-2009 / 18:23:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRTranslator methodsFor:'instructions'!
@@ -88,9 +108,9 @@
gen popTop.
!
-pushBlock: irMethod
+pushBlock: irClosure
- self shouldImplement
+ gen makeBlock: irClosure
"
| meth block |
@@ -100,21 +120,7 @@
self addPending: (Message selector: #pushLiteral: argument: block)
"
- "Modified: / 28-03-2009 / 20:34:11 / Jan Vrany <vranyj1@fel.cvut.cz>"
-!
-
-pushBlockMethod: irMethod
-
- 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>"
+ "Modified: / 30-03-2009 / 18:15:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
pushDup
@@ -161,10 +167,13 @@
"Bad bad bad!! Type switch"
kind == #MArg ifTrue:[^gen pushMethodArg: index].
kind == #MVar ifTrue:[^gen pushMethodVar: index].
+ kind == #BArg ifTrue:[^gen pushBlockArg: index].
+ kind == #BVar ifTrue:[^gen pushBlockVar: index].
self halt:'Should never be reached'.
"Created: / 30-03-2009 / 14:06:28 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 19:02:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
remoteReturn
@@ -257,8 +266,11 @@
kind == #MArg ifTrue:[^self error:'Cannot store to method argument!!'].
kind == #MVar ifTrue:[^self addPending: (Message selector: #storeMethodVar: argument: index)].
+ kind == #BArg ifTrue:[^self addPending: (Message selector: #storeBlockArg: argument: index)].
+ kind == #BVar ifTrue:[^self addPending: (Message selector: #storeBlockVar: argument: index)].
"Created: / 30-03-2009 / 14:07:04 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 30-03-2009 / 19:03:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!IRTranslator methodsFor:'interpret'!
@@ -352,12 +364,6 @@
"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>"
-!
-
literals
^gen literals