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 [ + + + + CompilerBackend class [ | optimizedMessages | ] + + CompilerBackend class >> optimizedMessages [ + + + ] + + CompilerBackend class >> symbolTable: aSymbolTable stack: aStack [ + + + ^ self new + symbolTable: aSymbolTable stack: aStack; + yourself + ] + + CompilerBackend class >> symbolTable: aSymbolTable [ + + + ^ self symbolTable: aSymbolTable stack: Stack new + ] + + CompilerBackend class >> new [ + + + ^ super new + initialize; + yourself + ] + + | stack symbolTable | + + initialize [ + + + ] + + symbolTable: aSymbolTable stack: aStack [ + + + symbolTable := aSymbolTable. + stack := aStack + ] + + stack [ + + + ^ stack + ] + + depthIncr [ + + + stack depthIncr + ] + + depthDecr [ + + + stack depthDecr + ] + + depthDecr: n [ + + + stack depthDecr: n + ] + + depthSet: n [ + + + ^ stack depthSet: n + ] + + maxDepth [ + + + + ^ stack maxDepth + ] + + addLiteral: anObject [ + + + ^ symbolTable addLiteral: anObject + ] + + contents [ + + + ] + + nextPutAll: anArray [ + + + ] + + dupStackTop [ + + + ] + + jumpBack: anInteger [ + + + ] + + jumpTo: anInteger [ + + + ] + + makeDirtyBlock [ + + + ] + + popStackTop [ + + + ] + + popStoreIntoArray: anIndex [ + + + ] + + pushLiteralVariable: aLiteral [ + + + ] + + pushLiteral: aLiteral [ + + + ] + + pushInteger: anInteger [ + + + ] + + pushNil [ + + + ] + + pushSelf [ + + + ] + + pushTemporaryVariable: anIndex [ + + + ] + + pushReceiverVariable: anIndex [ + + + ] + + pushOuterVariable: anIndex [ + + + ] + + returnContextStackTop [ + + + ] + + returnMethodStackTop [ + + + ] + + send: aSelector [ + + + ] + + sendImmediate: aSelector [ + + + ] + + superSend: aSelector [ + + + ] + + superSendImmediate: aSelector [ + + + ] + + storeLiteralVariable: anInteger [ + + + ] + + storeReceiverVariable: anInteger [ + + + ] + + storeTemporaryVariable: anInteger [ + + + ] + + storeOuterVariable: anInteger [ + + + ] +] + 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 [ + + + + + + + STBackend class >> optimizedMessages [ + + + ^ 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 [ + + + super initialize. + bytecodes := WriteStream on: (ByteArray new: 240) + ] + + selector: aSymbol numArgs: anArgsInteger numTemps: aTempsInteger attributes: anAttributesArray source: aString [ + + + | 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 [ + + + ^ bytecodes contents + ] + + nextPutAll: anArray [ + + + bytecodes nextPutAll: anArray + ] + + dupStackTop [ + + + self + depthIncr; + compileByte: DupStackTop + ] + + jumpBack: anInteger [ + + + self compileByte: JumpBack arg: anInteger + ] + + jumpTo: anInteger [ + + + self compileByte: Jump arg: anInteger + ] + + makeDirtyBlock [ + + + self compileByte: MakeDirtyBlock + ] + + popStackTop [ + + + self + depthDecr; + compileByte: PopStackTop + ] + + popStoreIntoArray: anIndex [ + + + self + depthDecr; + compileByte: PopStoreIntoArray arg: anIndex + ] + + popJumpFalse: anInteger [ + + + self + depthDecr; + compileByte: PopJumpFalse arg: anInteger + ] + + popJumpTrue: anInteger [ + + + self + depthDecr; + compileByte: PopJumpTrue arg: anInteger + ] + + pushLiteralConstant: aLiteral [ + + + self + depthIncr; + compileByte: PushLitConstant arg: aLiteral + ] + + pushLiteralVariable: aLiteral [ + + + self + depthIncr; + compileByte: PushLitVariable arg: aLiteral + ] + + pushLiteral: aLiteral [ + + + (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 [ + + + self + depthIncr; + compileByte: PushInteger arg: anInteger + ] + + pushNil [ + + + self + depthIncr; + compileByte: PushSpecial arg: NilIndex + ] + + pushSelf [ + + + self + depthIncr; + compileByte: PushSelf + ] + + pushTrue [ + + + self + depthIncr; + compileByte: PushSpecial arg: TrueIndex + ] + + pushFalse [ + + + self + depthIncr; + compileByte: PushSpecial arg: FalseIndex + ] + + pushTemporaryVariable: anIndex [ + + + self + depthIncr; + compileByte: PushTemporaryVariable arg: anIndex + ] + + pushReceiverVariable: anIndex [ + + + self + depthIncr; + compileByte: PushReceiverVariable arg: anIndex + ] + + pushOuterVariable: anIndex scope: aScope [ + + + self + depthIncr; + compileByte: PushOuterVariable arg: anIndex arg: aScope + ] + + returnContextStackTop [ + + + self compileByte: ReturnContextStackTop + ] + + returnMethodStackTop [ + + + self compileByte: ReturnMethodStackTop + ] + + send: aSelector [ + + + self depthDecr: aSelector numArgs. + VMSpecialSelectors at: aSelector ifPresent: [ :index | ^ self sendImmediate: index ]. + self compileByte: Send arg: (self addLiteral: aSelector) arg: aSelector numArgs + ] + + sendImmediate: anIndex [ + + + anIndex <= LastImmediateSend + ifTrue: [ self compileByte: anIndex arg: 0 ] + ifFalse: [ self compileByte: SendImmediate arg: anIndex ] + ] + + superSend: aSelector [ + + + self depthDecr: aSelector numArgs. + VMSpecialSelectors at: aSelector ifPresent: [ :index | ^ self superSendImmediate: index ]. + self compileByte: SendSuper arg: (self addLiteral: aSelector) arg: aSelector numArgs + ] + + superSendImmediate: anIndex [ + + + self compileByte: SendImmediateSuper arg: anIndex + ] + + storeLiteralVariable: anInteger [ + + + self compileByte: StoreLitVariable arg: anInteger + ] + + storeReceiverVariable: anInteger [ + + + self compileByte: StoreReceiverVariable arg: anInteger + ] + + storeTemporaryVariable: anInteger [ + + + self compileByte: StoreTemporaryVariable arg: anInteger + ] + + storeOuterVariable: anInteger scope: aScope [ + + + self + compileByte: StoreOuterVariable arg: anInteger arg: aScope + ] + + compileByte: aByte [ + + + self compileByte: aByte arg: 0 + ] + + compileByte: aByte arg: arg1 arg: arg2 [ + + + self compileByte: aByte arg: (arg1 bitShift: 8) + arg2 + ] + + compileByte: aByte arg: arg [ + + + | 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 | OneNode := nil. - TrueNode := nil. - FalseNode := nil. - NilNode := nil. SuperVariable := nil. - SelfVariable := nil. - ThisContextVariable := nil. STCompiler class >> 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 [ - ^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 [ | 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 [ - + | backend node destClass symTable parser bytecodes depth maxDepth isInsideBlock | + + class: aBehavior parser: aParser backend: aCompilerBackend [ + + 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 [ - | 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 [ - - ^maxDepth - ] - - depthDecr: n [ - - depth := depth - n - ] - - depthIncr [ - - 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)" - - - | oldDepth | - oldDepth := n -> maxDepth. - n isInteger - ifTrue: [depth := maxDepth := n] - ifFalse: - [depth := n key. - maxDepth := n value]. - ^oldDepth - ] - literals [ ^symTable literals @@ -314,38 +274,6 @@ indexed'' bytecode. The resulting stream is ^definition ] - compileByte: aByte [ - - self compileByte: aByte arg: 0 - ] - - compileByte: aByte arg: arg [ - - | 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 [ - - self compileByte: aByte arg: (arg1 bitShift: 8) + arg2 - ] - - nextPutAll: aByteArray [ - - bytecodes nextPutAll: aByteArray - ] - isInsideBlock [ ^isInsideBlock > 0 @@ -353,32 +281,28 @@ indexed'' bytecode. The resulting stream is pushLiteral: value [ - | 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 [ - | 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." - 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 | 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 [ 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 [ - 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." - 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." - - | 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 | 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)" - - - | 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)" - - - | 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 [ | 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 [ - - "aNode receiver acceptVisitor: self." - - | block | - block := aNode arguments first. - (block arguments isEmpty and: [block body temporaries isEmpty]) - ifFalse: [^false]. - ^false - ] - - compileLoop: aNode [ - - "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 [ - - | 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 [ - - 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 [ - - | 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 [ - - | 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 [ 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 [ | 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 [ 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 [ - 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 [ + + + 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 [ + + + | 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 [ + + + aNode arguments do: [ :each | + each isBlock ifFalse: [ ^ false ]. + (each arguments isEmpty and: [each body temporaries isEmpty]) ifFalse: [ ^ false ] ]. + ^ true + ] + + compileSTAnd: aNode [ + + + | 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 [ + + + | 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 [ + + + | 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 [ + + + | 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 [ + + + | 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 [ + + + | 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 [ + + + 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 [ + + + | 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 [ + + + | 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 [ + + + | 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 [ + + + | 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 [ + + + | 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 [ + + + ^ super new + initialize; + yourself + ] + + | depth maxDepth | + + initialize [ + + + depth := maxDepth := 0. + ] + + depthIncr [ + + + depth = maxDepth + ifTrue: [ depth := depth + 1. + maxDepth := maxDepth + 1 ] + ifFalse: [ depth := depth + 1 ] + ] + + depthDecr [ + + + depth := depth - 1 + ] + + depthDecr: n [ + + + 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)" + + + + | oldDepth | + oldDepth := n -> maxDepth. + n isInteger + ifTrue: [depth := maxDepth := n] + ifFalse: + [depth := n key. + maxDepth := n value]. + ^oldDepth + ] + + maxDepth [ + + + ^ 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 @@ OldSyntaxExporter.st SqueakExporter.st Extensions.st + Stack.st + CompilerBackend.st + STBackend.st STInST.Tests