"

 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 selfValue selfClass index block'

       classVariableNames:''

       poolDictionaries:''

       category:'System-Compiler-Support'

!

VariableNode comment:'

COPYRIGHT (c) 1994 by Claus Gittinger

             All Rights Reserved

'!

!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.

"

!

version

"

"

!

documentation

"

    node for parse-trees, representing variables

"

! !

!VariableNode class methodsFor:'instance creation'!

type:t token:tok

    ^ (self basicNew) type:t token:tok

!

type:t name:n

    ^ (self basicNew) type:t name:n

!

type:t index:i selfValue:s

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

!

type:t name:n value:val

    ^ (self basicNew) type:t name:n value:val

!

type:t name:n token:tok index:i

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

!

type:t name:n index:i selfValue:s

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

!

type:t name:n index:i selfClass:s

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

!

type:t name:n token:tok index:i block:b

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

!

type:t token:tok index:i

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

!

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

    ^ (self basicNew) type:t token:tok index:i block:b

! !

!VariableNode methodsFor:'accessing'!

type:t token:tok

    type := t.

    token := tok

!

type:t token:tok index:i

    type := t.

    index := i.

    token := tok

!

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

    type := t.

    index := i.

    block := b.

    token := tok

!

type:t name:n

    type := t.

    value := nil.

    name := n

!

type:t index:i selfValue:s

    type := t.

    value := nil.

    index := i.

    selfValue := s

!

type:t name:n value:val

    type := t.

    name := n.

    value := val

!

type:t name:n index:i selfValue:s

    type := t.

    value := nil.

    index := i.

    selfValue := s.

    name := n

!

type:t name:n index:i selfClass:s

    type := t.

    value := nil.

    index := i.

    selfClass := s.

    name := n

!

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:b

    type := t.

    index := i.

    block := b.

    token := tok.

    name := n

!

name

    ^ name

!

index

    ^ index

! !

!VariableNode methodsFor:'evaluating'!

evaluate

    (type == #MethodVariable) ifTrue:[

    ].

    (type == #InstanceVariable) ifTrue:[

        ^ selfValue instVarAt:index

    ].

    (type == #BlockArg) ifTrue:[

    ].

    (type == #GlobalVariable) ifTrue:[

        (Smalltalk includesKey:name) ifTrue:[

            ^ Smalltalk at:name

        ].

"

        self error:('global ' , name , ' is undefined').

"

        ^ UndefinedVariable name:name.

        ^ nil

    ].

    (type == #BlockVariable) ifTrue:[

    ].

    (type == #ClassVariable) ifTrue:[

        ^ Smalltalk at:name

    ].

    (type == #ClassInstanceVariable) ifTrue:[

        ^ selfClass instVarAt:index

    ].

    (type == #ThisContext) ifTrue:[

        ^ thisContext

    ].

    "not reached"

    self halt:'bad type'.

    ^ value

!

store:aValue

    (type == #MethodVariable) ifTrue:[

        token value:aValue. ^ aValue

    ].

    (type == #InstanceVariable) ifTrue:[

        ^ selfValue instVarAt:index put:aValue

    ].

    (type == #GlobalVariable) ifTrue:[

        ^ Smalltalk at:name put:aValue

    ].

    (type == #ClassVariable) ifTrue:[

        ^ Smalltalk at:name put:aValue

    ].

    (type == #BlockVariable) ifTrue:[

        token value:aValue. ^ aValue

    ].

    (type == #ClassInstanceVariable) ifTrue:[

        ^ selfClass instVarAt:index put:aValue

    ].

    "not reached"

    self halt:'bad type'.

    ^ aValue

! !

!VariableNode methodsFor:'code generation'!

codeForSideEffectOn:aStream inBlock:b

    "no code at all"

    ^ self

!

codeOn:aStream inBlock:codeBlock

    |theCode b deltaLevel|

    (type == #MethodArg) ifTrue:[

        (index <= 4) ifTrue:[

            aStream nextPut:(#(pushMethodArg1

                               pushMethodArg2

                               pushMethodArg3 

                               pushMethodArg4) at:index).

            ^ self

        ].

        aStream nextPut:#pushMethodArg.

        aStream nextPut:index.

        ^ self

    ].

    (type == #MethodVariable) ifTrue:[

        (index <= 6) ifTrue:[

            aStream nextPut:(#(pushMethodVar1

                               pushMethodVar2

                               pushMethodVar3

                               pushMethodVar4

                               pushMethodVar5

                               pushMethodVar6) at:index).

            ^ self

        ].

        aStream nextPut:#pushMethodVar.

        aStream 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.

        aStream nextPut:index.

        ^ self

    ].

    (type == #BlockArg) ifTrue:[

        "find deltaLevel to block, where argument was defined"

        b := codeBlock.

        deltaLevel := 0.

        [b notNil and:[b ~~ block]] whileTrue:[

            b inlineBlock ifFalse:[

                deltaLevel := deltaLevel + 1

            ].

            b := b home

        ].

        (deltaLevel == 0) ifTrue:[

            (index <= 4) ifTrue:[

                theCode := #(pushBlockArg1 pushBlockArg2 pushBlockArg3

                             pushBlockArg4) at:index.

                aStream nextPut:theCode.

                ^ self

            ].

            aStream nextPut:#pushBlockArg.

            aStream nextPut:index

        ] ifFalse:[

            (deltaLevel == 1) ifTrue:[

                aStream nextPut:#pushOuter1BlockArg

            ] ifFalse:[

                (deltaLevel == 2) ifTrue:[

                    aStream nextPut:#pushOuter2BlockArg

                ] ifFalse:[

                    aStream nextPut:#pushOuterBlockArg.

                    aStream nextPut:deltaLevel

                ]

            ].

            aStream nextPut:index

        ].

        ^ self

    ].

    (type == #GlobalVariable) ifTrue:[

        aStream nextPut:#pushGlobal.

        aStream nextPut:name.

        aStream nextPut:0.      "slot for generation "

        aStream nextPut:0.      "slot for cell address (4 byte) "

        aStream nextPut:0.

        aStream nextPut:0.

        aStream nextPut:0.

        ^ self

    ].

    (type == #ClassVariable) ifTrue:[

        aStream nextPut:#pushClassVar.

        aStream nextPut:name.

        aStream nextPut:0.      "slot for generation "

        aStream nextPut:0.      "slot for cell address (4 byte) "

        aStream nextPut:0.

        aStream nextPut:0.

        aStream nextPut:0.

        ^ self

    ].

    (type == #BlockVariable) ifTrue:[

        "find deltaLevel to block, where variable was defined"

        b := codeBlock.

        deltaLevel := 0.

        [b notNil and:[b ~~ block]] whileTrue:[

            b inlineBlock ifFalse:[

                deltaLevel := deltaLevel + 1

            ].

            b := b home

        ].

        (deltaLevel == 0) ifTrue:[

            aStream nextPut:#pushBlockVar.

            aStream nextPut:index

        ] ifFalse:[

            aStream nextPut:#pushOuterBlockVar.

            aStream nextPut:deltaLevel.

            aStream nextPut:index

        ].

        ^ self

    ].

    (type == #ClassInstanceVariable) ifTrue:[

        aStream nextPut:#pushClassInstVar.

        aStream nextPut:index.

        ^ self

    ].

    (type == #ThisContext) ifTrue:[

        aStream nextPut:#pushThisContext. ^ self

    ].

    "can this be reached ?"

    "not reached"

    self halt:'bad type'.

    aStream nextPut:#pushLit.

    aStream nextPut:value

!

codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded

    |theCode b deltaLevel|

    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.

        aStream 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.

        aStream nextPut:index.

        ^ self

    ].

    (type == #GlobalVariable) ifTrue:[

        aStream nextPut:#storeGlobal.

        aStream nextPut:name.

        aStream nextPut:0.      "slot for generation "

        aStream nextPut:0.      "slot for cell address (4 byte) "

        aStream nextPut:0.

        aStream nextPut:0.

        aStream nextPut:0.

        ^ self

    ].

    (type == #BlockVariable) ifTrue:[

        "find deltaLevel to block, where variable was defined"

        b := codeBlock.

        deltaLevel := 0.

        [b notNil and:[b ~~ block]] whileTrue:[

            b inlineBlock ifFalse:[

                deltaLevel := deltaLevel + 1

            ].

            b := b home

        ].

        (deltaLevel == 0) ifTrue:[

            aStream nextPut:#storeBlockVar.

            aStream nextPut:index

        ] ifFalse:[

            aStream nextPut:#storeOuterBlockVar.

            aStream nextPut:deltaLevel.

            aStream nextPut:index

        ].

        ^ self

    ].

    (type == #ClassVariable) ifTrue:[

        aStream nextPut:#storeClassVar.

        aStream nextPut:name.

        aStream nextPut:0.      "slot for generation "

        aStream nextPut:0.      "slot for cell address (4 byte) "

        aStream nextPut:0.

        aStream nextPut:0.

        aStream nextPut:0.

        ^ self

    ].

    (type == #ClassInstanceVariable) ifTrue:[

        aStream nextPut:#storeClassInstVar.

        aStream nextPut:index.

        ^ self

    ].

    "cannot be reached"

    ^ self error:'bad assignment'

! !

!VariableNode methodsFor:'printing'!

displayString

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

!

printOn:aStream indent:i

    (type == #MethodArg) ifTrue:[

        aStream nextPutAll:name. ^ self

    ].

    (type == #MethodVariable) ifTrue:[

        aStream nextPutAll:name. ^ self

    ].

    (type == #InstanceVariable) ifTrue:[

        aStream nextPutAll:name. ^ self

    ].

    (type == #BlockArg) ifTrue:[

        aStream nextPutAll:name. ^ self

    ].

    (type == #GlobalVariable) ifTrue:[

        aStream nextPutAll:name.^ self

    ].

    (type == #ClassVariable) ifTrue:[

        aStream nextPutAll:name. ^ self

    ].

    (type == #BlockVariable) ifTrue:[

        aStream nextPutAll:name. ^ self

    ].

    (type == #ClassInstanceVariable) ifTrue:[

        aStream nextPutAll:name. ^ self

    ].

    (type == #ThisContext) ifTrue:[

        aStream nextPutAll:'thisContext'. ^ self

    ].

    "not reached"

    self halt:'bad type'.

! !