"

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

"

! !

!VariableNode class methodsFor:'instance creation'!

type:t class:class name:n

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

!

type:t index:i selfValue:s

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

!

type:t name:n

    ^ (self basicNew) type:t name:n

!

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

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

!

type:t name:n value:val

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

!

type:t token:tok

    ^ (self basicNew) type:t token:tok

!

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

index

    ^ index

!

name

    ^ name

!

type:t class:class name:n

    type := t.

    value := nil.

    name := n.

    selfClass := class 

!

type:t index:i selfValue:s

    type := t.

    value := nil.

    index := i.

    selfValue := s

!

type:t name:n

    type := t.

    value := nil.

    name := n

!

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

    type := t.

    value := nil.

    index := i.

    selfClass := s.

    name := n

!

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

    type := t.

    value := nil.

    index := i.

    selfValue := 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

!

type:t name:n value:val

    type := t.

    name := n.

    value := val

!

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

! !

!VariableNode methodsFor:'code generation'!

codeForSideEffectOn:aStream inBlock:b for:aCompiler

    "no code at all"

    ^ self

!

codeOn:aStream inBlock:codeBlock for:aCompiler

    |theCode b deltaLevel litIndex|

    (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) 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.

	] ifFalse:[

	    (deltaLevel == 1) ifTrue:[

		aStream nextPut:#pushOuter1BlockArg

	    ] ifFalse:[

		(deltaLevel == 2) ifTrue:[

		    aStream nextPut:#pushOuter2BlockArg

		] ifFalse:[

		    aStream nextPut:#pushOuterBlockArg; nextPut:deltaLevel

		]

	    ].

	].

	aStream nextPut:index.

	^ self

    ].

    (type == #GlobalVariable) ifTrue:[

"/        aStream nextPut:#pushGlobal; nextPut:name.

	litIndex := aCompiler addLiteral:name asSymbol.

	litIndex < 256 ifTrue:[

	    aStream nextPut:#pushGlobalS; nextPut:litIndex

	] ifFalse:[

	    aStream nextPut:#pushGlobalL; nextPut:litIndex; nextPut:0

	].

	"slot for generation and cell address (6 byte)"

	aStream next:6 put:0.

	^ self

    ].

    (type == #ClassVariable) ifTrue:[

"/        aStream nextPut:#pushClassVar; nextPut:(selfClass name , ':' , name) asSymbol.

	litIndex := aCompiler addLiteral:(selfClass name , ':' , name) asSymbol.

	litIndex < 256 ifTrue:[

	    aStream nextPut:#pushClassVarS; nextPut:litIndex

	] ifFalse:[

	    aStream nextPut:#pushClassVarL; nextPut:litIndex; nextPut:0

	].

	"slot for generation and cell address (6 byte)"

	aStream next:6 put: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.

	] ifFalse:[

	    aStream nextPut:#pushOuterBlockVar; nextPut:deltaLevel.

	].

	aStream nextPut:index.

	^ self

    ].

    (type == #ClassInstanceVariable) ifTrue:[

	aStream nextPut:#pushClassInstVar; nextPut:index.

	^ self

    ].

    (type == #ThisContext) ifTrue:[

	aStream nextPut:#pushThisContext. ^ self

    ].

    "not reached"

    self halt:'bad type'.

!

codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded for:aCompiler

    |theCode b deltaLevel litIndex|

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

	"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

	] ifFalse:[

	    aStream nextPut:#storeOuterBlockVar; nextPut:deltaLevel

	].

	aStream nextPut:index.

	^ self

    ].

    (type == #GlobalVariable) ifTrue:[

"/        aStream nextPut:#storeGlobal; nextPut:name.

	litIndex := aCompiler addLiteral:name asSymbol.

	litIndex < 256 ifTrue:[

	    aStream nextPut:#storeGlobalS; nextPut:litIndex

	] ifFalse:[

	    aStream nextPut:#storeGlobalL; nextPut:litIndex; nextPut:0

	].

	"slot for generation and cell address (6 byte)"

	aStream next:6 put:0.

	^ self

    ].

    (type == #ClassVariable) ifTrue:[

"/        aStream nextPut:#storeClassVar; nextPut:(selfClass name , ':' , name) asSymbol.

	litIndex := aCompiler addLiteral:(selfClass name , ':' , name) asSymbol.

	litIndex < 256 ifTrue:[

	    aStream nextPut:#storeClassVarS; nextPut:litIndex

	] ifFalse:[

	    aStream nextPut:#storeClassVarL; nextPut:litIndex; nextPut:0

	].

	"slot for generation and cell address (6 byte)"

	aStream next:6 put:0.

	^ self

    ].

    (type == #ClassInstanceVariable) ifTrue:[

	aStream nextPut:#storeClassInstVar; nextPut:index.

	^ self

    ].

    "not reached"

    ^ self error:'bad assignment'

! !

!VariableNode methodsFor:'evaluating'!

evaluate

    (type == #MethodVariable

    or:[type == #BlockArg

    or:[type == #BlockVariable]]) ifTrue:[

	^ token variableValue

    ].

    (type == #InstanceVariable) ifTrue:[

	^ selfValue 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:(selfClass name , ':' , name) asSymbol

    ].

    (type == #ClassInstanceVariable) ifTrue:[

	^ selfClass instVarAt:index

    ].

    (type == #ThisContext) ifTrue:[

	^ thisContext

    ].

    "not reached"

    self halt:'bad type'.

    ^ value

!

store:aValue

    (type == #MethodVariable

    or:[type == #BlockVariable]) 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:(selfClass name , ':' , name) asSymbol put:aValue

    ].

    (type == #ClassInstanceVariable) ifTrue:[

	^ selfClass instVarAt:index put:aValue

    ].

    "not reached"

    self halt:'bad type'.

    ^ aValue

! !

!VariableNode methodsFor:'printing'!

displayString

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

!

printOn:aStream indent:i

    (type == #MethodArg              "/ actually only a debug-check

    or:[type == #MethodVariable

    or:[type == #InstanceVariable

    or:[type == #BlockArg

    or:[type == #GlobalVariable

    or:[type == #ClassVariable

    or:[type == #BlockVariable

    or:[type == #ClassInstanceVariable]]]]]]]) ifTrue:[

	aStream nextPutAll:name. ^ self

    ].

    (type == #ThisContext) ifTrue:[

	aStream nextPutAll:'thisContext'. ^ self

    ].

    "not reached"

    self halt:'bad type'.

! !

!VariableNode methodsFor:'queries'!

isGlobal

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

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

! !

!VariableNode class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/libcomp/VariableNode.st,v 1.15 1996-01-17 18:39:23 cg Exp $'

! !