"
 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

$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.5 1995-07-23 02:24:51 claus Exp $
'!

!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
"
$Header: /cvs/stx/stx/libcomp/Attic/VarNode.st,v 1.5 1995-07-23 02:24:51 claus Exp $
"
!

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

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

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

!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 class:class name:n
    type := t.
    value := nil.
    name := n.
    selfClass := class 
!

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
    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:'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; 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.
	"slot for generation and cell address (4 byte)"
	aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0.
	^ self
    ].
    (type == #ClassVariable) ifTrue:[
	aStream nextPut:#pushClassVar; nextPut:(selfClass name , ':' , name) asSymbol.
	"slot for generation and cell address (4 byte)"
	aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; 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.
	] 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
    ].

    "can this be reached ?"

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

    aStream nextPut:#pushLit; nextPut:value
!

codeStoreOn:aStream inBlock:codeBlock valueNeeded:valueNeeded
    |theCode b deltaLevel nm|

    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 == #GlobalVariable) ifTrue:[
	aStream nextPut:#storeGlobal; nextPut:name.
	"slot for generation and cell address (4 byte)"
	aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; 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
	] ifFalse:[
	    aStream nextPut:#storeOuterBlockVar; nextPut:deltaLevel
	].
	aStream nextPut:index.
	^ self
    ].
    (type == #ClassVariable) ifTrue:[
	aStream nextPut:#storeClassVar; nextPut:(selfClass name , ':' , name) asSymbol.
	"slot for generation and cell address (4 byte)"
	aStream nextPut:0; nextPut:0; nextPut:0; nextPut:0; nextPut:0.
	^ self
    ].
    (type == #ClassInstanceVariable) ifTrue:[
	aStream nextPut:#storeClassInstVar; nextPut:index.
	^ self
    ].
    "cannot be reached"
    ^ self error:'bad assignment'
! !

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