Hi,
I've refactored the compiler and add a backend support,
right now I've only added Smalltalk (in this patch). The goal
is to add support for C/x86/Java/C#/... C and x86 are particuliary
interesting (at least for me) to add Smalltalk directly in the virtual
machine.
Cheers,
Gwen
diff --git a/packages/stinst/parser/CompilerBackend.st b/packages/stinst/parser/CompilerBackend.st
new file mode 100644
index 0000000..5f72592
--- /dev/null
+++ b/packages/stinst/parser/CompilerBackend.st
@@ -0,0 +1,221 @@
+Object subclass: CompilerBackend [
+
+ <category: 'STInST-Backend'>
+
+ CompilerBackend class [ | optimizedMessages | ]
+
+ CompilerBackend class >> optimizedMessages [
+ <category: 'optimization'>
+
+ ]
+
+ CompilerBackend class >> symbolTable: aSymbolTable stack: aStack [
+ <category: 'instance creation'>
+
+ ^ self new
+ symbolTable: aSymbolTable stack: aStack;
+ yourself
+ ]
+
+ CompilerBackend class >> symbolTable: aSymbolTable [
+ <category: 'instance creation'>
+
+ ^ self symbolTable: aSymbolTable stack: Stack new
+ ]
+
+ CompilerBackend class >> new [
+ <category: 'instance creation'>
+
+ ^ super new
+ initialize;
+ yourself
+ ]
+
+ | stack symbolTable |
+
+ initialize [
+ <category: 'initialization'>
+
+ ]
+
+ symbolTable: aSymbolTable stack: aStack [
+ <category: 'initialization'>
+
+ symbolTable := aSymbolTable.
+ stack := aStack
+ ]
+
+ stack [
+ <category: 'stack'>
+
+ ^ stack
+ ]
+
+ depthIncr [
+ <category: 'stack'>
+
+ stack depthIncr
+ ]
+
+ depthDecr [
+ <category: 'stack'>
+
+ stack depthDecr
+ ]
+
+ depthDecr: n [
+ <category: 'stack'>
+
+ stack depthDecr: n
+ ]
+
+ depthSet: n [
+ <category: 'stack'>
+
+ ^ stack depthSet: n
+ ]
+
+ maxDepth [
+ <category: 'stack'>
+
+
+ ^ stack maxDepth
+ ]
+
+ addLiteral: anObject [
+ <category: 'literals'>
+
+ ^ symbolTable addLiteral: anObject
+ ]
+
+ contents [
+ <category: 'bytecode'>
+
+ ]
+
+ nextPutAll: anArray [
+ <category: 'bytecode'>
+
+ ]
+
+ dupStackTop [
+ <category: 'instructions'>
+
+ ]
+
+ jumpBack: anInteger [
+ <category: 'instructions'>
+
+ ]
+
+ jumpTo: anInteger [
+ <category: 'instructions'>
+
+ ]
+
+ makeDirtyBlock [
+ <category: 'instructions'>
+
+ ]
+
+ popStackTop [
+ <category: 'instructions'>
+
+ ]
+
+ popStoreIntoArray: anIndex [
+ <category: 'instructions'>
+
+ ]
+
+ pushLiteralVariable: aLiteral [
+ <category: 'instructions'>
+
+ ]
+
+ pushLiteral: aLiteral [
+ <category: 'instructions'>
+
+ ]
+
+ pushInteger: anInteger [
+ <category: 'instructions'>
+
+ ]
+
+ pushNil [
+ <category: 'instructions'>
+
+ ]
+
+ pushSelf [
+ <category: 'instructions'>
+
+ ]
+
+ pushTemporaryVariable: anIndex [
+ <category: 'instructions'>
+
+ ]
+
+ pushReceiverVariable: anIndex [
+ <category: 'instructions'>
+
+ ]
+
+ pushOuterVariable: anIndex [
+ <category: 'instructions'>
+
+ ]
+
+ returnContextStackTop [
+ <category: 'instructions'>
+
+ ]
+
+ returnMethodStackTop [
+ <category: 'instructions'>
+
+ ]
+
+ send: aSelector [
+ <category: 'instructions'>
+
+ ]
+
+ sendImmediate: aSelector [
+ <category: 'instructions'>
+
+ ]
+
+ superSend: aSelector [
+ <category: 'instructions'>
+
+ ]
+
+ superSendImmediate: aSelector [
+ <category: 'instructions'>
+
+ ]
+
+ storeLiteralVariable: anInteger [
+ <category: 'instructions'>
+
+ ]
+
+ storeReceiverVariable: anInteger [
+ <category: 'instructions'>
+
+ ]
+
+ storeTemporaryVariable: anInteger [
+ <category: 'instructions'>
+
+ ]
+
+ storeOuterVariable: anInteger [
+ <category: 'instructions'>
+
+ ]
+]
+
diff --git a/packages/stinst/parser/Makefile.frag b/packages/stinst/parser/Makefile.frag
index 301849b..41858d2 100644
--- a/packages/stinst/parser/Makefile.frag
+++ b/packages/stinst/parser/Makefile.frag
@@ -1,5 +1,5 @@
Parser_FILES = \
-packages/stinst/parser/ParseTreeSearcher.st packages/stinst/parser/RBFormatter.st packages/stinst/parser/RBParseNodes.st packages/stinst/parser/RBParser.st packages/stinst/parser/RBToken.st packages/stinst/parser/OrderedSet.st packages/stinst/parser/PoolResolutionTests.st packages/stinst/parser/STCompLit.st packages/stinst/parser/STCompiler.st packages/stinst/parser/STDecompiler.st packages/stinst/parser/STLoader.st packages/stinst/parser/STLoaderObjs.st packages/stinst/parser/STSymTable.st packages/stinst/parser/RewriteTests.st packages/stinst/parser/SqueakParser.st packages/stinst/parser/STFileParser.st packages/stinst/parser/SIFParser.st packages/stinst/parser/GSTParser.st packages/stinst/parser/STEvaluationDriver.st packages/stinst/parser/Exporter.st packages/stinst/parser/NewSyntaxExporter.st packages/stinst/parser/OldSyntaxExporter.st packages/stinst/parser/SqueakExporter.st packages/stinst/parser/Extensions.st packages/stinst/parser/ChangeLog
+packages/stinst/parser/RBToken.st packages/stinst/parser/RBParseNodes.st packages/stinst/parser/RBParser.st packages/stinst/parser/ParseTreeSearcher.st packages/stinst/parser/RBFormatter.st packages/stinst/parser/OrderedSet.st packages/stinst/parser/STFileParser.st packages/stinst/parser/STCompLit.st packages/stinst/parser/STSymTable.st packages/stinst/parser/STCompiler.st packages/stinst/parser/STDecompiler.st packages/stinst/parser/STLoaderObjs.st packages/stinst/parser/STLoader.st packages/stinst/parser/SqueakParser.st packages/stinst/parser/SIFParser.st packages/stinst/parser/GSTParser.st packages/stinst/parser/STEvaluationDriver.st packages/stinst/parser/Exporter.st packages/stinst/parser/NewSyntaxExporter.st packages/stinst/parser/OldSyntaxExporter.st packages/stinst/parser/SqueakExporter.st packages/stinst/parser/Extensions.st packages/stinst/parser/Stack.st packages/stinst/parser/CompilerBackend.st packages/stinst/parser/STBackend.st packages/stinst/parser/ChangeLog packages/stinst/parser/RewriteTests.st packages/stinst/parser/PoolResolutionTests.st
$(Parser_FILES):
$(srcdir)/packages/stinst/parser/stamp-classes: $(Parser_FILES)
touch $(srcdir)/packages/stinst/parser/stamp-classes
diff --git a/packages/stinst/parser/STBackend.st b/packages/stinst/parser/STBackend.st
new file mode 100644
index 0000000..160c477
--- /dev/null
+++ b/packages/stinst/parser/STBackend.st
@@ -0,0 +1,319 @@
+CompilerBackend subclass: STBackend [
+
+ <category: 'STInST-Backend'>
+
+ <import: VMOtherConstants>
+ <import: VMByteCodeNames>
+
+ STBackend class >> optimizedMessages [
+ <category: 'optimization'>
+
+ ^ optimizedMessages ifNil: [
+ optimizedMessages := IdentityDictionary new
+ at: #whileTrue put: #compileSTWhileLoop:;
+ at: #whileFalse put: #compileSTWhileLoop:;
+ at: #whileTrue: put: #compileSTWhileLoop:;
+ at: #whileFalse: put: #compileSTWhileLoop:;
+ at: #repeat put: #compileSTRepeat:;
+ at: #timesRepeat: put: #compileSTTimesRepeat:;
+ at: #to:do: put: #compileSTLoop:;
+ at: #to:by:do: put: #compileSTLoop:;
+ at: #ifTrue: put: #compileSTIfTrue:;
+ at: #ifTrue:ifFalse: put: #compileSTIfTrueIfFalse:;
+ at: #ifFalse: put: #compileSTIfFalse:;
+ at: #ifFalse:ifTrue: put: #compileSTIfFalseIfTrue:;
+ at: #and: put: #compileSTAnd:;
+ at: #or: put: #compileSTOr:;
+ yourself ]
+ ]
+
+ | bytecodes |
+
+ initialize [
+ <category: 'initialization'>
+
+ super initialize.
+ bytecodes := WriteStream on: (ByteArray new: 240)
+ ]
+
+ selector: aSymbol numArgs: anArgsInteger numTemps: aTempsInteger attributes: anAttributesArray source: aString [
+ <category: 'generation'>
+
+ | method |
+ method := CompiledMethod
+ literals: symbolTable literals
+ numArgs: anArgsInteger
+ numTemps: aTempsInteger
+ attributes: anAttributesArray
+ bytecodes: self contents
+ depth: self maxDepth + aTempsInteger + anArgsInteger.
+ (method descriptor)
+ setSourceCode: aString;
+ methodClass: symbolTable environment;
+ selector: aSymbol.
+ ^ method
+ ]
+
+ contents [
+ <category: 'bytecode'>
+
+ ^ bytecodes contents
+ ]
+
+ nextPutAll: anArray [
+ <category: 'bytecode'>
+
+ bytecodes nextPutAll: anArray
+ ]
+
+ dupStackTop [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: DupStackTop
+ ]
+
+ jumpBack: anInteger [
+ <category: 'instructions'>
+
+ self compileByte: JumpBack arg: anInteger
+ ]
+
+ jumpTo: anInteger [
+ <category: 'instructions'>
+
+ self compileByte: Jump arg: anInteger
+ ]
+
+ makeDirtyBlock [
+ <category: 'instructions'>
+
+ self compileByte: MakeDirtyBlock
+ ]
+
+ popStackTop [
+ <category: 'instructions'>
+
+ self
+ depthDecr;
+ compileByte: PopStackTop
+ ]
+
+ popStoreIntoArray: anIndex [
+ <category: 'instructions'>
+
+ self
+ depthDecr;
+ compileByte: PopStoreIntoArray arg: anIndex
+ ]
+
+ popJumpFalse: anInteger [
+ <category: 'instructions'>
+
+ self
+ depthDecr;
+ compileByte: PopJumpFalse arg: anInteger
+ ]
+
+ popJumpTrue: anInteger [
+ <category: 'instructions'>
+
+ self
+ depthDecr;
+ compileByte: PopJumpTrue arg: anInteger
+ ]
+
+ pushLiteralConstant: aLiteral [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushLitConstant arg: aLiteral
+ ]
+
+ pushLiteralVariable: aLiteral [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushLitVariable arg: aLiteral
+ ]
+
+ pushLiteral: aLiteral [
+ <category: 'instructions'>
+
+ (aLiteral isInteger and: [aLiteral >= 0 and: [aLiteral <= 1073741823]])
+ ifTrue:
+ [^ self pushInteger: aLiteral].
+ aLiteral isNil
+ ifTrue:
+ [^ self pushNil].
+ aLiteral == true
+ ifTrue:
+ [^ self pushTrue].
+ aLiteral == false
+ ifTrue:
+ [^ self pushFalse].
+ self pushLiteralConstant: (self addLiteral: aLiteral)
+ ]
+
+ pushInteger: anInteger [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushInteger arg: anInteger
+ ]
+
+ pushNil [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushSpecial arg: NilIndex
+ ]
+
+ pushSelf [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushSelf
+ ]
+
+ pushTrue [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushSpecial arg: TrueIndex
+ ]
+
+ pushFalse [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushSpecial arg: FalseIndex
+ ]
+
+ pushTemporaryVariable: anIndex [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushTemporaryVariable arg: anIndex
+ ]
+
+ pushReceiverVariable: anIndex [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushReceiverVariable arg: anIndex
+ ]
+
+ pushOuterVariable: anIndex scope: aScope [
+ <category: 'instructions'>
+
+ self
+ depthIncr;
+ compileByte: PushOuterVariable arg: anIndex arg: aScope
+ ]
+
+ returnContextStackTop [
+ <category: 'instructions'>
+
+ self compileByte: ReturnContextStackTop
+ ]
+
+ returnMethodStackTop [
+ <category: 'instructions'>
+
+ self compileByte: ReturnMethodStackTop
+ ]
+
+ send: aSelector [
+ <category: 'instructions'>
+
+ self depthDecr: aSelector numArgs.
+ VMSpecialSelectors at: aSelector ifPresent: [ :index | ^ self sendImmediate: index ].
+ self compileByte: Send arg: (self addLiteral: aSelector) arg: aSelector numArgs
+ ]
+
+ sendImmediate: anIndex [
+ <category: 'instructions'>
+
+ anIndex <= LastImmediateSend
+ ifTrue: [ self compileByte: anIndex arg: 0 ]
+ ifFalse: [ self compileByte: SendImmediate arg: anIndex ]
+ ]
+
+ superSend: aSelector [
+ <category: 'instructions'>
+
+ self depthDecr: aSelector numArgs.
+ VMSpecialSelectors at: aSelector ifPresent: [ :index | ^ self superSendImmediate: index ].
+ self compileByte: SendSuper arg: (self addLiteral: aSelector) arg: aSelector numArgs
+ ]
+
+ superSendImmediate: anIndex [
+ <category: 'instructions'>
+
+ self compileByte: SendImmediateSuper arg: anIndex
+ ]
+
+ storeLiteralVariable: anInteger [
+ <category: 'instructions'>
+
+ self compileByte: StoreLitVariable arg: anInteger
+ ]
+
+ storeReceiverVariable: anInteger [
+ <category: 'instructions'>
+
+ self compileByte: StoreReceiverVariable arg: anInteger
+ ]
+
+ storeTemporaryVariable: anInteger [
+ <category: 'instructions'>
+
+ self compileByte: StoreTemporaryVariable arg: anInteger
+ ]
+
+ storeOuterVariable: anInteger scope: aScope [
+ <category: 'instructions'>
+
+ self
+ compileByte: StoreOuterVariable arg: anInteger arg: aScope
+ ]
+
+ compileByte: aByte [
+ <category: 'private bytecode'>
+
+ self compileByte: aByte arg: 0
+ ]
+
+ compileByte: aByte arg: arg1 arg: arg2 [
+ <category: 'private bytecode'>
+
+ self compileByte: aByte arg: (arg1 bitShift: 8) + arg2
+ ]
+
+ compileByte: aByte arg: arg [
+ <category: 'private bytecode'>
+
+ | n |
+ n := 0.
+ [ (arg bitShift: n) > 255 ] whileTrue: [ n := n - 8 ].
+ n to: -8 by: 8 do: [ :shift |
+ bytecodes
+ nextPut: ExtByte;
+ nextPut: ((arg bitShift: shift) bitAnd: 255) ].
+ bytecodes
+ nextPut: aByte;
+ nextPut: (arg bitAnd: 255)
+ ]
+]
+
diff --git a/packages/stinst/parser/STCompLit.st b/packages/stinst/parser/STCompLit.st
index 33726c0..2e9a5e0 100644
--- a/packages/stinst/parser/STCompLit.st
+++ b/packages/stinst/parser/STCompLit.st
@@ -77,44 +77,12 @@ Eval [
VMOtherConstants at: #VMSpecialSelectors put: selectorsMap.
VMOtherConstants at: #VMSpecialIdentifiers
put: ((LookupTable new: 8)
- at: 'super' put: [:c | c compileError: 'invalid occurrence of super'];
- at: 'self' put: [:c | c compileByte: VMByteCodeNames.PushSelf];
- at: 'nil'
- put:
- [:c |
- c compileByte: VMByteCodeNames.PushSpecial arg: VMOtherConstants.NilIndex];
- at: 'true'
- put:
- [:c |
- c compileByte: VMByteCodeNames.PushSpecial arg: VMOtherConstants.TrueIndex];
- at: 'false'
- put:
- [:c |
- c compileByte: VMByteCodeNames.PushSpecial arg: VMOtherConstants.FalseIndex];
- at: 'thisContext'
- put:
- [:c |
- c
- pushLiteralVariable: #{ContextPart};
- compileByte: VMByteCodeNames.SendImmediate
- arg: VMOtherConstants.ThisContextSpecial];
+ at: 'super' put: [ :c | c compileError: 'invalid occurrence of super' ];
+ at: 'self' put: [ :c | c compilePushSelf ];
+ at: 'nil' put: [ :c | c compilePushNil ];
+ at: 'true' put: [ :c | c compilePushTrue ];
+ at: 'false' put: [ :c | c compilePushFalse ];
+ at: 'thisContext' put: [ :c | c compilePushThisContext ];
yourself).
- VMOtherConstants at: #VMSpecialMethods
- put: ((IdentityDictionary new: 32)
- at: #whileTrue put: #compileWhileLoop:;
- at: #whileFalse put: #compileWhileLoop:;
- at: #whileTrue: put: #compileWhileLoop:;
- at: #whileFalse: put: #compileWhileLoop:;
- at: #repeat put: #compileRepeat:;
- at: #timesRepeat: put: #compileTimesRepeat:;
- at: #to:do: put: #compileLoop:;
- at: #to:by:do: put: #compileLoop:;
- at: #ifTrue: put: #compileBoolean:;
- at: #ifTrue:ifFalse: put: #compileBoolean:;
- at: #ifFalse: put: #compileBoolean:;
- at: #ifFalse:ifTrue: put: #compileBoolean:;
- at: #and: put: #compileBoolean:;
- at: #or: put: #compileBoolean:;
- yourself)
]
diff --git a/packages/stinst/parser/STCompiler.st b/packages/stinst/parser/STCompiler.st
index 74fc9a8..018c925 100644
--- a/packages/stinst/parser/STCompiler.st
+++ b/packages/stinst/parser/STCompiler.st
@@ -53,7 +53,6 @@ Actually, I am used when conditionally compiled code has to be skipped.'>
STFakeCompiler subclass: STCompiler [
- | node destClass symTable parser bytecodes depth maxDepth isInsideBlock |
<comment: 'Unlike my brother STFakeCompiler, I am a real worker. Give me some nodes, and
I will output a full-fledged CompiledMethod!!
@@ -87,22 +86,13 @@ indexed'' bytecode. The resulting stream is
<category: 'System-Compiler'>
OneNode := nil.
- TrueNode := nil.
- FalseNode := nil.
- NilNode := nil.
SuperVariable := nil.
- SelfVariable := nil.
- ThisContextVariable := nil.
STCompiler class >> initialize [
<category: 'initialize'>
+
OneNode := RBLiteralNode value: 1.
- TrueNode := RBLiteralNode value: true.
- FalseNode := RBLiteralNode value: false.
- NilNode := RBLiteralNode value: nil.
- SelfVariable := RBVariableNode named: 'self'.
SuperVariable := RBVariableNode named: 'super'.
- ThisContextVariable := RBVariableNode named: 'thisContext'
]
STCompiler class >> evaluate: aSequenceNode parser: aParser [
@@ -115,7 +105,8 @@ indexed'' bytecode. The resulting stream is
selector: #Doit;
source: nil;
yourself.
- cm := self
+ cm := self
+ backend: STBackend
compile: methodNode
asMethodOf: UndefinedObject
classified: nil
@@ -144,7 +135,8 @@ indexed'' bytecode. The resulting stream is
STCompiler class >> compile: methodNode asMethodOf: aBehavior classified: aString parser: aParser [
<category: 'compilation'>
- ^self
+ ^self
+ backend: STBackend
compile: methodNode
asMethodOf: aBehavior
classified: aString
@@ -152,23 +144,26 @@ indexed'' bytecode. The resulting stream is
environment: nil
]
- STCompiler class >> compile: methodNode asMethodOf: aBehavior classified: aString parser: aParser environment: aNamespace [
+ STCompiler class >> backend: aCompilerBackend compile: methodNode asMethodOf: aBehavior classified: aString parser: aParser environment: aNamespace [
<category: 'compilation'>
| compiler method |
compiler := self new.
- compiler class: aBehavior parser: aParser.
+ compiler class: aBehavior parser: aParser backend: aCompilerBackend.
aNamespace isNil ifFalse: [compiler addPool: aNamespace].
method := compiler visitNode: methodNode.
aString isNil ifFalse: [ method methodCategory: aString ].
^method
]
- class: aBehavior parser: aParser [
- <category: 'private'>
+ | backend node destClass symTable parser bytecodes depth maxDepth isInsideBlock |
+
+ class: aBehavior parser: aParser backend: aCompilerBackend [
+ <category: 'initialization'>
+
destClass := aBehavior.
symTable := STSymbolTable new.
+ backend := aCompilerBackend symbolTable: symTable.
parser := aParser.
- bytecodes := WriteStream on: (ByteArray new: 240).
isInsideBlock := 0.
symTable declareEnvironment: aBehavior
]
@@ -190,15 +185,15 @@ indexed'' bytecode. The resulting stream is
bytecodesFor: aBlockNode atEndDo: aBlock [
<category: 'accessing'>
- | saveBytecodes result |
- saveBytecodes := bytecodes.
- bytecodes := WriteStream on: (ByteArray new: 240).
+ | saveBackend result |
+ saveBackend := backend.
+ backend := STBackend symbolTable: symTable stack: backend stack.
self declareArgumentsAndTemporaries: aBlockNode.
self compileStatements: aBlockNode body.
self undeclareArgumentsAndTemporaries: aBlockNode.
aBlock value.
- result := bytecodes contents.
- bytecodes := saveBytecodes.
+ result := backend contents.
+ backend := saveBackend.
^result
]
@@ -219,7 +214,7 @@ indexed'' bytecode. The resulting stream is
jumpLen := displacement + 2.
jumpLen := displacement + (self sizeOfJump: jumpLen).
jumpLen := displacement + (self sizeOfJump: jumpLen).
- self compileByte: JumpBack arg: jumpLen
+ backend jumpBack: jumpLen
]
compileJump: displacement if: jmpCondition [
@@ -229,10 +224,9 @@ indexed'' bytecode. The resulting stream is
["Should not happen"
^self error: 'Cannot compile backwards conditional jumps'].
- self depthDecr: 1.
jmpCondition
- ifFalse: [self compileByte: PopJumpFalse arg: displacement]
- ifTrue: [self compileByte: PopJumpTrue arg: displacement]
+ ifFalse: [ backend popJumpFalse: displacement]
+ ifTrue: [ backend popJumpTrue: displacement]
]
compileWarning: aString [
@@ -261,40 +255,6 @@ indexed'' bytecode. The resulting stream is
self declareTemporaries: node body
]
- maxDepth [
- <category: 'accessing'>
- ^maxDepth
- ]
-
- depthDecr: n [
- <category: 'accessing'>
- depth := depth - n
- ]
-
- depthIncr [
- <category: 'accessing'>
- depth = maxDepth
- ifTrue:
- [depth := depth + 1.
- maxDepth := maxDepth + 1]
- ifFalse: [depth := depth + 1]
- ]
-
- depthSet: n [
- "n can be an integer, or a previously returned value (in which case the
- exact status at the moment of the previous call is remembered)"
-
- <category: 'accessing'>
- | oldDepth |
- oldDepth := n -> maxDepth.
- n isInteger
- ifTrue: [depth := maxDepth := n]
- ifFalse:
- [depth := n key.
- maxDepth := n value].
- ^oldDepth
- ]
-
literals [
<category: 'accessing'>
^symTable literals
@@ -314,38 +274,6 @@ indexed'' bytecode. The resulting stream is
^definition
]
- compileByte: aByte [
- <category: 'accessing'>
- self compileByte: aByte arg: 0
- ]
-
- compileByte: aByte arg: arg [
- <category: 'accessing'>
- | n |
- n := 0.
- [(arg bitShift: n) > 255] whileTrue: [n := n - 8].
- n to: -8
- by: 8
- do:
- [:shift |
- bytecodes
- nextPut: ExtByte;
- nextPut: ((arg bitShift: shift) bitAnd: 255)].
- bytecodes
- nextPut: aByte;
- nextPut: (arg bitAnd: 255)
- ]
-
- compileByte: aByte arg: arg1 arg: arg2 [
- <category: 'accessing'>
- self compileByte: aByte arg: (arg1 bitShift: 8) + arg2
- ]
-
- nextPutAll: aByteArray [
- <category: 'accessing'>
- bytecodes nextPutAll: aByteArray
- ]
-
isInsideBlock [
<category: 'accessing'>
^isInsideBlock > 0
@@ -353,32 +281,28 @@ indexed'' bytecode. The resulting stream is
pushLiteral: value [
<category: 'accessing'>
- | definition |
(value isInteger and: [value >= 0 and: [value <= 1073741823]])
ifTrue:
- [self compileByte: PushInteger arg: value.
+ [backend pushInteger: value.
^self].
value isNil
ifTrue:
- [self compileByte: PushSpecial arg: NilIndex.
+ [backend pushNil.
^self].
value == true
ifTrue:
- [self compileByte: PushSpecial arg: TrueIndex.
+ [backend pushTrue.
^self].
value == false
ifTrue:
- [self compileByte: PushSpecial arg: FalseIndex.
+ [backend pushFalse.
^self].
- definition := self addLiteral: value.
- self compileByte: PushLitConstant arg: definition
+ backend pushLitConstant: value
]
pushLiteralVariable: value [
<category: 'accessing'>
- | definition |
- definition := self addLiteral: value.
- self compileByte: PushLitVariable arg: definition
+ backend pushLitVariable: value
]
sizeOfJump: distance [
@@ -469,17 +393,12 @@ indexed'' bytecode. The resulting stream is
self undeclareArgumentsAndTemporaries: node.
symTable finish.
attributes := self compileMethodAttributes: node primitiveSources.
- method := CompiledMethod
- literals: symTable literals
- numArgs: node arguments size
- numTemps: node body temporaries size
- attributes: attributes
- bytecodes: bytecodes contents
- depth: maxDepth + node body temporaries size + node arguments size.
- (method descriptor)
- setSourceCode: node source asSourceCode;
- methodClass: symTable environment;
- selector: node selector.
+ method := backend
+ selector: node selector
+ numArgs: node arguments size
+ numTemps: node body temporaries size
+ attributes: attributes
+ source: node source asSourceCode.
method attributesDo:
[:ann |
| handler error |
@@ -499,19 +418,15 @@ indexed'' bytecode. The resulting stream is
instead of a simple pop."
<category: 'visiting RBArrayConstructorNodes'>
- self
- depthIncr;
- pushLiteralVariable: (Smalltalk associationAt: #Array);
- depthIncr;
- compileByte: PushInteger arg: aNode body statements size;
- depthDecr: 1;
- compileByte: SendImmediate arg: NewColonSpecial.
+ backend
+ pushLiteralVariable: (backend addLiteral: (Smalltalk associationAt: #Array));
+ pushInteger: aNode body statements size;
+ sendImmediate: NewColonSpecial.
aNode body statements keysAndValuesDo:
- [:index :each |
+ [ :index :each |
each acceptVisitor: self.
- self
- depthDecr: 1;
- compileByte: PopStoreIntoArray arg: index - 1]
+ backend
+ popStoreIntoArray: index - 1 ]
]
acceptBlockNode: aNode [
@@ -530,45 +445,32 @@ indexed'' bytecode. The resulting stream is
<category: 'visiting RBBlockNodes'>
| bc depth block clean |
- depth := self depthSet: aNode arguments size + aNode body temporaries size.
- aNode body statements isEmpty
- ifTrue: [aNode body addNode: (RBLiteralNode value: nil)].
- bc := self insideNewScopeDo:
- [self bytecodesFor: aNode
- atEndDo:
- [aNode body lastIsReturn ifFalse: [self compileByte: ReturnContextStackTop]]].
+ depth := backend depthSet: aNode arguments size + aNode body temporaries size.
+ aNode body statements isEmpty ifTrue: [aNode body addNode: (RBLiteralNode value: nil)].
+ bc := self insideNewScopeDo: [ self bytecodesFor: aNode atEndDo: [ aNode body lastIsReturn ifFalse: [ backend returnContextStackTop ] ] ].
block := CompiledBlock
numArgs: aNode arguments size
numTemps: aNode body temporaries size
bytecodes: bc
- depth: self maxDepth
+ depth: backend maxDepth
literals: self literals.
- self depthSet: depth.
+ backend depthSet: depth.
clean := block flags.
clean == 0
ifTrue:
- [self
- pushLiteral: (BlockClosure block: block receiver: symTable environment).
- ^aNode].
- self pushLiteral: block.
- self compileByte: MakeDirtyBlock
+ [ ^ backend pushLiteral: (BlockClosure block: block receiver: symTable environment) ].
+ backend
+ pushLiteral: block;
+ makeDirtyBlock
]
compileStatements: aNode [
<category: 'visiting RBBlockNodes'>
aNode statements keysAndValuesDo:
[:index :each |
- index = 1
- ifFalse:
- [self
- depthDecr: 1;
- compileByte: PopStackTop].
- each acceptVisitor: self].
- aNode statements isEmpty
- ifTrue:
- [self
- depthIncr;
- compileByte: PushSpecial arg: NilIndex]
+ index = 1 ifFalse: [ backend popStackTop ].
+ each acceptVisitor: self ].
+ aNode statements isEmpty ifTrue: [ backend pushNil ]
]
acceptCascadeNode: aNode [
@@ -580,36 +482,29 @@ indexed'' bytecode. The resulting stream is
first := messages at: 1.
first receiver = SuperVariable
ifTrue:
- [aNode messages do: [:each | self compileSendToSuper: each]
- separatedBy:
- [self
- depthDecr: 1;
- compileByte: PopStackTop].
- ^aNode].
+ [ aNode messages do: [:each | self compileSendToSuper: each]
+ separatedBy: [ backend popStackTop ].
+ ^ aNode ].
first receiver acceptVisitor: self.
- self
- depthIncr;
- compileByte: DupStackTop.
+ backend dupStackTop.
self compileMessage: first.
messages
from: 2
to: messages size - 1
do:
- [:each |
- self
- compileByte: PopStackTop;
- compileByte: DupStackTop.
+ [:each |
+ backend
+ popStackTop;
+ dupStackTop.
self compileMessage: each].
- self
- depthDecr: 1;
- compileByte: PopStackTop.
+ backend popStackTop.
self compileMessage: messages last
]
acceptOptimizedNode: aNode [
<category: 'visiting RBOptimizedNodes'>
- self depthIncr.
- self pushLiteral: (self class evaluate: aNode body parser: parser)
+
+ backend pushLiteral: (self class evaluate: aNode body parser: parser)
]
acceptLiteralNode: aNode [
@@ -617,9 +512,9 @@ indexed'' bytecode. The resulting stream is
it represents."
<category: 'visiting RBLiteralNodes'>
- self depthIncr.
+
aNode compiler: self.
- self pushLiteral: aNode value
+ backend pushLiteral: aNode value
]
acceptAssignmentNode: aNode [
@@ -633,18 +528,11 @@ indexed'' bytecode. The resulting stream is
]
acceptMessageNode: aNode [
- "RBMessageNode contains a message send. Its instance variable are
- a receiver, selector, and arguments."
-
<category: 'compiling'>
- | specialSelector |
- aNode receiver = SuperVariable
- ifTrue:
- [self compileSendToSuper: aNode.
- ^true].
- specialSelector := VMSpecialMethods at: aNode selector ifAbsent: [nil].
- specialSelector isNil
- ifFalse: [(self perform: specialSelector with: aNode) ifTrue: [^false]].
+
+ aNode receiver = SuperVariable ifTrue: [ ^ self compileSendToSuper: aNode ].
+ backend class optimizedMessages at: aNode selector ifPresent: [ :aSymbol |
+ (self perform: aSymbol with: aNode) ifTrue: [ ^ self ] ].
aNode receiver acceptVisitor: self.
self compileMessage: aNode
]
@@ -657,241 +545,26 @@ indexed'' bytecode. The resulting stream is
<category: 'compiling'>
| args litIndex |
aNode arguments do: [:each | each acceptVisitor: self].
- VMSpecialSelectors at: aNode selector
- ifPresent:
- [:idx |
- idx <= LastImmediateSend
- ifTrue: [self compileByte: idx arg: 0]
- ifFalse: [self compileByte: SendImmediate arg: idx].
- ^aNode].
- args := aNode arguments size.
- litIndex := self addLiteral: aNode selector.
- self
- compileByte: Send
- arg: litIndex
- arg: args
- ]
-
- compileRepeat: aNode [
- "Answer whether the loop can be optimized (that is,
- whether the only parameter is a STBlockNode)"
-
- <category: 'compiling'>
- | whileBytecodes |
- aNode receiver isBlock ifFalse: [^false].
- (aNode receiver arguments isEmpty
- and: [aNode receiver body temporaries isEmpty]) ifFalse: [^false].
- whileBytecodes := self bytecodesFor: aNode receiver
- atEndDo:
- [self
- compileByte: PopStackTop;
- depthDecr: 1].
- self nextPutAll: whileBytecodes.
- self compileBackJump: whileBytecodes size.
-
- "The optimizer might like to see the return value of #repeat."
- self
- depthIncr;
- compileByte: PushSpecial arg: NilIndex.
- ^true
- ]
-
- compileWhileLoop: aNode [
- "Answer whether the while loop can be optimized (that is,
- whether the only parameter is a STBlockNode)"
-
- <category: 'compiling'>
- | whileBytecodes argBytecodes jumpOffsets |
- aNode receiver isBlock ifFalse: [^false].
- (aNode receiver arguments isEmpty
- and: [aNode receiver body temporaries isEmpty]) ifFalse: [^false].
- argBytecodes := #().
- aNode arguments do:
- [:onlyArgument |
- onlyArgument isBlock ifFalse: [^false].
- (onlyArgument arguments isEmpty
- and: [onlyArgument body temporaries isEmpty]) ifFalse: [^false].
- argBytecodes := self bytecodesFor: onlyArgument
- atEndDo:
- [self
- compileByte: PopStackTop;
- depthDecr: 1]].
- whileBytecodes := self bytecodesFor: aNode receiver.
- self nextPutAll: whileBytecodes.
- jumpOffsets := self displacementsToJumpAround: argBytecodes size
- and: whileBytecodes size + 2. "for jump around jump"
-
- "The if: clause means: if selector is whileFalse:, compile
- a 'pop/jump if true'; else compile a 'pop/jump if false'"
- self compileJump: (self sizeOfJump: jumpOffsets value)
- if: (aNode selector == #whileTrue or: [aNode selector == #whileTrue:]).
- self compileByte: Jump arg: jumpOffsets value.
- argBytecodes isNil ifFalse: [self nextPutAll: argBytecodes].
- self compileByte: JumpBack arg: jumpOffsets key.
-
- "Somebody might want to use the return value of #whileTrue:
- and #whileFalse:"
- self
- depthIncr;
- compileByte: PushSpecial arg: NilIndex.
- ^true
+ backend send: aNode selector
]
compileSendToSuper: aNode [
<category: 'compiling'>
| litIndex args |
- self
- depthIncr;
- compileByte: PushSelf.
+ backend pushSelf.
aNode arguments do: [:each | each acceptVisitor: self].
- self pushLiteral: destClass superclass.
- VMSpecialSelectors at: aNode selector
- ifPresent:
- [:idx |
- self compileByte: SendImmediateSuper arg: idx.
- ^aNode].
+ backend pushLiteral: destClass superclass.
litIndex := self addLiteral: aNode selector.
args := aNode arguments size.
- self
- compileByte: SendSuper
- arg: litIndex
- arg: args.
- self depthDecr: aNode arguments size
- ]
-
- compileTimesRepeat: aNode [
- <category: 'compiling'>
- "aNode receiver acceptVisitor: self."
-
- | block |
- block := aNode arguments first.
- (block arguments isEmpty and: [block body temporaries isEmpty])
- ifFalse: [^false].
- ^false
- ]
-
- compileLoop: aNode [
- <category: 'compiling'>
- "aNode receiver acceptVisitor: self."
-
- | stop step block |
- aNode arguments do:
- [:each |
- stop := step. "to:"
- step := block. "by:"
- block := each "do:"].
- block isBlock ifFalse: [^false].
- (block arguments size = 1 and: [block body temporaries isEmpty])
- ifFalse: [^false].
- stop isNil
- ifTrue:
- [stop := step.
- step := OneNode "#to:do:"]
- ifFalse: [step isImmediate ifFalse: [^false]].
- ^false
- ]
-
- compileBoolean: aNode [
- <category: 'compiling'>
- | bc1 ret1 bc2 selector |
- aNode arguments do:
- [:each |
- each isBlock ifFalse: [^false].
- (each arguments isEmpty and: [each body temporaries isEmpty])
- ifFalse: [^false].
- bc1 isNil
- ifTrue:
- [bc1 := self bytecodesFor: each.
- ret1 := each body lastIsReturn]
- ifFalse: [bc2 := self bytecodesFor: each]].
- aNode receiver acceptVisitor: self.
- selector := aNode selector.
- bc2 isNil
- ifTrue:
- ["Transform everything into #ifTrue:ifFalse: or #ifFalse:ifTrue:"
-
- selector == #ifTrue:
- ifTrue:
- [selector := #ifTrue:ifFalse:.
- bc2 := NilIndex "Push nil"].
- selector == #ifFalse:
- ifTrue:
- [selector := #ifFalse:ifTrue:.
- bc2 := NilIndex "Push nil"].
- selector == #and:
- ifTrue:
- [selector := #ifTrue:ifFalse:.
- bc2 := FalseIndex "Push false"].
- selector == #or:
- ifTrue:
- [selector := #ifFalse:ifTrue:.
- bc2 := TrueIndex "Push true"].
- bc2 :=
- {PushSpecial.
- bc2}.
- ^self
- compileBoolean: aNode
- longBranch: bc1
- returns: ret1
- shortBranch: bc2
- longIfTrue: selector == #ifTrue:ifFalse:].
- selector == #ifTrue:ifFalse:
- ifTrue:
- [^self
- compileIfTrue: bc1
- returns: ret1
- ifFalse: bc2].
- selector == #ifFalse:ifTrue:
- ifTrue:
- [^self
- compileIfFalse: bc1
- returns: ret1
- ifTrue: bc2].
- ^self error: 'bad boolean message selector'
- ]
-
- compileBoolean: aNode longBranch: bc1 returns: ret1 shortBranch: bc2 longIfTrue: longIfTrue [
- <category: 'compiling'>
- self compileJump: bc1 size + (ret1 ifTrue: [0] ifFalse: [2])
- if: longIfTrue not.
- self nextPutAll: bc1.
- ret1 ifFalse: [self compileByte: Jump arg: bc2 size].
- self nextPutAll: bc2.
- ^true
- ]
-
- compileIfTrue: bcTrue returns: bcTrueReturns ifFalse: bcFalse [
- <category: 'compiling'>
- | trueSize |
- trueSize := bcTrueReturns
- ifTrue: [bcTrue size]
- ifFalse: [bcTrue size + (self sizeOfJump: bcFalse size)].
- self compileJump: trueSize if: false.
- self nextPutAll: bcTrue.
- bcTrueReturns ifFalse: [self compileByte: Jump arg: bcFalse size].
- self nextPutAll: bcFalse.
- ^true
- ]
-
- compileIfFalse: bcFalse returns: bcFalseReturns ifTrue: bcTrue [
- <category: 'compiling'>
- | falseSize |
- falseSize := bcFalseReturns
- ifTrue: [bcFalse size]
- ifFalse: [bcFalse size + (self sizeOfJump: bcTrue size)].
- self compileJump: falseSize if: true.
- self nextPutAll: bcFalse.
- bcFalseReturns ifFalse: [self compileByte: Jump arg: bcTrue size].
- self nextPutAll: bcTrue.
- ^true
+ backend superSend: aNode selector
]
acceptReturnNode: aNode [
<category: 'compiling'>
aNode value acceptVisitor: self.
self isInsideBlock
- ifTrue: [self compileByte: ReturnMethodStackTop]
- ifFalse: [self compileByte: ReturnContextStackTop]
+ ifTrue: [ backend returnMethodStackTop ]
+ ifFalse: [ backend returnContextStackTop ]
]
compileAssignmentFor: aNode [
@@ -907,55 +580,289 @@ indexed'' bytecode. The resulting stream is
[^self compileStoreTemporary: definition
scopes: (symTable outerScopes: aNode name)].
(symTable isReceiver: aNode name)
- ifTrue: [^self compileByte: StoreReceiverVariable arg: definition].
- self compileByte: StoreLitVariable arg: definition.
- self compileByte: PopStackTop.
- self compileByte: PushLitVariable arg: definition
+ ifTrue: [^backend storeReceiverVariable: definition].
+ backend storeLiteralVariable: definition.
+ backend popStackTop.
+ backend pushLiteralVariable: definition
]
acceptVariableNode: aNode [
<category: 'visiting RBVariableNodes'>
| locationType definition |
- self depthIncr.
- VMSpecialIdentifiers at: aNode name
- ifPresent:
- [:block |
- block value: self.
- ^aNode].
+ VMSpecialIdentifiers at: aNode name ifPresent: [:block | ^ block value: self ].
definition := self lookupName: aNode name.
(symTable isTemporary: aNode name)
ifTrue:
- [^self compilePushTemporary: definition
- scopes: (symTable outerScopes: aNode name)].
+ [^self compilePushTemporary: definition scopes: (symTable outerScopes: aNode name)].
(symTable isReceiver: aNode name)
ifTrue:
- [self compileByte: PushReceiverVariable arg: definition.
- ^aNode].
- self compileByte: PushLitVariable arg: definition
+ [ ^ backend pushReceiverVariable: definition ].
+ backend pushLiteralVariable: definition
]
compilePushTemporary: number scopes: outerScopes [
<category: 'visiting RBVariableNodes'>
outerScopes = 0
ifFalse:
- [self
- compileByte: PushOuterVariable
- arg: number
- arg: outerScopes.
- ^self].
- self compileByte: PushTemporaryVariable arg: number
+ [ ^ backend pushOuterVariable: number scope: outerScopes ].
+ backend pushTemporaryVariable: number
+ ]
+
+ compilePushSelf [
+
+ backend pushSelf
+ ]
+
+ compilePushTrue [
+
+ backend pushTrue
+ ]
+
+ compilePushFalse [
+
+ backend pushFalse
+ ]
+
+ compilePushNil [
+
+ backend pushNil
+ ]
+
+ compilePushThisContext [
+
+ backend
+ pushLiteralVariable: (backend addLiteral: #{ContextPart});
+ send: #thisContext
]
compileStoreTemporary: number scopes: outerScopes [
<category: 'visiting RBVariableNodes'>
- outerScopes = 0
- ifFalse:
- [self
- compileByte: StoreOuterVariable
- arg: number
- arg: outerScopes.
- ^self].
- self compileByte: StoreTemporaryVariable arg: number
+ outerScopes = 0 ifFalse: [ ^ backend storeOuterVariable: number scope: outerScopes ].
+ backend storeTemporaryVariable: number
+ ]
+
+ checkCompileSTWhileLoop: aNode [
+ <category: '*STInST-Backend'>
+
+ aNode receiver isBlock ifFalse: [ ^ false ].
+ (aNode receiver arguments isEmpty and: [ aNode receiver body temporaries isEmpty ]) ifFalse: [ ^ false ].
+ aNode arguments do: [ :block |
+ block isBlock ifFalse: [ ^ false ].
+ (block arguments isEmpty and: [ block body temporaries isEmpty ]) ifFalse: [ ^ false ] ].
+ ^ true
+ ]
+
+ compileSTWhileLoop: aNode [
+ <category: '*STInST-Backend'>
+
+ | whileBytecodes argBytecodes jumpOffsets |
+ (self checkCompileSTWhileLoop: aNode) ifFalse: [ ^ false ].
+ argBytecodes := aNode arguments isEmpty ifTrue: [ #() ] ifFalse: [ self bytecodesFor: aNode arguments first atEndDo: [ backend popStackTop ] ].
+ whileBytecodes := self bytecodesFor: aNode receiver.
+ backend nextPutAll: whileBytecodes.
+ jumpOffsets := self displacementsToJumpAround: argBytecodes size and: whileBytecodes size + 2.
+ self compileJump: (self sizeOfJump: jumpOffsets value) if: (aNode selector == #whileTrue or: [ aNode selector == #whileTrue: ]).
+ backend jumpTo: jumpOffsets value.
+ backend nextPutAll: argBytecodes.
+ backend jumpBack: jumpOffsets key.
+ backend pushNil.
+ ^ true
+ ]
+
+ checkCompileSTBoolean: aNode [
+ <category: '*STInST-Backend'>
+
+ aNode arguments do: [ :each |
+ each isBlock ifFalse: [ ^ false ].
+ (each arguments isEmpty and: [each body temporaries isEmpty]) ifFalse: [ ^ false ] ].
+ ^ true
+ ]
+
+ compileSTAnd: aNode [
+ <category: '*STInST-Backend'>
+
+ | bc1 bc2 ret1 selector |
+ (self checkCompileSTBoolean: aNode) ifFalse: [ ^ false ].
+ bc1 := self bytecodesFor: aNode arguments first.
+ ret1 := aNode arguments first body lastIsReturn.
+ bc2 := { PushSpecial. FalseIndex }.
+ aNode receiver acceptVisitor: self.
+ selector := aNode selector.
+ ^ self
+ compileBoolean: aNode
+ longBranch: bc1
+ returns: ret1
+ shortBranch: bc2
+ longIfTrue: true
+ ]
+
+ compileSTOr: aNode [
+ <category: '*STInST-Backend'>
+
+ | bc1 bc2 ret1 selector |
+ (self checkCompileSTBoolean: aNode) ifFalse: [ ^ false ].
+ bc1 := self bytecodesFor: aNode arguments first.
+ ret1 := aNode arguments first body lastIsReturn.
+ bc2 := { PushSpecial. TrueIndex }.
+ aNode receiver acceptVisitor: self.
+ selector := aNode selector.
+ ^ self
+ compileBoolean: aNode
+ longBranch: bc1
+ returns: ret1
+ shortBranch: bc2
+ longIfTrue: false
+ ]
+
+ compileSTIfTrue: aNode [
+ <category: '*STInST-Backend'>
+
+ | bc1 bc2 ret1 selector |
+ (self checkCompileSTBoolean: aNode) ifFalse: [ ^ false ].
+ bc1 := self bytecodesFor: aNode arguments first.
+ ret1 := aNode arguments first body lastIsReturn.
+ bc2 := { PushSpecial. NilIndex }.
+ aNode receiver acceptVisitor: self.
+ selector := aNode selector.
+ ^ self
+ compileBoolean: aNode
+ longBranch: bc1
+ returns: ret1
+ shortBranch: bc2
+ longIfTrue: true
+ ]
+
+ compileSTIfFalse: aNode [
+ <category: '*STInST-Backend'>
+
+ | bc1 bc2 ret1 selector |
+ (self checkCompileSTBoolean: aNode) ifFalse: [ ^ false ].
+ bc1 := self bytecodesFor: aNode arguments first.
+ ret1 := aNode arguments first body lastIsReturn.
+ bc2 := { PushSpecial. NilIndex }.
+ aNode receiver acceptVisitor: self.
+ selector := aNode selector.
+ ^ self
+ compileBoolean: aNode
+ longBranch: bc1
+ returns: ret1
+ shortBranch: bc2
+ longIfTrue: false
+ ]
+
+ compileSTIfTrueIfFalse: aNode [
+ <category: '*STInST-Backend'>
+
+ | bc1 bc2 ret1 selector |
+ (self checkCompileSTBoolean: aNode) ifFalse: [ ^ false ].
+ bc1 := self bytecodesFor: aNode arguments first.
+ ret1 := aNode arguments first body lastIsReturn.
+ bc2 := self bytecodesFor: aNode arguments second.
+ aNode receiver acceptVisitor: self.
+ selector := aNode selector.
+ ^ self
+ compileIfTrue: bc1
+ returns: ret1
+ ifFalse: bc2
+ ]
+
+ compileSTIfFalseIfTrue: aNode [
+ <category: '*STInST-Backend'>
+
+ | bc1 bc2 ret1 selector |
+ (self checkCompileSTBoolean: aNode) ifFalse: [ ^ false ].
+ bc1 := self bytecodesFor: aNode arguments first.
+ ret1 := aNode arguments first body lastIsReturn.
+ bc2 := self bytecodesFor: aNode arguments second.
+ aNode receiver acceptVisitor: self.
+ selector := aNode selector.
+ ^ self
+ compileIfFalse: bc1
+ returns: ret1
+ ifTrue: bc2
+ ]
+
+ compileBoolean: aNode longBranch: bc1 returns: ret1 shortBranch: bc2 longIfTrue: longIfTrue [
+ <category: '*STInST-Backend'>
+
+ self compileJump: bc1 size + (ret1 ifTrue: [0] ifFalse: [2])
+ if: longIfTrue not.
+ backend nextPutAll: bc1.
+ ret1 ifFalse: [backend jumpTo: bc2 size].
+ backend nextPutAll: bc2.
+ ^true
+ ]
+
+ compileIfTrue: bcTrue returns: bcTrueReturns ifFalse: bcFalse [
+ <category: '*STInST-Backend'>
+
+ | trueSize |
+ trueSize := bcTrueReturns
+ ifTrue: [bcTrue size]
+ ifFalse: [bcTrue size + (self sizeOfJump: bcFalse size)].
+ self compileJump: trueSize if: false.
+ backend nextPutAll: bcTrue.
+ bcTrueReturns ifFalse: [ backend jumpTo: bcFalse size ].
+ backend nextPutAll: bcFalse.
+ ^true
+ ]
+
+ compileIfFalse: bcFalse returns: bcFalseReturns ifTrue: bcTrue [
+ <category: '*STInST-Backend'>
+
+ | falseSize |
+ falseSize := bcFalseReturns
+ ifTrue: [bcFalse size]
+ ifFalse: [bcFalse size + (self sizeOfJump: bcTrue size)].
+ self compileJump: falseSize if: true.
+ backend nextPutAll: bcFalse.
+ bcFalseReturns ifFalse: [backend jumpTo: bcTrue size].
+ backend nextPutAll: bcTrue.
+ ^true
+ ]
+
+ compileSTRepeat: aNode [
+ <category: '*STInST-Backend'>
+
+ | whileBytecodes |
+ aNode receiver isBlock ifFalse: [^false].
+ (aNode receiver arguments isEmpty and: [aNode receiver body temporaries isEmpty]) ifFalse: [^false].
+ whileBytecodes := self bytecodesFor: aNode receiver atEndDo: [ backend popStackTop ].
+ backend nextPutAll: whileBytecodes.
+ self compileBackJump: whileBytecodes size.
+ "The optimizer might like to see the return value of #repeat."
+ backend pushNil.
+ ^ true
+ ]
+
+ compileSTLoop: aNode [
+ <category: '*STInST-Backend'>
+
+ | stop step block |
+ aNode arguments do:
+ [:each |
+ stop := step. "to:"
+ step := block. "by:"
+ block := each "do:"].
+ block isBlock ifFalse: [^false].
+ (block arguments size = 1 and: [block body temporaries isEmpty])
+ ifFalse: [^false].
+ stop isNil
+ ifTrue:
+ [stop := step.
+ step := OneNode "#to:do:"]
+ ifFalse: [step isImmediate ifFalse: [^false]].
+ ^false
+ ]
+
+ compileSTTimesRepeat: aNode [
+ <category: '*STInST-Backend'>
+
+ | block |
+ block := aNode arguments first.
+ (block arguments isEmpty and: [block body temporaries isEmpty])
+ ifFalse: [^false].
+ ^false
]
compileMethodAttributes: attributes [
diff --git a/packages/stinst/parser/Stack.st b/packages/stinst/parser/Stack.st
new file mode 100644
index 0000000..d6d51af
--- /dev/null
+++ b/packages/stinst/parser/Stack.st
@@ -0,0 +1,62 @@
+Object subclass: Stack [
+
+ Stack class >> new [
+ <category: 'instance creation'>
+
+ ^ super new
+ initialize;
+ yourself
+ ]
+
+ | depth maxDepth |
+
+ initialize [
+ <category: 'initialization'>
+
+ depth := maxDepth := 0.
+ ]
+
+ depthIncr [
+ <category: 'stack'>
+
+ depth = maxDepth
+ ifTrue: [ depth := depth + 1.
+ maxDepth := maxDepth + 1 ]
+ ifFalse: [ depth := depth + 1 ]
+ ]
+
+ depthDecr [
+ <category: 'stack'>
+
+ depth := depth - 1
+ ]
+
+ depthDecr: n [
+ <category: 'stack'>
+
+ depth := depth - n
+ ]
+
+ depthSet: n [
+ "n can be an integer, or a previously returned value (in which case the
+ exact status at the moment of the previous call is remembered)"
+
+ <category: 'stack'>
+
+ | oldDepth |
+ oldDepth := n -> maxDepth.
+ n isInteger
+ ifTrue: [depth := maxDepth := n]
+ ifFalse:
+ [depth := n key.
+ maxDepth := n value].
+ ^oldDepth
+ ]
+
+ maxDepth [
+ <category: 'stack'>
+
+ ^ maxDepth
+ ]
+]
+
diff --git a/packages/stinst/parser/package.xml b/packages/stinst/parser/package.xml
index 1c9f2c7..de99a3c 100644
--- a/packages/stinst/parser/package.xml
+++ b/packages/stinst/parser/package.xml
@@ -24,6 +24,9 @@
<filein>OldSyntaxExporter.st</filein>
<filein>SqueakExporter.st</filein>
<filein>Extensions.st</filein>
+ <filein>Stack.st</filein>
+ <filein>CompilerBackend.st</filein>
+ <filein>STBackend.st</filein>
<test>
<namespace>STInST.Tests</namespace>
_______________________________________________
help-smalltalk mailing list
[email protected]
https://lists.gnu.org/mailman/listinfo/help-smalltalk
