# HG changeset patch # User Jan Vrany # Date 1333044238 0 # Node ID be8c2dd09dff5dfaea8771c72325c9034fd764b6 # Parent 1bfd09c6b3d880a38f17635fc53ee537e702f4d3 Build files regenerated diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRAccess.st --- a/IRAccess.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRAccess.st Thu Mar 29 18:03:58 2012 +0000 @@ -29,13 +29,13 @@ !IRAccess class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRAccess.st,v 1.3 2009/10/08 11:57:08 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRAccess.st,v 1.3 2009/10/08 11:57:08 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRAccess.st,v 1.3 2009/10/08 11:57:08 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRBlockReturnTop.st --- a/IRBlockReturnTop.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRBlockReturnTop.st Thu Mar 29 18:03:58 2012 +0000 @@ -41,13 +41,13 @@ !IRBlockReturnTop class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBlockReturnTop.st,v 1.3 2009/10/08 11:58:58 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBlockReturnTop.st,v 1.3 2009/10/08 11:58:58 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBlockReturnTop.st,v 1.3 2009/10/08 11:58:58 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRBuilder.st --- a/IRBuilder.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRBuilder.st Thu Mar 29 18:03:58 2012 +0000 @@ -106,13 +106,6 @@ "Modified: / 30-03-2009 / 11:15:46 / Jan Vrany " ! -tempNames - - ^ir tempNames - - "Modified: / 30-03-2009 / 11:15:46 / Jan Vrany " -! - testJumpAheadTarget: label jumpAheadStacks at: label ifPresent: [:stack | @@ -127,20 +120,6 @@ self addTemps: {tempKey} ! -addTempIfNotDefined: tempKey - - self addTempsIfNotDefined: (Array with: tempKey) - - "Created: / 23-03-2010 / 13:46:20 / Jan Vrany " -! - -addTempsIfNotDefined: temps - - ir addTempsIfNotDefined: temps - - "Created: / 23-03-2010 / 13:46:20 / Jan Vrany " -! - initialize ^self initializeFor: IRMethod new. @@ -478,13 +457,13 @@ !IRBuilder class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBuilder.st,v 1.3 2009/10/08 11:57:58 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBuilder.st,v 1.3 2009/10/08 11:57:58 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBuilder.st,v 1.3 2009/10/08 11:57:58 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRBuilderTest.st --- a/IRBuilderTest.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRBuilderTest.st Thu Mar 29 18:03:58 2012 +0000 @@ -186,11 +186,10 @@ !IRBuilderTest methodsFor:'testing'! -error +halt "Redefinition for testing the #send:toSuperOf:" "Created: / 11-06-2008 / 16:08:52 / Jan Vrany " - "Created: / 15-11-2011 / 22:27:59 / Jan Vrany " ! isThisEverCalled @@ -465,7 +464,7 @@ iRMethod := (IRBuilder new) numRargs:1; addTemps:#( #self ); - pushLiteralVariable:#ArithmeticError; + pushLiteralVariable:(ArithmeticValue bindingOf:#ArithmeticSignal); returnTop; ir. aCompiledMethod := iRMethod compiledCode. @@ -474,7 +473,6 @@ = ArithmeticValue arithmeticSignal). "Modified: / 11-06-2008 / 11:31:32 / Jan Vrany " - "Modified: / 15-11-2011 / 22:25:06 / Jan Vrany " ! testLiteralVariableGlobale @@ -670,7 +668,7 @@ numRargs:1; addTemps:#( #self ); pushReceiver; - send:#error toSuperOf:IRBuilderTest; + send:#halt toSuperOf:IRBuilderTest; returnTop; ir. aCompiledMethod := iRMethod compiledCode. @@ -682,7 +680,6 @@ raise:Error. "Modified: / 11-06-2008 / 16:09:12 / Jan Vrany " - "Modified: / 15-11-2011 / 22:25:36 / Jan Vrany " ! testStorIntoVariable @@ -692,7 +689,7 @@ numRargs:1; addTemps:#( #self ); pushLiteral:4; - storeIntoLiteralVariable:(#'IRBuilderTest:TestToPush'); + storeIntoLiteralVariable:(IRBuilderTest bindingOf:#TestToPush); returnTop; ir. aCompiledMethod := iRMethod compiledCode. @@ -700,8 +697,6 @@ aCompiledMethod valueWithReceiver:nil arguments:#(). self assert:(IRBuilderTest testToPush = 4). IRBuilderTest testToPush:nil. - - "Modified: / 15-11-2011 / 22:27:39 / Jan Vrany " ! testStoreTemp @@ -1035,5 +1030,5 @@ ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRBytecodeGenerator.st --- a/IRBytecodeGenerator.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRBytecodeGenerator.st Thu Mar 29 18:03:58 2012 +0000 @@ -37,6 +37,17 @@ !IRBytecodeGenerator methodsFor:'accessing'! +getCode + + " + Private entry for IRBytecodeGenerator>>makeBlock: + " + + ^code + + "Created: / 30-03-2009 / 19:00:07 / Jan Vrany " +! + properties: aDictionary properties := aDictionary. @@ -213,6 +224,7 @@ at: index + 1 put: (closureCode at: index + 1) + pos + 4]]. + code addAll: closureCode. "Patch number of closure bytecodes" @@ -220,7 +232,6 @@ "Created: / 30-03-2009 / 18:16:10 / Jan Vrany " "Modified: / 12-05-2009 / 08:58:11 / Jan Vrany " - "Modified: / 23-03-2010 / 22:34:24 / Jan Vrany " ! popTop @@ -715,38 +726,6 @@ "Modified: / 13-05-2009 / 10:42:16 / Jan Vrany " ! -getCode - - | stream basicBlockStartOffset | - [ orderSeq - inject: false - into: [:changed :seqId | (self updateJump: seqId) | changed] - ] whileTrue. - - stream := (OrderedCollection new: 200) writeStream. - basicBlockStartOffset := 0. - orderSeq do: [:seqId | - (instrMaps at: seqId) do: [:assoc | - assoc key "instr" bytecodeIndex: stream position + assoc value. - ]. - "Patch makeBlock offsets" - (seqCode at: seqId) withIndexDo: - [:instr :index| - instr == #makeBlock ifTrue: - [(seqCode at: seqId) - at: index + 1 - put: ((seqCode at: seqId) at: index + 1) + basicBlockStartOffset]]. - - stream nextPutAll: (seqCode at: seqId). - basicBlockStartOffset := basicBlockStartOffset + (seqCode at: seqId) size. - ]. - ^stream contents - - "Created: / 11-06-2008 / 14:00:43 / Jan Vrany " - "Modified: / 13-05-2009 / 11:15:41 / Jan Vrany " - "Modified: / 24-03-2010 / 08:42:04 / Jan Vrany " -! - literals ^literals asArray @@ -829,13 +808,13 @@ !IRBytecodeGenerator class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBytecodeGenerator.st,v 1.3 2009/10/08 12:04:39 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBytecodeGenerator.st,v 1.3 2009/10/08 12:04:39 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRBytecodeGenerator.st,v 1.3 2009/10/08 12:04:39 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRClosure.st --- a/IRClosure.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRClosure.st Thu Mar 29 18:03:58 2012 +0000 @@ -10,6 +10,10 @@ !IRClosure methodsFor:'accessing'! +environmentIr + ^ environmentIr +! + environmentIr:something environmentIr := something. ! ! @@ -55,13 +59,13 @@ !IRClosure class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRClosure.st,v 1.3 2009/10/08 12:00:40 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRClosure.st,v 1.3 2009/10/08 12:00:40 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRClosure.st,v 1.3 2009/10/08 12:00:40 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRConstant.st --- a/IRConstant.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRConstant.st Thu Mar 29 18:03:58 2012 +0000 @@ -61,13 +61,13 @@ !IRConstant class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRConstant.st,v 1.3 2009/10/08 12:03:32 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRConstant.st,v 1.3 2009/10/08 12:03:32 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRConstant.st,v 1.3 2009/10/08 12:03:32 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRDecompiler.st --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/IRDecompiler.st Thu Mar 29 18:03:58 2012 +0000 @@ -0,0 +1,1305 @@ +"{ Package: 'cvut:stx/goodies/newcompiler' }" + +IRInterpreter subclass:#IRDecompiler + instanceVariableNames:'stack sp scope currentInstr valueLabelMap mapEmptyStatement' + classVariableNames:'' + poolDictionaries:'' + category:'NewCompiler-IR' +! + +IRDecompiler comment:'I interpret IRMethod instructions and generate a Smalltalk abstract syntax tree rooted at a RBMethodNode. +This is implemented like a shift-reduce parser. Each instruction either causes a node to be pushed on the stack (shift), or causes one or more nodes to be popped and combined into a single node which is push back on the stack (reduce). Most reduction is done at the "label: labelNum" instruction where it tries to reduce jump structures into control messages like #ifTrue:, whileFalse:, etc. +Several pseudo nodes (RBPseudoNode and subclasses) are used to represent basic instructions that have not been reduced to real AST nodes yet. +' +! + + +!IRDecompiler class methodsFor:'as yet unclassified'! + +dummySelector: numArgs + "Answer a dummy selector with number of args" + + | sel | + sel _ 'unknown'. + 1 to: numArgs do: [:i | + sel _ sel, 'with:']. + ^ sel asSymbol +! ! + +!IRDecompiler methodsFor:'accessing'! + +scope + + ^scope +! ! + +!IRDecompiler methodsFor:'init'! + +addTempToScope: ir + + "Temp may be created only if they are not used in the method" + 0 to: ir numRargs - 1 do: [:i | (scope + rawVarAt: i + ifNone: [ + scope capturedVars do: [:each | + each index = i ifTrue:[ + scope tempVarAt: scope capturedVars size + scope tempVars size. + ^self]]. + scope tempVarAt: i]) markArg] +! + +decompileIR: ir + | sequenceNode temps args goto seq value method | + scope isBlockScope + ifTrue:[(scope addTemp: 'parent env') markArg] + ifFalse:[(scope addTemp: 'self') markArg]. + ir tempKeys do: [:temp | scope tempVarAt: temp]. + 0 to: ir numRargs - 1 do: [:i | (scope tempVarAt: i) markArg]. + self interpret: ir. + + self addTempToScope: ir. + self label: #return. + self Label: #return. + (self endCase: #lastReturn) ifFalse:[self Label: #return.]. + goto := self Goto. + value := self ValueOrNone. + seq := self Sequence. + self removeClosureCreation: seq. + sp = 1 ifFalse: [stack explore. self error: 'error']. + value ifNotNil: [seq addNode: value]. + sequenceNode := (self newBlock: seq return: goto) body. + temps := scope compactIndexTemps asArray. + ir tempKeys: temps. + args := (temps first: ir numRargs) allButFirst. + args := args collect: [:var | self newVar: var]. + temps := temps allButFirst: ir numRargs. + sequenceNode temporaries: (temps collect: [:var | self newVar: var]), + ((scope capturedVars select:[:var | var name ~= 'self' and: [var sourceTemp == nil]]) + collect:[:var | self newVar: var]). + method := (RBMethodNode new) + selectorParts: (self + newSelectorParts: (self class dummySelector: args size)); + arguments: args; + body: sequenceNode; + primitiveNode: ir primitiveNode; + scope: scope. + sequenceNode parent: method. + Preferences compileBlocksAsClosures + ifFalse: [ASTFixDecompileBlockScope new visitNode: method]. + ^ method +! + +removeClosureCreation: seq + (Preferences compileBlocksAsClosures + and: [seq statements size > 0] + and: [seq statements first isClosureEnvironmentCreation]) ifTrue: [ + seq statements removeFirst. + (seq statements size > 0 + and: [seq statements first isClosureEnvironmentRegistration]) + ifTrue: [seq statements removeFirst]]. + + [Preferences compileBlocksAsClosures + and: [seq statements size > 0] + and: [seq statements first isClosureRegistrationAndCreation + or: [seq statements first isSelfClosureRegistration] + or: [seq statements first isTempClosureRegistration]]] + whileTrue: [seq statements removeFirst] +! + +scope: aLexicalScope + + scope := aLexicalScope +! ! + +!IRDecompiler methodsFor:'instructions'! + +goto: seqNum + + self stackPush: (RBPseudoGotoNode new destination: seqNum). +! + +if: bool goto: seqNum1 otherwise: seqNum2 + + self stackPush: (RBPseudoIfNode new + boolean: bool; + destination: seqNum1; + otherwise: seqNum2) +! + +label: seqNum + + stack isEmpty ifTrue: [ "start" + ^ stack addLast: (RBPseudoLabelNode new destination: seqNum)]. + + self captureEmptyStatement. + "Reduce jump structures to one of the following if possible" + [ (self endBlock: seqNum) or: [ + (self endAndOr: seqNum) or: [ + (self endAndOr2: seqNum) or: [ + (self endIfThen: seqNum) or: [ + (self endIfThen2: seqNum) or:[ + (self endIfThenElse: seqNum) or: [ + (self endCase: seqNum) or: [ + (self endToDo: seqNum) or: [ + (self endWhile: seqNum) or: [ + (self endWhile2: seqNum) or: [ + (self endIfNil: seqNum)]]]]]]]]]] + ] whileTrue. + + stack addLast: (RBPseudoLabelNode new destination: seqNum). +! + +popTop + + | value | + stack last ifNil: [^ stack removeLast]. "pop no-op from #simplifyTempAssign:" + [stack last isLabel + and: [(stack atLast:2) isGoto] + and: [stack last destination = (stack atLast: 2) destination]] + whileTrue: [ + stack removeLast. + stack removeLast]. + stack last isValue ifTrue: [ + (stack atLast: 2) isSequence ifTrue: [ + value := stack removeLast. + ^ stack last addNode: value. + ] ifFalse: [(stack atLast: 2) isPseudo ifTrue: [ + value := stack removeLast. + ^ stack addLast: (RBSequenceNode statements: {value}). + ]]. + ]. + stack addLast: RBPseudoPopNode new +! + +pushBlock: irMethod + + self block: irMethod env: nil +! + +pushBlockMethod: irMethod + + "block will recognized when send: #createBlock:" + self pushLiteral: irMethod +! + +pushDup + + stack addLast: RBPseudoDupNode new +! + +pushInstVar: index + + self stackPush: (self newVar: (scope instanceScope instVar: index)) +! + +pushLiteral: object + + self stackPush: (self newLiteral: object). +! + +pushLiteralVariable: object + + | var | + var := scope lookupVar: object key asString. + self stackPush: (self newVar: var) +! + +pushTemp: tempIndex + + | var | + var := scope basicTempVarAt: tempIndex. + var isTemp ifTrue: [var cantBeCapture]. + self stackPush: (self newVar: var). +! + +remoteReturn + + stack removeLast. "pop home context free var" + self goto: #return. +! + +returnTop + + self goto: #return. +! + +send: selector numArgs: numArgs + + | args rcvr | + selector = #caseError ifTrue:[^self stackPush: (RBPseudoSendNode new selector: selector)]. + args := OrderedCollection new. + [ selector numArgs timesRepeat: [args addFirst: self Value]. + rcvr := self Value. + ] on: Abort do: [ + [self stackPush: (RBPseudoSendNode new selector: selector). + ^self cascade] on: Abort do:[^false] + ]. + + Preferences compileBlocksAsClosures + ifTrue: [ (rcvr isLiteral and: [selector = #createBlock:]) ifTrue: [ + ^ self block: rcvr value env: args first]] + ifFalse: [ (selector = #blockCopy:) ifTrue: [ + ^ self stackPush: (RBPseudoSendNode new selector: selector; arguments: args)]]. + + self stackPush: (self simplify: (RBMessageNode new + receiver: rcvr + selectorParts: (self newSelectorParts: selector) + arguments: args)). + + "Created: / 01-12-2008 / 19:40:52 / Jan Vrany " +! + +send: selector numArgs: numArgs toSuperOf: behavior + + | args rcvr | + args := OrderedCollection new. + selector numArgs timesRepeat: [args addFirst: self Value]. + rcvr := self Value. + (rcvr isVariable and: [rcvr name = 'self']) ifFalse: [self patternError]. + + rcvr identifierToken: (SqueakToken value: 'super' start: 0). + self stackPush: (RBMessageNode new + receiver: rcvr + selectorParts: (self newSelectorParts: selector) + arguments: args). + + "Created: / 01-12-2008 / 19:45:52 / Jan Vrany " +! + +storeIntoLiteralVariable: association + + | var | + var := scope lookupVar: association key asString. + self stackPush: (self simplifyTempAssign: + (RBAssignmentNode variable: (self newVar: (var markWrite)) value: self Value)) +! + +storeTemp: tempIndex + + | var | + var := scope basicTempVarAt: tempIndex. + var isCaptured ifFalse: [var cantBeCapture]. + var isTemp ifTrue:[ + var isArg: false]. + self stackPush: (self simplifyTempAssign: + (RBAssignmentNode variable: (self newVar: (var markWrite)) value: self Value)). +! ! + +!IRDecompiler methodsFor:'interpret'! + +interpretInstruction: irInstruction + + currentInstr := irInstruction. + super interpretInstruction: irInstruction. +! + +interpretSequence: instructionSequence + + super interpretSequence: instructionSequence. + "currentInstr := nil." +! ! + +!IRDecompiler methodsFor:'old blocks'! + +blockReturnTop + + self goto: #return. +! + +endBlock: seqNum + + | blockSeq block goto startBlock | + [ + goto := self GotoOrReturn: seqNum. + (goto isRet + or:[goto mapInstr notNil + and: [goto mapInstr isBlockReturnTop]]) ifFalse: [self abort]. + sp = 0 ifTrue: [self abort]. + blockSeq := self Sequence2. + startBlock := self Label. + block := self Block. + (goto isRet not + and:[goto mapInstr notNil] + and: [goto mapInstr isBlockReturnTop] + and: [block successor ~= seqNum]) ifTrue:[ + self stackPush: block. + self stackPush: startBlock. + self stackPush: blockSeq. + self stackPush: goto. + self abort]. + self Send. + ] on: Abort do: [^ false]. + + self stackPush: (self newBlock: blockSeq return: goto). + stack last arguments: block arguments. + "No extra scope is need if we don't use any temporaries and arguments. + so we remove them" + (stack last arguments isEmpty and: [stack last body temporaries isEmpty]) + ifTrue:[ASTReplaceVariableScope replace: stack last scope: scope outerScope ]. + scope := scope outerScope. + currentInstr := nil. + self goto: block successor. + ^ true +! + +jumpOverBlock: seqNum1 to: seqNum2 + | numArgs args oldscope pseudoBlock | + + oldscope := scope. + self scope: (scope newBlockScope). + oldscope tempVarAt: 0. + (scope addObjectTemp: (oldscope tempVarAt: 0)). + numArgs := stack last arguments first value. + self stackPush: (pseudoBlock := RBPseudoBlockNode new). + + args := OrderedCollection new. + numArgs timesRepeat: [ | var instr | + instr := currentInstr blockSequence removeFirst. + var := oldscope tempVarAt: instr number. + args add: (self newVar: var). + var isUnused ifTrue: [oldscope removeTempFromOldBlock: var]. + scope addObjectTemp: var. + currentInstr blockSequence first isPop + ifFalse: [ + currentInstr blockSequence sequence addFirst: (IRInstruction pushTemp: var index)] + ifTrue:[currentInstr blockSequence removeFirst]. + + ]. + args := args reverse. + pseudoBlock + block: seqNum1; + successor: seqNum2; + arguments: args + +! + +storeInstVar: number + + | var | + var := scope instanceScope instVar: number. + self stackPush: (RBAssignmentNode variable: (self newVar: var) value: self Value) +! ! + +!IRDecompiler methodsFor:'priv instructions'! + +addReturn: statements from: goto + + | ret | + statements last isReturn ifTrue:[^self]. + ret := RBReturnNode value: statements last. + Preferences compileBlocksAsClosures ifTrue:[ + scope isHome ifFalse: [ret homeBinding: scope outerEnvScope thisEnvVar]]. + goto mapInstr sourceNode: ret. + statements atLast: 1 put: ret. +! + +block: method env: envRefNode + + self stackPush: (IRDecompiler new + scope: (scope newBlockScope "capturedVars: vars"); + decompileIR: method ir) + asBlock +! + +cascade + + | messages selector args rcvr | + messages := OrderedCollection new. + "last message" + selector _ self Send selector. + args := OrderedCollection new. + selector numArgs timesRepeat: [args addFirst: self Value]. + messages addFirst: selector -> args. + + "rest of messages" + [(rcvr := self ValueOrNone) isNil] whileTrue: [ + self Pop. + selector := self Send selector. + args := OrderedCollection new. + selector numArgs timesRepeat: [args addFirst: self Value]. + self Dup. + messages addFirst: selector -> args. + ]. + + messages := messages collect: [:assoc | + RBMessageNode + receiver: rcvr + selector: assoc key + arguments: assoc value]. + self stackPush: (RBCascadeNode messages: messages). +! + +endAndOr2: seqNum + + | goto seq p if2 test else o if1 seqValue elseTest otherwise | + [ + goto _ self Goto. + seqValue _ self ValueOrNone. + seq _ self Sequence. + p _ self Label destination. + if2 _ self IfGoto: seqNum otherwise: p. + elseTest _ self Value. + else _ self SequenceBackTo: goto destination. + o _ self Label destination. + o = goto destination ifTrue: [self abort]. + if1 _ self IfGoto: seqNum otherwise: o. + test _ self Value. + ] on: Abort do: [^ false]. + + if1 boolean = if2 boolean + ifFalse: [ + otherwise := RBSequenceNode statements: #(). + otherwise addNode: (self newLiteral: if2 boolean). + self stackPush: (RBMessageNode + receiver: test + selector: (if2 boolean ifTrue: [#ifTrue:ifFalse:] ifFalse: [#ifFalse:ifTrue:]) + arguments: {self newBlock: (else addNode: elseTest). + self newBlock: otherwise}).] + ifTrue:[self stackPush: (RBMessageNode + receiver: test + selector: (if2 boolean ifTrue: [#or:] ifFalse: [#and:]) + arguments: {self newBlock: (else addNode: elseTest)})]. + stack addLast: if2. + self label: p. + stack addLast: seq. + seqValue ifNotNil: [stack addLast: seqValue]. + stack addLast: goto. + ^ true +! + +endAndOr: seqNum + + | o test branches if body block sel1 sel2 if2 | + branches := OrderedCollection new. + [ + (if2 := self If) otherwise = seqNum ifFalse: [self abort]. + [ test := self Value. + body := self Sequence. + branches add: {body. test}. + o := self Label destination. + (if := self If) otherwise = o ifFalse: [self abort]. + if destination = seqNum + ] whileFalse: [ + if boolean = if2 boolean ifFalse: [self abort]. + if destination = if2 destination ifFalse: [self abort]. + ]. + if boolean = if2 boolean ifTrue: [self abort]. + test := self Value. + ] on: Abort do: [^ false]. + + if boolean + ifTrue: [sel1 := #or:. sel2 := #and:] + ifFalse: [sel1 := #and:. sel2 := #or:]. + block := self newBlock: (branches first first addNode: branches first second). + branches allButFirstDo: [:pair | + block := self newBlock: (pair first addNode: (RBMessageNode + receiver: pair second + selector: sel2 + arguments: {block})). + ]. + self stackPush: (RBMessageNode + receiver: test + selector: sel1 + arguments: {block}). + stack addLast: if2. + ^ true +! + +endCase: seqNum + + | otherwiseGoto goto node otherwiseValue otherwiseSeq n branchValue branchSeq f caseValue caseSeq rcvr branches message seqEnd afterOterwise seq afterOterwiseValue | + branches := OrderedCollection new. + [ "otherwise" + otherwiseGoto := self Goto. + node := self stackDown. + node isSequence ifTrue: [(node statements size = 1 + and:[node statements first isSend] + and: [ + node := node statements first. + node selector == #caseError]) ifFalse: [ + otherwiseSeq := node] ]. + (node isPop or: [node isSend and: [node selector == #caseError]]) ifTrue: [ + node isPop ifTrue: [node := self Send]. + node selector == #caseError ifFalse: [self abort]. + ] ifFalse: [ + sp := sp + 1. "stackUp" + + seqNum == #lastReturn + ifFalse: [ + otherwiseValue := self ValueOrNone. + otherwiseSeq := self Sequence] + ifTrue: [ + afterOterwiseValue := self ValueOrNone. + otherwiseSeq := RBSequenceNode statements: #(). + afterOterwise := self SequenceOtherwise]. + ]. + n := self Label destination. + "last case branch" + seqNum == #lastReturn + ifFalse: [goto := self GotoOrReturn: seqNum] + ifTrue: [ + seqEnd := n. + goto := self GotoOrReturn: n. + otherwiseGoto := goto]. + branchValue := self ValueOrNone. + branchSeq := self Sequence. + (stack at: sp) isPop ifTrue: [self stackDown]. + f := self Label destination. + + "last case" + self IfGoto: n otherwise: f. + self Send selector == #= ifFalse: [self abort]. + caseValue := self Value. + caseSeq := self Sequence. + otherwiseSeq ifNil: [self Dup]. + branches addFirst: ({caseSeq. caseValue} -> {branchSeq. branchValue. goto}). + + [(rcvr := self ValueOrNone) isNil] whileTrue: [ + "case branch" + n := self Label destination. + seqNum == #lastReturn + ifFalse: [goto := self GotoOrReturn: seqNum] + ifTrue: [goto := self GotoOrReturn: seqEnd]. + branchValue := self ValueOrNone. + branchSeq := self Sequence. + self Pop. + f := self Label destination. + "case" + self IfGoto: n otherwise: f. + self Send selector == #= ifFalse: [self abort]. + caseValue := self Value. + caseSeq := self Sequence. + self Dup. + branches addFirst: ({caseSeq. caseValue} -> {branchSeq. branchValue. goto}). + ]. + ] on: Abort do: [^ false]. + + branches := branches collect: [:assoc | + assoc key second + ifNotNil: [assoc key first addNode: assoc key second]. + assoc value second + ifNotNil: [assoc value first addNode: assoc value second]. + RBMessageNode + receiver: (self newBlock: assoc key first return: nil) + selector: #-> + arguments: + {self newBlock: assoc value first return: assoc value third} + ]. + message := otherwiseSeq + ifNil: [ + RBMessageNode + receiver: rcvr + selector: #caseOf: + arguments: {RBArrayNode statements: branches}] + ifNotNil: [ + otherwiseValue + ifNotNil: [otherwiseSeq addNode: otherwiseValue]. + RBMessageNode + receiver: rcvr + selector: #caseOf:otherwise: + arguments: + {RBArrayNode statements: branches. + self newBlock: otherwiseSeq return: otherwiseGoto}. + ]. + self stackPush: message. + seqNum == #lastReturn ifTrue: [ + self popTop. + seq := self Sequence. + afterOterwise ifNotNil:[seq statements addAllLast: afterOterwise statements]. + self stackPush: seq. + afterOterwiseValue ifNotNil:[self stackPush: afterOterwiseValue]. + branchValue := 1]. + branchValue ifNil: [self popTop]. + self stackPush: otherwiseGoto. + ^ true +! + +endIfNil: seqNum + + | goto branch o if rcvr value | + [ + goto := self Goto. + value := self Value. + branch := self Sequence. + self Pop. + o := self Label destination. + if := self IfGoto: seqNum otherwise: o. + self Send selector == #== ifFalse: [self abort]. + (self Value isLiteral: [:v | v isNil]) ifFalse: [self abort]. + self Dup. + rcvr := self Value. + ] on: Abort do: [^ false]. + + branch addNode: value. + self stackPush: (RBMessageNode + receiver: rcvr + selector: (if boolean ifTrue: [#ifNotNil:] ifFalse: [#ifNil:]) + arguments: {self newBlock: branch return: goto}). + self goto: seqNum. + ^ true +! + +endIfThen2: seqNum + + | goto branch o if test value gotoNum branch2 | + [ + goto := self Goto. + (goto mapInstr ~= nil + and: [goto mapInstr isJump] + and: [goto mapInstr destination size = 1] + and: [goto mapInstr destination last isJump]) + ifTrue: [gotoNum := goto + mapInstr destination last destination orderNumber] + ifFalse:[self abort]. + (currentInstr ~= nil + and: [currentInstr isJump] + and: [currentInstr destination orderNumber = goto destination]) + ifFalse: [self abort]. + value := self Value. + branch := self Sequence. + o := self Label destination. + seqNum = gotoNum + ifFalse:[if := self IfGoto: gotoNum otherwise: o] + ifTrue:[self abort]. + test := self Value. + ] on: Abort do: [^ false]. + + value ifNotNil: [branch addNode: value]. + branch2 := RBSequenceNode statements: #(). + branch2 addNode: (self newLiteral: if boolean). + self stackPush: (self simplify: (RBMessageNode + receiver: test + selector: (if boolean ifTrue: [#ifFalse:ifTrue:] ifFalse: [#ifTrue:ifFalse:]) + arguments: {self newBlock: branch return: goto. + self newBlock: branch2})). + self goto: goto destination. + ^true +! + +endIfThen3: seqNum + + | goto branch o if test value | + [ + goto := self Goto. + (goto destination == seqNum or: [self isExplicitReturn: goto]) + ifFalse: [self abort]. + goto isRet ifTrue: [value := self Value]. + branch := self Sequence. + o := self Label destination. + if := self If. + ((if destination = seqNum + or: [if destination = (mapEmptyStatement at: seqNum ifAbsent:[seqNum])]) + and: [if otherwise = o]) + ifFalse:[self abort]. + test := self Value. + ] on: Abort do: [^ false]. + + + value ifNotNil: [branch addNode: value]. + self stackPush: (self simplify: (RBMessageNode + receiver: test + selector: (if boolean ifTrue: [#ifFalse:] ifFalse: [#ifTrue:]) + arguments: {self newBlock: branch return: goto})). + self popTop. + self goto: seqNum. + ^ true +! + +endIfThen: seqNum + + | goto branch o if test value | + [ + goto := self Goto. + (goto destination == seqNum or: [self isExplicitReturn: goto]) + ifFalse: [self abort]. + goto isRet ifTrue: [value := self Value]. + branch := self Sequence. + o := self Label destination. + if := self IfGoto: seqNum otherwise: o. + test := self Value. + ] on: Abort do: [^ false]. + + + value ifNotNil: [branch addNode: value]. + self stackPush: (self simplify: (RBMessageNode + receiver: test + selector: (if boolean ifTrue: [#ifFalse:] ifFalse: [#ifTrue:]) + arguments: {self newBlock: branch return: goto})). + self popTop. + self goto: seqNum. + ^ true +! + +endIfThenElse: seqNum + + | goto2 else d goto1 then o if test value2 value1 | + [ + goto2 := self Goto. + value2 := self ValueOrNone. + else := self Sequence. + d := self Label destination. + goto1 := self Goto. + ((self isExplicitReturn: goto2) or: [goto2 destination == goto1 destination]) ifFalse: [self abort]. + value1 := self ValueOrNone. + then := self Sequence. + o := self Label destination. + if := self IfGoto: d otherwise: o. + test := self Value. + ] on: Abort do: [^ false]. + + value2 ifNotNil: [else addNode: value2]. + value1 ifNotNil: [then addNode: value1]. + (self isExplicitReturn: goto1) ifTrue:[self addReturn: then statements from: goto1]. + (self isExplicitReturn: goto2) ifTrue:[self addReturn: else statements from: goto2]. + self stackPush: (self simplify: (else isEmpty + ifTrue: [RBMessageNode + receiver: test + selector: (if boolean ifTrue: [#ifFalse:] ifFalse: [#ifTrue:]) + arguments: {self newBlock: then return: goto1}] + ifFalse: [RBMessageNode + receiver: test + selector: (if boolean + ifTrue: [#ifFalse:ifTrue:] + ifFalse: [#ifTrue:ifFalse:]) + arguments: { + self newBlock: then return: goto1. + self newBlock: else return: goto2}])). + value1 ifNil: [self popTop]. + currentInstr := goto1 mapInstr. + self stackPush: goto1. + (else statements isEmpty and: + [stack anySatisfy: [:n | n isIf and: [n destination = d]]] + ) ifTrue: [ + self label: d. + currentInstr := goto2 mapInstr. + self stackPush: goto2. + ]. + ^ true +! + +endToDo: seqNum + + | start limit incr iter step loopBlock o if test limitExpr init | + [ + start := self Goto destination. + limit := self Value. + incr := self Assignment. + iter := incr variable. + (incr value isMessage and: + [incr value selector == #+ and: + [incr value receiver isVariable and: + [incr value receiver binding == iter binding]]] + ) ifFalse: [self abort]. + step := incr value arguments first. + loopBlock := self Sequence. + o := self Label destination. + if := self IfGoto: seqNum otherwise: o. + test := self Value. + (test isMessage and: + [(test selector == #<= or: [test selector == #>=]) and: + [(valueLabelMap at: test arguments first ifAbsent: [self abort]) destination = start]] + ) ifFalse: [self abort]. + limitExpr := test arguments first. + limitExpr isAssignment ifTrue: [ + (limitExpr variable binding index == limit binding index + and:[limitExpr variable binding scope == limit binding scope]) ifFalse: [self abort]. + limitExpr := limitExpr value. + ]. + init := test receiver. + (init isAssignment and: [init variable binding == iter binding]) + ifFalse: [self abort]. + ] on: Abort do: [^ false]. + limit isVariable + ifTrue:[scope + removeTemp: limit binding + ifAbsent:[Preferences compileBlocksAsClosures + ifFalse:[scope removeTempFromOldBlock: limit]]]. + loopBlock := self newBlock: loopBlock. + loopBlock arguments: {iter}. + self stackPush: ((step isLiteral: [:c | c = 1]) + ifTrue: [RBMessageNode + receiver: init value + selector: #to:do: + arguments: {limitExpr. loopBlock}] + ifFalse: [RBMessageNode + receiver: init value + selector: #to:by:do: + arguments: {limitExpr. step. loopBlock}]). + self popTop. + self goto: seqNum. + ^ true +! + +endWhile2: seqNum + + | start loopBlock if test sequence o goto previousStack | + [ + stack := (previousStack := stack) copy. + start := (goto := self Goto) destination. + self stackPush: goto. + [self endIfThen3: start] whileTrue. + start := self Goto destination. + loopBlock _ self Sequence. + o _ self Label destination. + if _ self IfGoto: seqNum otherwise: o. + test _ self Value. + sequence _ self SequenceBackTo: start. + self Label: start. + sp _ sp + 1. "stackUp" + ] on: Abort do: [stack := previousStack. ^ false]. + loopBlock isEmpty + ifTrue:[self stackPush: (self simplify: (RBMessageNode + receiver: (self newBlock: (sequence addNode: test)) + selector: (if boolean ifTrue: [#whileFalse] ifFalse: [#whileTrue]) + arguments: #()))] + ifFalse:[self stackPush: (self simplify: (RBMessageNode + receiver: (self newBlock: (sequence addNode: test)) + selector: (if boolean ifTrue: [#whileFalse:] ifFalse: [#whileTrue:]) + arguments: {self newBlock: loopBlock}))]. + self popTop. + self goto: seqNum. + ^ true +! + +endWhile: seqNum + + | start loopBlock if test sequence o | + [ + start _ self Goto destination. + loopBlock _ self Sequence. + o _ self Label destination. + if _ self IfGoto: seqNum otherwise: o. + test _ self Value. + sequence _ self SequenceBackTo: start. + self Label: start. + sp _ sp + 1. "stackUp" + ] on: Abort do: [^ false]. + loopBlock isEmpty + ifTrue:[self stackPush: (self simplify: (RBMessageNode + receiver: (self newBlock: (sequence addNode: test)) + selector: (if boolean ifTrue: [#whileFalse] ifFalse: [#whileTrue]) + arguments: #()))] + ifFalse:[self stackPush: (self simplify: (RBMessageNode + receiver: (self newBlock: (sequence addNode: test)) + selector: (if boolean ifTrue: [#whileFalse:] ifFalse: [#whileTrue:]) + arguments: {self newBlock: loopBlock}))]. + self popTop. + self goto: seqNum. + ^ true +! ! + +!IRDecompiler methodsFor:'private'! + +captureEmptyStatement + | by replace node | + + [by := self Goto destination. + replace := self Label destination. + replace = 0 ifTrue: [self abort]] + on: Abort + do: [^ false]. + mapEmptyStatement at: by put: replace. + sp := nil. + ^ true +! + +fixInnerFreeVar: aRcvrTemp + + | scopeInnerFreeVar | + scopeInnerFreeVar := scope outerScope. + [aRcvrTemp scope = scopeInnerFreeVar] whileFalse:[ + scopeInnerFreeVar hasInnerFreeVars: true. + scopeInnerFreeVar := scopeInnerFreeVar outerScope]. + aRcvrTemp scope hasInnerFreeVars: true +! + +initialize + + stack := OrderedCollection new. + scope := nil parseScope newMethodScope. "in case never set" + valueLabelMap := IdentityDictionary new. + mapEmptyStatement := IdentityDictionary new +! + +isExplicitReturn: goto + + Preferences compileBlocksAsClosures + ifTrue:[^ goto isRet + and: [goto mapInstr notNil] + and: [goto mapInstr isRemote or: [scope isBlockScope not]]] + ifFalse: [^goto isRet and: [goto mapInstr isBlockReturnTop not]] +! + +mapNode: node + + currentInstr ifNil: [^ self]. + node isPseudo + ifTrue: [node mapInstr: currentInstr] + ifFalse: [currentInstr sourceNode: node] +! + +newBlock: sequence + + ^ self newBlock: sequence return: nil +! + +newBlock: sequence return: goto + + | statements block | + statements := sequence statements. + (goto notNil and: [self isExplicitReturn: goto]) ifTrue: [ + self addReturn: statements from: goto + ]. + sequence statements: statements. + block := RBBlockNode body: sequence. + sequence parent: block. + Preferences compileBlocksAsClosures ifFalse: [block scope: scope]. + ^block +! + +newLiteral: literal + + ^ RBLiteralNode value: literal +! + +newSelectorParts: selector + + ^ selector keywords collect: [:word | + RBLiteralToken value: word] +! + +newVar: semVar + + ^ RBVariableNode new + identifierToken: (RBIdentifierToken value: semVar name start: 0); + binding: semVar +! + +simplify: mess + "mess is a messageNode. If it is a message created by the compiler convert it back to its normal form" + + | rcvr var | +" (mess selector == #value and: [mess receiver isLiteral]) ifTrue: [ + ^ self newVar: (GlobalVar new assoc: mess receiver value; scope: scope) + ]." + + (mess selector = #privSetInHolder: and: [mess arguments first isLiteral]) ifTrue: [ + ^ RBAssignmentNode + variable: (self newVar: (GlobalVar new assoc: mess arguments first value; scope: scope) markWrite) + value: mess receiver + ]. + + (mess selector = #privGetInstVar: and: + [mess arguments first isLiteral and: + [mess receiver isVariable]]) ifTrue: [ + rcvr := mess receiver binding. + rcvr == scope receiverVar ifTrue: [ + ^ self newVar: (scope receiverVarAt: mess arguments first value)]. + (rcvr isContextVar and: [mess arguments first value == 5]) ifTrue: [ + var := scope tempVarAt: -1. + ^self newVar: var]. + (rcvr isCaptured and:[rcvr sourceTemp = rcvr scope receiverVar]) + ifTrue:[ + self fixInnerFreeVar: rcvr. + ^self newVar: (rcvr scope receiverVarAt: mess arguments first value)]. + rcvr isEnv ifTrue: [^self newVar: (rcvr scope captureVarAt: mess arguments first value)]]. + + (mess selector = #privStoreIn:instVar: and: + [mess arguments last isLiteral and: + [mess arguments first isVariable]]) ifTrue: [ + rcvr := mess arguments first binding. + (mess receiver name = 'self' and: [rcvr isEnv]) + ifTrue:[scope captureSelf: mess arguments last value. + ^mess]. + rcvr == scope receiverVar ifTrue: [^ RBAssignmentNode + variable: (self newVar: (scope receiverVarForAssignmentAt: mess arguments last value) markWrite) + value: mess receiver]. + (rcvr isCaptured and:[rcvr sourceTemp = rcvr scope receiverVar]) + ifTrue:[ + self fixInnerFreeVar: rcvr. + ^RBAssignmentNode + variable: (self newVar: (rcvr scope receiverVarForAssignmentAt: mess arguments last value) markWrite) + value: mess receiver]. + mess isClosureEnvironmentRegistration + ifTrue: [ + scope captureSelf: mess arguments last value. + ^mess]. + rcvr isEnv ifTrue:[ + mess receiver isTemp + ifTrue:[var := (scope + captureVarAt: mess arguments last value + sourceTemp: mess receiver binding) markWrite.] + ifFalse:[var := (scope + captureVarAt: mess arguments last value sourceTemp: ((TempVar new) + name: (scope captureVarName: mess arguments last value); + index: mess arguments last value; + scope: self; + cantBeCapture)) markWrite + ]. + ^ RBAssignmentNode + variable: (self newVar: var) + value: mess receiver]]. + ^mess +! + +simplifyTempAssign: assignment + "If it is a assignment created by the compiler convert it back to its normal form" + + | mess | + ((mess := assignment value) isMessage and: + [mess selector = #wrapInTempHolder and: + [mess receiver isLiteral: [:v | v isNil]]] + ) ifTrue: [ + ^ nil "no-op" + ]. + + ^ assignment +! ! + +!IRDecompiler methodsFor:'stack'! + +Assignment + + | node | + (node := self stackDown) isAssignment ifTrue: [^ node]. + self abort +! + +Block + + | node | + (node := self stackDown) isBlock ifTrue: [^ node]. + self abort +! + +Dup + + | node | + (node := self stackDown) isDup ifTrue: [^ node]. + self abort +! + +Goto + + | node | + (node := self stackDown) isGoto ifTrue: [^ node]. + self abort +! + +Goto: seqNum + + | goto | + (goto := self Goto) destination = seqNum ifTrue: [^ goto]. + self abort +! + +GotoOrReturn: seqNum + + | goto | + goto := self Goto. + (goto destination = seqNum or: [goto isRet]) ifTrue: [^ goto]. + self abort +! + +If + + | node | + (node := self stackDown) isIf ifTrue: [^ node]. + self abort +! + +IfGoto: seqNum otherwise: seqNum2 + + | if | + ((if := self If) destination = seqNum and: [if otherwise = seqNum2]) + ifTrue: [^ if]. + self abort +! + +Label + + | node | + (node := self stackDown) isLabel ifTrue: [^ node]. + self abort +! + +Label: seqNum + + | label | + (label := self Label) destination = seqNum ifTrue: [^ label]. + self abort +! + +Pop + + | node | + (node := self stackDown) isPop ifTrue: [^ node]. + self abort +! + +Send + + | node | + (node := self stackDown) isPseudoSend ifTrue: [^ node]. + self abort +! + +Sequence + | node seq i goto | + seq := RBSequenceNode statements: #(). + i := self spIndex. + [node := stack at: i. + node isSequence + ifTrue: + [seq addNodesFirst: node statements. + node := stack at: (i := i - 1)]. + (node isLabel and: [i > 1]) + ifFalse: + [sp := i. + ^ seq]. + goto := stack at: (i := i - 1). + goto isGoto and: [goto destination = node destination]] + whileTrue: [i := i - 1]. + sp := i + 1. + ^ seq +! + +Sequence2 + | node seq i block temps label | + seq := RBSequenceNode statements: #(). + i := self spIndex. + node := stack at: i. + [(node isLabel and: [(stack at: i - 1) isGoto] and:[node destination = (stack at: i - 1) destination]) + ifTrue:[ + i := i - 2. + node := stack at: i]. + (node isLabel not and: [i > 1])] whileTrue: + [ + node isSequence + ifTrue: [seq addNodesFirst: node statements] + ifFalse: [seq addNodeFirst: node]. + i := i - 1. + node := stack at: i]. + sp := i. + label := self Label. + block := self Block. + self stackPush: block. + self stackPush: label. + "Add the temporaries find" + temps := scope tempVars asArray allButFirst. + temps := temps select: [:each | ((block arguments + collect: [:var | var binding]) includes: each) not]. + seq temporaries: (temps collect: [:var | self newVar: var]). + ^ seq +! + +SequenceBackTo: labelNum + | node seq i goto | + seq := RBSequenceNode statements: #(). + i := self spIndex. + [node := stack at: i. + node isSequence + ifTrue: + [seq addNodesFirst: node statements. + node := stack at: (i := i - 1)]. + (node isLabel and: [i > 1]) + ifFalse: + [sp := i. + ^ seq]. + node destination = labelNum + ifTrue: + [sp := i. + ^ seq]. + goto := stack at: (i := i - 1). + goto isGoto and: [goto destination = node destination]] + whileTrue: [i := i - 1]. + sp := i + 1. + ^ seq +! + +SequenceOtherwise + | node seq i | + seq := RBSequenceNode statements: #(). + i := self spIndex. + node := stack at: i. + node isSequence ifTrue: [ + seq addNodesFirst: node statements. + self stackDown] + ifFalse:[node isLabel ifFalse:[self abort]]. + ^ seq +! + +Value + + | node | + node := self ValueOrNone. + node ifNil: [self abort]. + ^ node +! + +ValueOrNone + | node i label | + i := self spIndex. + [node := stack at: i. + node isValue + ifTrue: + [label ifNotNil: [valueLabelMap at: node put: label]. + sp := i - 1. + ^ node]. + (node isLabel and: [i > 1]) ifFalse: [^ nil]. + label := node. + node := stack at: (i := i - 1). + node isGoto and: [node destination = label destination]] + whileTrue: [i := i - 1]. + ^ nil +! + +abort + + | spWas | + spWas := sp. + sp := nil. + Abort signal +! + +fixStack + + sp ifNotNil: [stack removeLast: (stack size - sp)]. + sp := nil. +! + +spIndex + ^ sp ifNil: [sp := stack size] +! + +stackDown + + | node | + sp ifNil: [sp _ stack size]. + sp = 0 ifTrue: [self abort]. + node _ stack at: sp. + sp _ sp - 1. + ^ node +! + +stackPush: node + + self fixStack. + stack addLast: node. + node ifNil: [^ self]. "no op" + self mapNode: node. +! ! + +!IRDecompiler class methodsFor:'documentation'! + +version + ^ '$Id$' +! + +version_CVS + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRDecompiler.st,v 1.3 2009/10/08 12:04:20 fm Exp §' +! + +version_SVN + ^ '$Id:: $' +! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRDup.st --- a/IRDup.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRDup.st Thu Mar 29 18:03:58 2012 +0000 @@ -21,13 +21,13 @@ !IRDup class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRDup.st,v 1.3 2009/10/08 11:57:50 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRDup.st,v 1.3 2009/10/08 11:57:50 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRDup.st,v 1.3 2009/10/08 11:57:50 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRFunction.st --- a/IRFunction.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRFunction.st Thu Mar 29 18:03:58 2012 +0000 @@ -50,23 +50,6 @@ "Modified: / 12-08-2009 / 09:22:05 / Jan Vrany " ! -addTempsIfNotDefined: temps - - | ir tempsToAdd | - ir := self. - tempsToAdd := temps asSet. - [ ir isNil ] whileFalse: - [ir tempNames do: - [:temp| - (tempsToAdd includes:temp) - ifTrue:[tempsToAdd remove: temp]]. - ir := ir environmentIr]. - tempsToAdd isEmpty ifTrue:[^self]. - self addTemps: tempsToAdd - - "Created: / 23-03-2010 / 13:51:15 / Jan Vrany " -! - additionalLiterals ^additionalLiterals. ! @@ -110,10 +93,6 @@ ^self allInstructionsMatching: [:bc | bc isTempStore]. ! -environmentIr - ^ environmentIr -! - ir ^self. ! @@ -195,12 +174,11 @@ inspector2TabIRCode ^Tools::Inspector2Tab new - label: 'IR Code'; - priority: 75; - text: self longPrintString. + label: 'IR Code'; + priority: 75; + view: ((ScrollableView for:TextView) contents: self longPrintString; yourself) "Created: / 11-06-2008 / 01:05:16 / Jan Vrany " - "Modified: / 15-02-2010 / 13:04:55 / Jan Vrany " ! ! !IRFunction methodsFor:'decompiling'! @@ -500,13 +478,13 @@ !IRFunction class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRFunction.st,v 1.4 2009/10/08 11:59:08 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRFunction.st,v 1.4 2009/10/08 11:59:08 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRFunction.st,v 1.4 2009/10/08 11:59:08 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRInstVarAccess.st --- a/IRInstVarAccess.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRInstVarAccess.st Thu Mar 29 18:03:58 2012 +0000 @@ -30,13 +30,13 @@ !IRInstVarAccess class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarAccess.st,v 1.3 2009/10/08 12:01:34 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarAccess.st,v 1.3 2009/10/08 12:01:34 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarAccess.st,v 1.3 2009/10/08 12:01:34 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRInstVarRead.st --- a/IRInstVarRead.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRInstVarRead.st Thu Mar 29 18:03:58 2012 +0000 @@ -30,13 +30,13 @@ !IRInstVarRead class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarRead.st,v 1.3 2009/10/08 11:56:08 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarRead.st,v 1.3 2009/10/08 11:56:08 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarRead.st,v 1.3 2009/10/08 11:56:08 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRInstVarStore.st --- a/IRInstVarStore.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRInstVarStore.st Thu Mar 29 18:03:58 2012 +0000 @@ -33,13 +33,13 @@ !IRInstVarStore class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarStore.st,v 1.3 2009/10/08 11:59:32 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarStore.st,v 1.3 2009/10/08 11:59:32 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstVarStore.st,v 1.3 2009/10/08 11:59:32 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRInstruction.st --- a/IRInstruction.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRInstruction.st Thu Mar 29 18:03:58 2012 +0000 @@ -409,13 +409,13 @@ !IRInstruction class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstruction.st,v 1.3 2009/10/08 11:55:09 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstruction.st,v 1.3 2009/10/08 11:55:09 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInstruction.st,v 1.3 2009/10/08 11:55:09 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRInterpreter.st --- a/IRInterpreter.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRInterpreter.st Thu Mar 29 18:03:58 2012 +0000 @@ -111,13 +111,13 @@ !IRInterpreter class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInterpreter.st,v 1.3 2009/10/08 11:58:54 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInterpreter.st,v 1.3 2009/10/08 11:58:54 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRInterpreter.st,v 1.3 2009/10/08 11:58:54 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRJump.st --- a/IRJump.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRJump.st Thu Mar 29 18:03:58 2012 +0000 @@ -52,13 +52,13 @@ !IRJump class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJump.st,v 1.3 2009/10/08 12:01:23 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJump.st,v 1.3 2009/10/08 12:01:23 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJump.st,v 1.3 2009/10/08 12:01:23 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRJumpIf.st --- a/IRJumpIf.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRJumpIf.st Thu Mar 29 18:03:58 2012 +0000 @@ -61,13 +61,13 @@ !IRJumpIf class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJumpIf.st,v 1.3 2009/10/08 12:05:24 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJumpIf.st,v 1.3 2009/10/08 12:05:24 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJumpIf.st,v 1.3 2009/10/08 12:05:24 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRJumpOverBlock.st --- a/IRJumpOverBlock.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRJumpOverBlock.st Thu Mar 29 18:03:58 2012 +0000 @@ -40,13 +40,13 @@ !IRJumpOverBlock class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJumpOverBlock.st,v 1.3 2009/10/08 11:56:16 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJumpOverBlock.st,v 1.3 2009/10/08 11:56:16 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRJumpOverBlock.st,v 1.3 2009/10/08 11:56:16 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRLine.st --- a/IRLine.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRLine.st Thu Mar 29 18:03:58 2012 +0000 @@ -34,13 +34,13 @@ !IRLine class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLine.st,v 1.3 2009/10/08 12:03:44 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLine.st,v 1.3 2009/10/08 12:03:44 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLine.st,v 1.3 2009/10/08 12:03:44 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRLiteralVariableAccess.st --- a/IRLiteralVariableAccess.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRLiteralVariableAccess.st Thu Mar 29 18:03:58 2012 +0000 @@ -33,13 +33,13 @@ !IRLiteralVariableAccess class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableAccess.st,v 1.3 2009/10/08 11:59:04 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableAccess.st,v 1.3 2009/10/08 11:59:04 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableAccess.st,v 1.3 2009/10/08 11:59:04 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRLiteralVariableRead.st --- a/IRLiteralVariableRead.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRLiteralVariableRead.st Thu Mar 29 18:03:58 2012 +0000 @@ -27,13 +27,13 @@ !IRLiteralVariableRead class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableRead.st,v 1.3 2009/10/08 12:03:40 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableRead.st,v 1.3 2009/10/08 12:03:40 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableRead.st,v 1.3 2009/10/08 12:03:40 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRLiteralVariableStore.st --- a/IRLiteralVariableStore.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRLiteralVariableStore.st Thu Mar 29 18:03:58 2012 +0000 @@ -27,13 +27,13 @@ !IRLiteralVariableStore class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableStore.st,v 1.3 2009/10/08 11:56:40 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableStore.st,v 1.3 2009/10/08 11:56:40 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRLiteralVariableStore.st,v 1.3 2009/10/08 11:56:40 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRMethod.st --- a/IRMethod.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRMethod.st Thu Mar 29 18:03:58 2012 +0000 @@ -52,13 +52,13 @@ !IRMethod class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRMethod.st,v 1.3 2009/10/08 11:56:48 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRMethod.st,v 1.3 2009/10/08 11:56:48 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRMethod.st,v 1.3 2009/10/08 11:56:48 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRPop.st --- a/IRPop.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRPop.st Thu Mar 29 18:03:58 2012 +0000 @@ -27,13 +27,13 @@ !IRPop class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRPop.st,v 1.3 2009/10/08 11:57:32 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRPop.st,v 1.3 2009/10/08 11:57:32 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRPop.st,v 1.3 2009/10/08 11:57:32 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRPrinter.st --- a/IRPrinter.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRPrinter.st Thu Mar 29 18:03:58 2012 +0000 @@ -210,13 +210,13 @@ !IRPrinter class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRPrinter.st,v 1.3 2009/10/08 12:00:24 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRPrinter.st,v 1.3 2009/10/08 12:00:24 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRPrinter.st,v 1.3 2009/10/08 12:00:24 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRReturn.st --- a/IRReturn.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRReturn.st Thu Mar 29 18:03:58 2012 +0000 @@ -42,13 +42,13 @@ !IRReturn class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRReturn.st,v 1.3 2009/10/08 12:01:32 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRReturn.st,v 1.3 2009/10/08 12:01:32 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRReturn.st,v 1.3 2009/10/08 12:01:32 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRSend.st --- a/IRSend.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRSend.st Thu Mar 29 18:03:58 2012 +0000 @@ -78,13 +78,13 @@ !IRSend class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSend.st,v 1.3 2009/10/08 12:03:48 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSend.st,v 1.3 2009/10/08 12:03:48 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSend.st,v 1.3 2009/10/08 12:03:48 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRSequence.st --- a/IRSequence.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRSequence.st Thu Mar 29 18:03:58 2012 +0000 @@ -407,13 +407,13 @@ !IRSequence class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSequence.st,v 1.3 2009/10/08 11:59:45 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSequence.st,v 1.3 2009/10/08 11:59:45 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRSequence.st,v 1.3 2009/10/08 11:59:45 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRStackCount.st --- a/IRStackCount.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRStackCount.st Thu Mar 29 18:03:58 2012 +0000 @@ -121,13 +121,13 @@ !IRStackCount class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRStackCount.st,v 1.3 2009/10/08 11:59:57 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRStackCount.st,v 1.3 2009/10/08 11:59:57 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRStackCount.st,v 1.3 2009/10/08 11:59:57 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRTempAccess.st --- a/IRTempAccess.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRTempAccess.st Thu Mar 29 18:03:58 2012 +0000 @@ -59,13 +59,13 @@ !IRTempAccess class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempAccess.st,v 1.3 2009/10/08 12:03:42 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempAccess.st,v 1.3 2009/10/08 12:03:42 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempAccess.st,v 1.3 2009/10/08 12:03:42 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRTempRead.st --- a/IRTempRead.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRTempRead.st Thu Mar 29 18:03:58 2012 +0000 @@ -29,13 +29,13 @@ !IRTempRead class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempRead.st,v 1.3 2009/10/08 12:00:10 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempRead.st,v 1.3 2009/10/08 12:00:10 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempRead.st,v 1.3 2009/10/08 12:00:10 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRTempStore.st --- a/IRTempStore.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRTempStore.st Thu Mar 29 18:03:58 2012 +0000 @@ -29,13 +29,13 @@ !IRTempStore class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempStore.st,v 1.3 2009/10/08 12:04:11 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempStore.st,v 1.3 2009/10/08 12:04:11 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTempStore.st,v 1.3 2009/10/08 12:04:11 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRTransformTest.st --- a/IRTransformTest.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRTransformTest.st Thu Mar 29 18:03:58 2012 +0000 @@ -60,13 +60,12 @@ (iRMethod allSequences last) last delete. (iRMethod allSequences last) - addInstructions: (Array with:(IRInstruction pushLiteral: 2) with: (IRInstruction returnTop)). + addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)}. aCompiledMethod := iRMethod compiledCode. self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2]. "Modified: / 30-03-2009 / 19:40:10 / Jan Vrany " - "Modified: / 07-05-2011 / 14:17:58 / Jan Vrany " ! testAddIntructionsBefore @@ -83,13 +82,12 @@ push := (iRMethod allSequences last) at: (iRMethod allSequences size - 1) . (iRMethod allSequences last) - addInstructions: (Array with:(IRInstruction pushLiteral: 2) with: (IRInstruction returnTop)) before: push. + addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)} before: push. aCompiledMethod := iRMethod compiledCode. self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2]. "Modified: / 30-03-2009 / 19:40:21 / Jan Vrany " - "Modified: / 07-05-2011 / 14:18:33 / Jan Vrany " ! testAddIntructionsBeforeFromLList @@ -165,13 +163,13 @@ !IRTransformTest class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTransformTest.st,v 1.3 2009/10/08 11:56:52 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTransformTest.st,v 1.3 2009/10/08 11:56:52 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTransformTest.st,v 1.3 2009/10/08 11:56:52 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff IRTranslator.st --- a/IRTranslator.st Tue Nov 15 21:28:05 2011 +0000 +++ b/IRTranslator.st Thu Mar 29 18:03:58 2012 +0000 @@ -167,11 +167,10 @@ kind == #BArg ifTrue:[^gen pushBlockArg: index]. kind == #BVar ifTrue:[^gen pushBlockVar: index]. - self error:'Should never be reached'. + self halt:'Should never be reached'. "Created: / 30-03-2009 / 14:06:28 / Jan Vrany " "Modified: / 30-03-2009 / 19:02:32 / Jan Vrany " - "Modified: / 09-04-2010 / 15:05:48 / Jan Vrany " ! remoteReturn @@ -372,13 +371,13 @@ !IRTranslator class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTranslator.st,v 1.3 2009/10/08 12:04:47 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTranslator.st,v 1.3 2009/10/08 12:04:47 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/IRTranslator.st,v 1.3 2009/10/08 12:04:47 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff Make.proto --- a/Make.proto Tue Nov 15 21:28:05 2011 +0000 +++ b/Make.proto Thu Mar 29 18:03:58 2012 +0000 @@ -1,7 +1,7 @@ # $Header$ # # DO NOT EDIT -# automagically generated from the projectDefinition: cvut_stx_goodies_newcompiler. +# automagically generated from the projectDefinition: cvut_stx_goodies_newcompiler at 2012-03-29 19:04:24.824. # # Warning: once you modify this file, do not rerun # stmkmp or projectDefinition-build again - otherwise, your changes are lost. @@ -34,7 +34,7 @@ # add the path(es) here:, # ********** OPTIONAL: MODIFY the next lines *** # LOCALINCLUDES=-Ifoo -Ibar -LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libwidg -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libcompat -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libcomp -I$(INCLUDE_TOP)/stx/libtool +LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libwidg -I$(INCLUDE_TOP)/stx/goodies/libtool3 -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic2 -I$(INCLUDE_TOP)/stx/libcompat -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libcomp -I$(INCLUDE_TOP)/stx/libtool # if you need any additional defines for embedded C code, @@ -44,7 +44,7 @@ LOCALDEFINES= LIBNAME=libcvut_stx_goodies_newcompiler -STCLOCALOPT='-package=$(PACKAGE)' -I. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -H. -varPrefix=$(LIBNAME) +STCLOCALOPT='-package=$(PACKAGE)' -I. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -headerDir=. -varPrefix=$(LIBNAME) # ********** OPTIONAL: MODIFY the next line *** @@ -63,17 +63,31 @@ all:: preMake classLibRule postMake -pre_objs:: update-svn-revision +pre_objs:: + -update-svn-revision: - if [ ! -r .svnversion -o "$(shell svnversion -n)" != "$(shell cat .svnversion)" ]; then \ - svnversion -n > .svnversion; \ - sed -i -e "s/\"\$$SVN\-Revision:\".*\"\$$\"/\"\$$SVN-Revision:\"'$(shell svnversion -n)'\"\$$\"/g" \ - cvut_stx_goodies_newcompiler.st; \ +# Update SVN revision in stx_libbasic3.st +ifneq (,$(findstring .svn,$(wildcard .svn))) +.svnversion: *.st + if [ -d .svn ]; then \ + rev=$(shell svnversion -n); \ + echo -n $$rev > .svnversion; \ + else \ + echo -n exported > .svnversion; \ fi -.PHONY: update-svn-revision + +cvut_stx_goodies_newcompiler.o: cvut_stx_goodies_newcompiler.st .svnversion + if [ -d .svn ]; then \ + rev2="$(shell printf "%-16s" $$(cat .svnversion))"; \ + sed -e "s/\"\$$SVN\-Revision:\".*\"\$$\"/\"\$$SVN-Revision:\"\'$$rev2\'\"\$$\"/g" $< > .cvut_stx_goodies_newcompiler.svn.st; \ + fi + $(MAKE) CC="$(CLASSLIB_CC)" OPT="$(OPT)" SEPINITCODE="$(SEPINITCODE)" STC="$(STC)" STFILE=.cvut_stx_goodies_newcompiler.svn $(O_RULE); + mv .cvut_stx_goodies_newcompiler.svn.$(O) cvut_stx_goodies_newcompiler.$(O) +endif + + # add more install actions here @@ -90,20 +104,22 @@ prereq: $(REQUIRED_SUPPORT_DIRS) cd $(TOP)/libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" + cd $(TOP)/goodies/libtool3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/goodies/refactoryBrowser/parser && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libcomp && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd $(TOP)/libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" + cd $(TOP)/libdb && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libboss && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd $(TOP)/goodies/xml/vw && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" + cd $(TOP)/libdb/libodbc && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" + cd $(TOP)/libdb/libsqlite && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/goodies/sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libui && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd $(TOP)/goodies/xml/stx && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" + cd $(TOP)/libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libwidg && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" + cd $(TOP)/libhtml && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libwidg2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" - cd $(TOP)/libwidg3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libtool && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/libcompat && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" cd $(TOP)/librun && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)" @@ -111,6 +127,7 @@ cleanjunk:: + -rm -f *.s *.s2 clean:: -rm -f *.o *.H @@ -131,6 +148,7 @@ $(OUTDIR)IRAccess.$(O) IRAccess.$(H): IRAccess.st $(INCLUDE_TOP)/cvut/stx/goodies/newcompiler/IRInstruction.$(H) $(INCLUDE_TOP)/stx/libbasic/Link.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)IRClosure.$(O) IRClosure.$(H): IRClosure.st $(INCLUDE_TOP)/cvut/stx/goodies/newcompiler/IRFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)IRConstant.$(O) IRConstant.$(H): IRConstant.st $(INCLUDE_TOP)/cvut/stx/goodies/newcompiler/IRInstruction.$(H) $(INCLUDE_TOP)/stx/libbasic/Link.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) +$(OUTDIR)IRDecompiler.$(O) IRDecompiler.$(H): IRDecompiler.st $(INCLUDE_TOP)/cvut/stx/goodies/newcompiler/IRInterpreter.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)IRDup.$(O) IRDup.$(H): IRDup.st $(INCLUDE_TOP)/cvut/stx/goodies/newcompiler/IRInstruction.$(H) $(INCLUDE_TOP)/stx/libbasic/Link.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)IRJump.$(O) IRJump.$(H): IRJump.st $(INCLUDE_TOP)/cvut/stx/goodies/newcompiler/IRInstruction.$(H) $(INCLUDE_TOP)/stx/libbasic/Link.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) $(OUTDIR)IRLine.$(O) IRLine.$(H): IRLine.st $(INCLUDE_TOP)/cvut/stx/goodies/newcompiler/IRInstruction.$(H) $(INCLUDE_TOP)/stx/libbasic/Link.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR) diff -r 1bfd09c6b3d8 -r be8c2dd09dff Make.spec --- a/Make.spec Tue Nov 15 21:28:05 2011 +0000 +++ b/Make.spec Thu Mar 29 18:03:58 2012 +0000 @@ -1,7 +1,7 @@ # $Header$ # -# DO NOT EDIT -# automagically generated from the projectDefinition: cvut_stx_goodies_newcompiler. +# DO NOT EDIT +# automagically generated from the projectDefinition: cvut_stx_goodies_newcompiler at 2012-03-29 19:04:23.686. # # Warning: once you modify this file, do not rerun # stmkmp or projectDefinition-build again - otherwise, your changes are lost. @@ -18,7 +18,7 @@ # Argument(s) to the stc compiler (stc --usage). -# -H. : create header files locally +# -headerDir=. : create header files locally # (if removed, they will be created as common # -Pxxx : defines the package # -Zxxx : a prefix for variables within the classLib @@ -61,6 +61,7 @@ IRAccess \ IRClosure \ IRConstant \ + IRDecompiler \ IRDup \ IRJump \ IRLine \ @@ -98,6 +99,7 @@ $(OUTDIR)IRAccess.$(O) \ $(OUTDIR)IRClosure.$(O) \ $(OUTDIR)IRConstant.$(O) \ + $(OUTDIR)IRDecompiler.$(O) \ $(OUTDIR)IRDup.$(O) \ $(OUTDIR)IRJump.$(O) \ $(OUTDIR)IRLine.$(O) \ diff -r 1bfd09c6b3d8 -r be8c2dd09dff Makefile --- a/Makefile Tue Nov 15 21:28:05 2011 +0000 +++ b/Makefile Thu Mar 29 18:03:58 2012 +0000 @@ -1,7 +1,7 @@ # -# DO NOT EDIT +# DO NOT EDIT # -# make uses this file (Makefile) only, if there is no +# make uses this file (Makefile) only, if there is no # file named "makefile" (lower-case m) in the same directory. # My only task is to generate the real makefile and call make again. # Thereafter, I am no longer used and needed. @@ -16,4 +16,4 @@ include Make.proto makefile: - $(TOP)/rules/stmkmf + $(TOP)/rules/stmkmf diff -r 1bfd09c6b3d8 -r be8c2dd09dff abbrev.stc --- a/abbrev.stc Tue Nov 15 21:28:05 2011 +0000 +++ b/abbrev.stc Thu Mar 29 18:03:58 2012 +0000 @@ -1,16 +1,20 @@ +# automagically generated by the project definition +# this file is needed for stc to be able to compile modules independently. +# it provides information about a classes filename, category and especially namespace. IRBuilder IRBuilder cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 -IRBuilderTest IRBuilderTest cvut:stx/goodies/newcompiler 'NewCompiler-IR-Tests' 4 +IRBuilderTest IRBuilderTest cvut:stx/goodies/newcompiler 'NewCompiler-IR-Tests' 1 IRBytecodeGenerator IRBytecodeGenerator cvut:stx/goodies/newcompiler 'NewCompiler-Bytecode' 0 IRFunction IRFunction cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRInstruction IRInstruction cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRInterpreter IRInterpreter cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRSequence IRSequence cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRStackCount IRStackCount cvut:stx/goodies/newcompiler 'NewCompiler-Bytecode' 0 -IRTransformTest IRTransformTest cvut:stx/goodies/newcompiler 'NewCompiler-IR-Tests' 4 -cvut_stx_goodies_newcompiler cvut_stx_goodies_newcompiler cvut:stx/goodies/newcompiler '* Projects & Packages *' 4 +IRTransformTest IRTransformTest cvut:stx/goodies/newcompiler 'NewCompiler-IR-Tests' 1 +cvut_stx_goodies_newcompiler cvut_stx_goodies_newcompiler cvut:stx/goodies/newcompiler '* Projects & Packages *' 3 IRAccess IRAccess cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRClosure IRClosure cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRConstant IRConstant cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 +IRDecompiler IRDecompiler cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRDup IRDup cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRJump IRJump cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 IRLine IRLine cvut:stx/goodies/newcompiler 'NewCompiler-IR' 0 diff -r 1bfd09c6b3d8 -r be8c2dd09dff bc.mak --- a/bc.mak Tue Nov 15 21:28:05 2011 +0000 +++ b/bc.mak Thu Mar 29 18:03:58 2012 +0000 @@ -1,18 +1,24 @@ # $Header$ # # DO NOT EDIT -# automagically generated from the projectDefinition: cvut_stx_goodies_newcompiler. +# automagically generated from the projectDefinition: cvut_stx_goodies_newcompiler at 2012-03-29 19:04:25.464. # # Warning: once you modify this file, do not rerun # stmkmp or projectDefinition-build again - otherwise, your changes are lost. # -# This file contains make rules for the win32 platform (using borland-bcc). +# Notice, that the name bc.mak is historical (from times, when only borland c was supported). +# This file contains make rules for the win32 platform using either borland-bcc or visual-c. # It shares common definitions with the unix-make in Make.spec. -# The nt.mak supports the following targets: +# The bc.mak supports the following targets: # bmake - compile all st-files to a classLib (dll) # bmake clean - clean all temp files # bmake clobber - clean all # +# Historic Note: +# this used to contain only rules to make with borland +# (called via bmake, by "make.exe -f bc.mak") +# this has changed; it is now also possible to build using microsoft visual c +# (called via vcmake, by "make.exe -f bc.mak -DUSEVC") # TOP=..\..\..\..\stx INCLUDE_TOP=$(TOP)\.. @@ -28,10 +34,10 @@ -LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libwidg -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libcompat -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libcomp -I$(INCLUDE_TOP)\stx\libtool +LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libwidg -I$(INCLUDE_TOP)\stx\goodies\libtool3 -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic2 -I$(INCLUDE_TOP)\stx\libcompat -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libcomp -I$(INCLUDE_TOP)\stx\libtool LOCALDEFINES= -STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -H. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME) +STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME) LOCALLIBS= OBJS= $(COMMON_OBJS) $(WIN32_OBJS) @@ -45,20 +51,22 @@ # build all prerequisite packages for this package prereq: pushd ..\..\..\..\stx\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " + pushd ..\..\..\..\stx\goodies\libtool3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\goodies\refactoryBrowser\parser & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libcomp & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\..\..\stx\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " + pushd ..\..\..\..\stx\libdb & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libboss & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\..\..\stx\goodies\xml\vw & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " + pushd ..\..\..\..\stx\libdb\libodbc & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " + pushd ..\..\..\..\stx\libdb\libsqlite & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\goodies\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libui & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\..\..\stx\goodies\xml\stx & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " + pushd ..\..\..\..\stx\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libwidg & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " + pushd ..\..\..\..\stx\libhtml & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libwidg2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " - pushd ..\..\..\..\stx\libwidg3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libtool & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\libcompat & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " pushd ..\..\..\..\stx\librun & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) " @@ -66,6 +74,7 @@ + # BEGINMAKEDEPEND --- do not remove this line; make depend needs it $(OUTDIR)IRBuilder.$(O) IRBuilder.$(H): IRBuilder.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)IRBytecodeGenerator.$(O) IRBytecodeGenerator.$(H): IRBytecodeGenerator.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) @@ -78,6 +87,7 @@ $(OUTDIR)IRAccess.$(O) IRAccess.$(H): IRAccess.st $(INCLUDE_TOP)\cvut\stx\goodies\newcompiler\IRInstruction.$(H) $(INCLUDE_TOP)\stx\libbasic\Link.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)IRClosure.$(O) IRClosure.$(H): IRClosure.st $(INCLUDE_TOP)\cvut\stx\goodies\newcompiler\IRFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)IRConstant.$(O) IRConstant.$(H): IRConstant.st $(INCLUDE_TOP)\cvut\stx\goodies\newcompiler\IRInstruction.$(H) $(INCLUDE_TOP)\stx\libbasic\Link.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) +$(OUTDIR)IRDecompiler.$(O) IRDecompiler.$(H): IRDecompiler.st $(INCLUDE_TOP)\cvut\stx\goodies\newcompiler\IRInterpreter.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)IRDup.$(O) IRDup.$(H): IRDup.st $(INCLUDE_TOP)\cvut\stx\goodies\newcompiler\IRInstruction.$(H) $(INCLUDE_TOP)\stx\libbasic\Link.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)IRJump.$(O) IRJump.$(H): IRJump.st $(INCLUDE_TOP)\cvut\stx\goodies\newcompiler\IRInstruction.$(H) $(INCLUDE_TOP)\stx\libbasic\Link.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) $(OUTDIR)IRLine.$(O) IRLine.$(H): IRLine.st $(INCLUDE_TOP)\cvut\stx\goodies\newcompiler\IRInstruction.$(H) $(INCLUDE_TOP)\stx\libbasic\Link.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR) diff -r 1bfd09c6b3d8 -r be8c2dd09dff bmake.bat --- a/bmake.bat Tue Nov 15 21:28:05 2011 +0000 +++ b/bmake.bat Thu Mar 29 18:03:58 2012 +0000 @@ -3,6 +3,6 @@ @REM type bmake, and wait... @REM do not edit - automatically generated from ProjectDefinition @REM ------- -make.exe -N -f bc.mak %1 %2 +make.exe -N -f bc.mak %* diff -r 1bfd09c6b3d8 -r be8c2dd09dff cvut_stx_goodies_newcompiler.st --- a/cvut_stx_goodies_newcompiler.st Tue Nov 15 21:28:05 2011 +0000 +++ b/cvut_stx_goodies_newcompiler.st Thu Mar 29 18:03:58 2012 +0000 @@ -11,48 +11,37 @@ !cvut_stx_goodies_newcompiler class methodsFor:'description'! preRequisites - "list all required packages. - This list can be maintained manually or (better) generated and - updated by scanning the superclass hierarchies and looking for - global variable accesses. (the browser has a menu function for that) - Howevery, often too much is found, and you may want to explicitely - exclude individual packages in the #excludedFromPrerequisites method." - ^ #( - #'stx:goodies/refactoryBrowser/parser' + #'stx:goodies/libtool3' "Tools::Inspector2Tab - referenced by IRFunction>>inspector2TabIRCode " + #'stx:goodies/refactoryBrowser/parser' "RBIdentifierToken - referenced by IRDecompiler>>newVar: " #'stx:goodies/sunit' "TestCase - superclass of IRTransformTest " #'stx:libbasic' "Link - superclass of IRLine " #'stx:libbasic2' "OrderedDictionary - referenced by IRBytecodeGenerator>>initialize " #'stx:libcomp' "PrimitiveNode - referenced by IRFunction>>initialize " - #'stx:libcompat' - #'stx:libtool' "Tools::Inspector2Tab - referenced by IRFunction>>inspector2TabIRCode " - #'stx:libwidg' + #'stx:libcompat' "Preferences - referenced by IRDecompiler>>removeClosureCreation: " + #'stx:libwidg' "ScrollableView - referenced by IRFunction>>inspector2TabIRCode " ) ! ! !cvut_stx_goodies_newcompiler class methodsFor:'description - contents'! classNamesAndAttributes - "lists the classes which are to be included in the project. - Each entry in the list may be: a single class-name (symbol), - or an array-literal consisting of class name and attributes. - Attributes are: #autoload or # where os is one of win32, unix,..." - ^ #( " or ( attributes...) in load order" IRBuilder - (IRBuilderTest autoload) + IRBuilderTest IRBytecodeGenerator IRFunction IRInstruction IRInterpreter IRSequence IRStackCount - (IRTransformTest autoload) + IRTransformTest #'cvut_stx_goodies_newcompiler' IRAccess IRClosure IRConstant + IRDecompiler IRDup IRJump IRLine @@ -78,9 +67,6 @@ ! extensionMethodNames - "lists the extension methods which are to be included in the project. - Entries are 2-element array literals, consisting of class-name and selector." - ^ #( ByteCodeCompiler literalArray: Class binding @@ -124,23 +110,32 @@ !cvut_stx_goodies_newcompiler class methodsFor:'description - svn'! +svnRepositoryUrlString + "Return a SVN repository URL of myself. + (Generated since 2011-04-08) + Do not make the string shorter!!!!!! We have to use fixed-length keyword!!!!!! + " + + ^ '$URL:: $' +! + svnRevisionNr "Return a SVN revision number of myself. This number is updated after a commit" - ^ "$SVN-Revision:"'34M'"$" + ^ "$SVN-Revision:"'nil '"$" ! ! !cvut_stx_goodies_newcompiler class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/cvut_stx_goodies_newcompiler.st,v 1.4 2009/10/08 12:00:46 fm Exp $' + ^ '$Id$' ! version_CVS - ^ '$Header: /cvs/stx/cvut/stx/goodies/newcompiler/cvut_stx_goodies_newcompiler.st,v 1.4 2009/10/08 12:00:46 fm Exp $' + ^ '§Header: /cvs/stx/cvut/stx/goodies/newcompiler/cvut_stx_goodies_newcompiler.st,v 1.4 2009/10/08 12:00:46 fm Exp §' ! version_SVN - ^ '$Id$' + ^ '$Id:: $' ! ! diff -r 1bfd09c6b3d8 -r be8c2dd09dff extensions.st --- a/extensions.st Tue Nov 15 21:28:05 2011 +0000 +++ b/extensions.st Thu Mar 29 18:03:58 2012 +0000 @@ -1,6 +1,4 @@ -"{ Package: 'cvut:stx/goodies/newcompiler' }" - -! +"{ Package: 'cvut:stx/goodies/newcompiler' }"! !ByteCodeCompiler methodsFor:'accessing'! @@ -11,6 +9,7 @@ "Created: / 03-11-2008 / 14:09:33 / Jan Vrany " ! ! + !Class methodsFor:'accessing'! binding @@ -19,8 +18,18 @@ "Created: / 11-06-2008 / 11:20:35 / Jan Vrany " ! ! + +!Class methodsFor:'accessing'! + +bindingOf: classVarName + + ^(self fullName , ':' , classVarName) asSymbol + + "Created: / 11-06-2008 / 11:29:19 / Jan Vrany " +! ! + !cvut_stx_goodies_newcompiler class methodsFor:'documentation'! extensionsVersion_SVN - ^ '$Id$' -! ! + ^ '$Id:: $' +! ! \ No newline at end of file diff -r 1bfd09c6b3d8 -r be8c2dd09dff libInit.cc --- a/libInit.cc Tue Nov 15 21:28:05 2011 +0000 +++ b/libInit.cc Thu Mar 29 18:03:58 2012 +0000 @@ -38,6 +38,7 @@ _IRAccess_Init(pass,__pRT__,snd); _IRClosure_Init(pass,__pRT__,snd); _IRConstant_Init(pass,__pRT__,snd); +_IRDecompiler_Init(pass,__pRT__,snd); _IRDup_Init(pass,__pRT__,snd); _IRJump_Init(pass,__pRT__,snd); _IRLine_Init(pass,__pRT__,snd); diff -r 1bfd09c6b3d8 -r be8c2dd09dff newcompiler.rc --- a/newcompiler.rc Tue Nov 15 21:28:05 2011 +0000 +++ b/newcompiler.rc Thu Mar 29 18:03:58 2012 +0000 @@ -1,15 +1,17 @@ // -// DO NOT EDIT +// DO NOT EDIT // automagically generated from the projectDefinition: cvut_stx_goodies_newcompiler. // VS_VERSION_INFO VERSIONINFO - FILEVERSION 6,1,33,33 - PRODUCTVERSION 6,1,2,1 + FILEVERSION 6,2,0,1 + PRODUCTVERSION 6,2,1,1 +#if (__BORLANDC__) FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD FILEOS VOS_NT_WINDOWS32 FILETYPE VFT_DLL FILESUBTYPE VS_USER_DEFINED +#endif BEGIN BLOCK "StringFileInfo" @@ -18,12 +20,12 @@ BEGIN VALUE "CompanyName", "CVUT FEI & Mathieu Suen\0" VALUE "FileDescription", "Smalltalk/X Bytecode generation library based on Squeak's NewCompiler (LIB)\0" - VALUE "FileVersion", "6.1.33.33\0" + VALUE "FileVersion", "6.2.0.1\0" VALUE "InternalName", "cvut:stx/goodies/newcompiler\0" VALUE "LegalCopyright", "Copyright Jan Vrany & Mathieu Suen 2008\0" VALUE "ProductName", "NewCompiler\0" - VALUE "ProductVersion", "6.1.2.1\0" - VALUE "ProductDate", "Sat, 07 May 2011 13:19:03 GMT\0" + VALUE "ProductVersion", "6.2.1.1\0" + VALUE "ProductDate", "Thu, 29 Mar 2012 18:04:25 GMT\0" END END diff -r 1bfd09c6b3d8 -r be8c2dd09dff vcmake.bat --- a/vcmake.bat Tue Nov 15 21:28:05 2011 +0000 +++ b/vcmake.bat Thu Mar 29 18:03:58 2012 +0000 @@ -3,6 +3,10 @@ @REM type vcmake, and wait... @REM do not edit - automatically generated from ProjectDefinition @REM ------- -make.exe -N -f bc.mak -DUSEVC %1 %2 + +@if not defined VSINSTALLDIR ( + call "C:\Program Files\Microsoft Visual Studio 10.0"\VC\bin\vcvars32.bat +) +make.exe -N -f bc.mak -DUSEVC %*