VarNode.st
author Stefan Vogel <sv@exept.de>
Fri, 06 Mar 1998 16:38:37 +0100
changeset 657 0ecf1ff6f6bf
parent 642 de97c93c4f49
child 719 9ccbae6ba13e
permissions -rw-r--r--
Fix #makeMethod:

"
 COPYRIGHT (c) 1994 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

PrimaryNode subclass:#VariableNode
	instanceVariableNames:'name token index block'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Compiler-Support'
!

!VariableNode class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1994 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    node for parse-trees, representing variables
    This is a helper class for the compiler.

    [author:]
        Claus Gittinger
"
! !

!VariableNode class methodsFor:'instance creation'!

type:t class:class name:n
    ^ (self basicNew) type:t class:class name:n
!

type:t context:aContext
    ^ (self basicNew) type:t context:aContext

    "Created: / 17.1.1998 / 04:00:35 / cg"
!

type:t name:n
    ^ (self basicNew) type:t name:n
!

type:t name:n context:aContext index:i
    ^ (self basicNew) type:t name:n context:aContext index:i

    "Created: / 17.1.1998 / 02:40:32 / cg"
!

type:t name:n index:i selfClass:s
    ^ (self basicNew) type:t name:n index:i selfClass:s
!

type:t name:n index:i selfValue:s
    ^ (self basicNew) type:t name:n index:i selfValue:s
!

type:t name:n token:tok index:i
    ^ (self basicNew) type:t name:n token:tok index:i
!

type:t name:n token:tok index:i block:b from:codeBlock
    ^ (self basicNew) type:t name:n token:tok index:i block:b from:codeBlock

    "Modified: 2.7.1997 / 10:55:48 / cg"
! !

!VariableNode methodsFor:'accessing'!

block
    ^ block

    "Created: 2.7.1997 / 18:53:38 / cg"
!

index
    ^ index
!

name
    ^ name
!

type:t class:class name:n
    type := t.
    name := n.
    value := class

    "Modified: / 17.1.1998 / 04:03:55 / cg"
!

type:t context:aContext
    type := t.
    value := aContext.

    "Modified: / 17.1.1998 / 04:01:55 / cg"
!

type:t name:n
    type := t.
    value := nil.
    name := n
!

type:t name:n context:aContext index:i
    type := t.
    index := i.
    value := aContext.
    name := n

    "Created: / 17.1.1998 / 02:40:55 / cg"
    "Modified: / 17.1.1998 / 04:01:21 / cg"
!

type:t name:n index:i selfClass:s
    type := t.
    index := i.
    value := s.
    name := n

    "Modified: / 17.1.1998 / 04:04:04 / cg"
!

type:t name:n index:i selfValue:s
    type := t.
    index := i.
    value := s.
    name := n

    "Modified: / 17.1.1998 / 04:02:58 / cg"
!

type:t name:n token:tok index:i
    type := t.
    index := i.
    token := tok.
    name := n
!

type:t name:n token:tok index:i block:variableBlock from:codeBlock
    type := t.
    index := i.
    block := variableBlock.
    token := tok.
    name := n.
    (type == #BlockArg) ifTrue:[
        variableBlock blockArgAccessed:true.
    ].

    codeBlock ~~ variableBlock ifTrue:[
        codeBlock rememberOuterBlockVarAccess:self
    ]

    "Created: 2.7.1997 / 10:54:50 / cg"
    "Modified: 2.7.1997 / 11:12:58 / cg"
!

type:t token:tok index:i block:b
    type := t.
    index := i.
    block := b.
    token := tok.

    (type == #BlockArg) ifTrue:[
        b blockArgAccessed:true.
    ].

    "Modified: 18.6.1997 / 11:41:05 / cg"
! !

!VariableNode methodsFor:'code generation'!

codeForSideEffectOn:aStream inBlock:b for:aCompiler
    "no code at all"
    ^ self
!

codeLoadOn:aStream type:type index:index inBlock:codeBlock for:aCompiler
    |theCode b deltaLevel litIndex specialGlobalIndex
     bvIdx bvTyp blocksCode|

    (type == #MethodArg) ifTrue:[
        (index <= 4) ifTrue:[
            aStream nextPut:(#(pushMethodArg1
                               pushMethodArg2
                               pushMethodArg3 
                               pushMethodArg4) at:index).
            ^ self
        ].
        aStream nextPut:#pushMethodArg; nextPut:index.
        ^ self
    ].

    (type == #MethodVariable) ifTrue:[
        (index <= 6) ifTrue:[
            aStream nextPut:(#(pushMethodVar1
                               pushMethodVar2
                               pushMethodVar3
                               pushMethodVar4
                               pushMethodVar5
                               pushMethodVar6) at:index).
            ^ self
        ].
        aStream nextPut:#pushMethodVar; nextPut:index.
        ^ self
    ].

    (type == #InstanceVariable) ifTrue:[
        (index <= 10) ifTrue:[
            theCode := #(pushInstVar1 pushInstVar2 pushInstVar3
                         pushInstVar4 pushInstVar5 pushInstVar6
                         pushInstVar7 pushInstVar8 pushInstVar9
                         pushInstVar10) at:index.
            aStream nextPut:theCode.
            ^ self
        ].
        aStream nextPut:#pushInstVar; nextPut:index.
        ^ self
    ].

    ((type == #BlockArg) 
    or:[type == #BlockVariable]) ifTrue:[
        "/ compiling for codeBlock; accessing variable in block.

        bvIdx := index.
        bvTyp := type.

        "/ find the context where that variable is contained physically
        blocksCode := block.
        [blocksCode notNil and:[blocksCode isInlineBlock]] whileTrue:[
            blocksCode := blocksCode home
        ].

        "/ find deltaLevel from code-context to the containing block
        b := codeBlock.
        deltaLevel := 0.
        [b notNil and:[b ~~ blocksCode]] whileTrue:[
            b isInlineBlock ifFalse:[
                deltaLevel := deltaLevel + 1
            ].
            b := b home
        ].

        b isNil ifTrue:[
            codeBlock isNil ifTrue:[
                "/ a var of a block which is inlined in the method. 
                "/ Generate a pushMVAR

                bvIdx := block indexOfFirstTemp + index - 1.
                type == #BlockVariable ifTrue:[
                    bvIdx := bvIdx + block numArgs
                ].
                ^ self 
                    codeLoadOn:aStream
                    type:#MethodVariable
                    index:bvIdx
                    inBlock:codeBlock
                    for:aCompiler
            ].

            "/ a var of a block which is inlined in the outer block.
            "/ Generate a pushBVAR

            bvIdx := block indexOfFirstTemp + index - 1.
            type == #BlockVariable ifTrue:[
                bvIdx := bvIdx + block numArgs
            ].
            bvTyp := #BlockVariable.
        ] ifFalse:[
            block isInlineBlock ifTrue:[
                "/ a var of a block which is inlined in another block.
                "/ Generate a pushBVAR / pushOuterBVAR
                bvIdx := block indexOfFirstTemp + index - 1.
                type == #BlockVariable ifTrue:[
                    bvIdx := bvIdx + block numArgs
                ].
                bvTyp := #BlockVariable.
            ]
        ].

        (bvTyp == #BlockVariable) ifTrue:[
            (deltaLevel == 0) ifTrue:[
                bvIdx <= 3 ifTrue:[
                    aStream nextPut:(#(pushBlockVar1 pushBlockVar2 pushBlockVar3) at:bvIdx).
                    ^ self
                ].
                aStream nextPut:#pushBlockVar.
            ] ifFalse:[
                aStream nextPut:#pushOuterBlockVar; nextPut:deltaLevel.
            ].
        ] ifFalse:[
            (deltaLevel == 0) ifTrue:[
                (bvIdx <= 4) ifTrue:[
                    aStream nextPut:(#(pushBlockArg1 pushBlockArg2 pushBlockArg3
                                       pushBlockArg4) at:bvIdx).
                    ^ self
                ].
                aStream nextPut:#pushBlockArg.
            ] ifFalse:[
                (deltaLevel == 1) ifTrue:[
                    aStream nextPut:#pushOuter1BlockArg
                ] ifFalse:[
                    (deltaLevel == 2) ifTrue:[
                        aStream nextPut:#pushOuter2BlockArg
                    ] ifFalse:[
                        aStream nextPut:#pushOuterBlockArg; nextPut:deltaLevel
                    ]
                ].
            ].
        ].
        aStream nextPut:bvIdx.
        ^ self
    ].

    (type == #GlobalVariable) ifTrue:[
        litIndex := aCompiler addLiteral:name asSymbol.
        specialGlobalIndex := aCompiler specialGlobalCodeFor:name.
        specialGlobalIndex notNil ifTrue:[
            aStream nextPut:#pushSpecialGlobal; nextPut:specialGlobalIndex.
            ^ self
        ].

        litIndex < 256 ifTrue:[
            aStream nextPut:#pushGlobalS; nextPut:litIndex
        ] ifFalse:[
            aStream nextPut:#pushGlobalL; nextPut:litIndex; nextPut:0
        ].
        ^ self
    ].

    (type == #ClassVariable) ifTrue:[
        litIndex := aCompiler addLiteral:(value name , ':' , name) asSymbol.
        litIndex < 256 ifTrue:[
            aStream nextPut:#pushClassVarS; nextPut:litIndex
        ] ifFalse:[
            aStream nextPut:#pushClassVarL; nextPut:litIndex; nextPut:0
        ].
        ^ self
    ].

    (type == #PrivateClass) ifTrue:[
        litIndex := aCompiler addLiteral:(value name , '::' , name) asSymbol.
        litIndex < 256 ifTrue:[
            aStream nextPut:#pushGlobalS; nextPut:litIndex
        ] ifFalse:[
            aStream nextPut:#pushGlobalL; nextPut:litIndex; nextPut:0
        ].
        ^ self
    ].

    (type == #ClassInstanceVariable) ifTrue:[
        aStream nextPut:#pushClassInstVar; nextPut:index.
        ^ self
    ].

    (type == #ThisContext) ifTrue:[
        aStream nextPut:#pushThisContext. ^ self
    ].

    "not reached"
    self halt:'bad type'.

    "Created: / 25.6.1997 / 16:14:17 / cg"
    "Modified: / 17.1.1998 / 04:04:17 / cg"
!

codeOn:aStream inBlock:codeBlock for:aCompiler
    self
        codeLoadOn:aStream type:type index:index inBlock:codeBlock for:aCompiler

    "Modified: 26.6.1997 / 10:06:10 / cg"
!

codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded for:aCompiler
    self
        codeStoreOn:aStream type:type index:index
        inBlock:codeBlock valueNeeded:valueNeeded for:aCompiler

    "Modified: 25.6.1997 / 16:15:28 / cg"
!

codeStoreOn:aStream type:type index:index inBlock:codeBlock valueNeeded:valueNeeded for:aCompiler
    |theCode b deltaLevel litIndex bvIdx blocksCode|

    valueNeeded ifTrue:[
        aStream nextPut:#dup
    ].

    (type == #MethodVariable) ifTrue:[
        (index <= 6) ifTrue:[
            theCode := #(storeMethodVar1 storeMethodVar2
                         storeMethodVar3 storeMethodVar4
                         storeMethodVar5 storeMethodVar6) at:index.
            aStream nextPut:theCode.
            ^ self
        ].
        aStream nextPut:#storeMethodVar; nextPut:index.
        ^ self
    ].

    (type == #InstanceVariable) ifTrue:[
        (index <= 10) ifTrue:[
            theCode := #(storeInstVar1 storeInstVar2
                         storeInstVar3 storeInstVar4
                         storeInstVar5 storeInstVar6
                         storeInstVar7 storeInstVar8
                         storeInstVar9 storeInstVar10) at:index.
            aStream nextPut:theCode.
            ^ self
        ].
        aStream nextPut:#storeInstVar; nextPut:index.
        ^ self
    ].

    (type == #BlockVariable) ifTrue:[
        bvIdx := index.
        
        "/ find the context where that variable is contained physically
        blocksCode := block.
        [blocksCode notNil and:[blocksCode isInlineBlock]] whileTrue:[
            blocksCode := blocksCode home
        ].

        "find deltaLevel to block, where variable was defined"
        b := codeBlock.
        deltaLevel := 0.
        [b notNil and:[b ~~ blocksCode]] whileTrue:[
            b isInlineBlock ifFalse:[
                deltaLevel := deltaLevel + 1
            ].
            b := b home
        ].

        b isNil ifTrue:[
            codeBlock isNil ifTrue:[
                "/ a block which is inlined in the method. 
                "/ Generate a pushMVAR

                bvIdx := block indexOfFirstTemp + index - 1.
                bvIdx := bvIdx + block numArgs.
                ^ self
                    codeStoreOn:aStream 
                    type:#MethodVariable index:bvIdx 
                    inBlock:codeBlock 
                    valueNeeded:false       "/ already dupped if value is needed
                    for:aCompiler
            ].
            "/ a var of a block which is inlined in the outer block.
            "/ Generate a pushBVAR

            bvIdx := block indexOfFirstTemp + index - 1.
            bvIdx := bvIdx + block numArgs.
        ] ifFalse:[
            block isInlineBlock ifTrue:[
                "/ a var of a block which is inlined in another block.
                "/ Generate a pushBVAR / pushOuterBVAR
                bvIdx := block indexOfFirstTemp + index - 1.
                bvIdx := bvIdx + block numArgs.
            ]
        ].

        (deltaLevel == 0) ifTrue:[
            bvIdx <= 3 ifTrue:[
                aStream nextPut:(#(storeBlockVar1 storeBlockVar2 storeBlockVar3) at:bvIdx).
                ^ self
            ].
            aStream nextPut:#storeBlockVar
        ] ifFalse:[
            aStream nextPut:#storeOuterBlockVar; nextPut:deltaLevel
        ].
        aStream nextPut:bvIdx.
        ^ self
    ].

    (type == #GlobalVariable) ifTrue:[
        litIndex := aCompiler addLiteral:name asSymbol.
        litIndex < 256 ifTrue:[
            aStream nextPut:#storeGlobalS; nextPut:litIndex
        ] ifFalse:[
            aStream nextPut:#storeGlobalL; nextPut:litIndex; nextPut:0
        ].
        ^ self
    ].

    (type == #ClassVariable) ifTrue:[
        litIndex := aCompiler addLiteral:(value name , ':' , name) asSymbol.
        litIndex < 256 ifTrue:[
            aStream nextPut:#storeClassVarS; nextPut:litIndex
        ] ifFalse:[
            aStream nextPut:#storeClassVarL; nextPut:litIndex; nextPut:0
        ].
        ^ self
    ].

    (type == #ClassInstanceVariable) ifTrue:[
        aStream nextPut:#storeClassInstVar; nextPut:index.
        ^ self
    ].

    "not reached"
    ^ self error:'bad assignment'

    "Created: / 25.6.1997 / 16:14:40 / cg"
    "Modified: / 17.1.1998 / 04:04:23 / cg"
! !

!VariableNode methodsFor:'enumeration'!

nodeDo:anEnumerator
    "helper for parse tree walking"

    ^ anEnumerator doVariable:self name:name

    "Created: 19.6.1997 / 16:41:35 / cg"
! !

!VariableNode methodsFor:'evaluating'!

evaluate
    (type == #ContextVariable) ifTrue:[
        ^ value at:index
    ].
    (type == #MethodVariable
    or:[type == #BlockArg
    or:[type == #BlockVariable]]) ifTrue:[
        ^ token variableValue
    ].
    (type == #InstanceVariable) ifTrue:[
        ^ value instVarAt:index
    ].
    (type == #GlobalVariable) ifTrue:[
        (Smalltalk includesKey:name) ifTrue:[
            ^ Smalltalk at:name
        ].
"
        self error:('global ' , name , ' is undefined').
"

        ^ UndefinedVariable name:name.
        ^ nil
    ].
    (type == #ClassVariable) ifTrue:[
        ^ Smalltalk at:(value name , ':' , name) asSymbol
    ].
    (type == #ClassInstanceVariable) ifTrue:[
        ^ value instVarAt:index
    ].
    (type == #ThisContext) ifTrue:[
        value notNil ifTrue:[
            ^ value
        ].
        ^ thisContext
    ].
    (type == #PrivateClass) ifTrue:[
        ^ value privateClassesAt:name asSymbol
    ].
    "not reached"
    self halt:'bad type'.
    ^ value

    "Modified: / 17.1.1998 / 04:04:34 / cg"
!

store:aValue
    (type == #ContextVariable) ifTrue:[
        value at:index put:aValue. ^ aValue
    ].
    (type == #MethodVariable
    or:[type == #BlockVariable]) ifTrue:[
        token value:aValue. ^ aValue
    ].
    (type == #InstanceVariable) ifTrue:[
        ^ value instVarAt:index put:aValue
    ].
    (type == #GlobalVariable) ifTrue:[
        ^ Smalltalk at:name put:aValue
    ].
    (type == #ClassVariable) ifTrue:[
        ^ Smalltalk at:(value name , ':' , name) asSymbol put:aValue
    ].
    (type == #ClassInstanceVariable) ifTrue:[
        ^ value instVarAt:index put:aValue
    ].
    "not reached"
    self halt:'bad type'.
    ^ aValue

    "Modified: / 17.1.1998 / 04:04:40 / cg"
! !

!VariableNode methodsFor:'printing'!

displayString
    "return a string for display in inspectors etc."

    ^ 'InterpreterVariable(' , self printString , ')'

    "Modified: 20.9.1997 / 11:42:07 / cg"
!

printOn:aStream indent:i

    "/ actually only a debug-check
    (
    type == #ContextVariable              
    or:[type == #MethodArg            
    or:[type == #MethodVariable
    or:[type == #InstanceVariable
    or:[type == #BlockArg
    or:[type == #GlobalVariable
    or:[type == #ClassVariable
    or:[type == #BlockVariable
    or:[type == #PrivateClass
    or:[type == #ClassInstanceVariable]]]]]]]]]) ifTrue:[
        aStream nextPutAll:name. ^ self
    ].
    (type == #ThisContext) ifTrue:[
        aStream nextPutAll:'thisContext'. ^ self
    ].
    "not reached"
    self halt:'bad type'.

    "Modified: / 17.1.1998 / 02:56:06 / cg"
! !

!VariableNode methodsFor:'queries'!

canReuseAsArg:anotherNode
    anotherNode isVariable ifTrue:[
        anotherNode type ~~ type ifTrue:[^ false].

        (type == #ThisContext) ifTrue:[^ true].

        index notNil ifTrue:[
            anotherNode index ~~ index ifTrue:[^ false].
        ].
        (type == #MethodArg) ifTrue:[^ true].
        (type == #MethodVariable) ifTrue:[^ true].
        (type == #InstanceVariable) ifTrue:[^ true].

        name notNil ifTrue:[
            anotherNode name ~~ name ifTrue:[^ false].
        ].
        (type == #GlobalVariable) ifTrue:[^ true].
        (type == #ClassVariable) ifTrue:[^ true].
    ].
    ^ false

    "Created: 14.4.1996 / 00:46:18 / cg"
    "Modified: 14.4.1996 / 00:55:25 / cg"
!

isArgument
    "return true, if this is a node for an argument (block or method)"

    ^ (type == #MethodArg) or:[type == #BlockArg]

    "Created: 27.6.1997 / 13:07:05 / cg"
    "Modified: 27.6.1997 / 13:07:19 / cg"
!

isGlobal
    "return true, if this is a node for a global variable"

    ^ (type == #GlobalVariable) and:[Smalltalk includesKey:name]
!

isLocal
    "return true, if this is a node for a local (block or method) variable"

    ^ (type == #MethodVariable) or:[type == #BlockVariable]

    "Created: 1.3.1996 / 00:03:53 / cg"
    "Modified: 1.3.1996 / 00:04:46 / cg"
!

isVariable
    "return true, if this is a node for a variable"

    ^ true

    "Created: 14.4.1996 / 00:46:32 / cg"
! !

!VariableNode class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.35 1998-01-17 15:01:49 cg Exp $'
! !