--- a/PrimaryNode.st Wed Jan 12 21:20:41 1994 +0100
+++ b/PrimaryNode.st Sun Jan 16 04:51:45 1994 +0100
@@ -11,7 +11,7 @@
"
ParseNode subclass:#PrimaryNode
- instanceVariableNames:'value name selfValue token index block'
+ instanceVariableNames:'value'
classVariableNames:''
poolDictionaries:''
category:'System-Compiler-Support'
@@ -22,127 +22,12 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/PrimaryNode.st,v 1.4 1993-12-11 01:09:30 claus Exp $
+$Header: /cvs/stx/stx/libcomp/PrimaryNode.st,v 1.5 1994-01-16 03:51:42 claus Exp $
written 88 by claus
'!
-!PrimaryNode 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 value:val
- ^ (self basicNew) type:t value:val
-!
-
-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 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
-! !
-
!PrimaryNode 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 value:val
- type := t.
- value := val
-!
-
-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 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
-!
-
value
^ value
! !
@@ -150,61 +35,11 @@
!PrimaryNode methodsFor:'evaluating'!
evaluate
- (type == #MethodVariable) ifTrue:[
- ^ token value
- ].
- (type == #InstanceVariable) ifTrue:[
- ^ selfValue instVarAt:index
- ].
- (type == #BlockArg) ifTrue:[
- ^ token value
- ].
- (type == #GlobalVariable) ifTrue:[
- (Smalltalk includesKey:name) ifTrue:[
- ^ Smalltalk at:name
- ].
-"
- self error:('global ' , name , ' is undefined').
-"
-
- ^ UndefinedVariable name:name.
- ^ nil
- ].
- (type == #BlockVariable) ifTrue:[
- ^ token value
- ].
- (type == #ClassVariable) ifTrue:[
- ^ Smalltalk at:name
- ].
- (type == #ClassInstanceVariable) ifTrue:[
- ^ selfValue class instVarAt:index
- ].
- (type == #ThisContext) ifTrue:[
- ^ thisContext
- ].
- ^ value
+ self subclassResponsibility
!
store:aValue
- (type == #MethodVariable) ifTrue:[
- token value: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
- ].
- (type == #ClassInstanceVariable) ifTrue:[
- ^ selfValue class instVarAt:index put:aValue
- ].
- ^ aValue
+ self subclassResponsibility
! !
!PrimaryNode methodsFor:'code generation'!
@@ -215,264 +50,19 @@
!
codeOn:aStream inBlock:codeBlock
- |theCode b deltaLevel|
-
- (type == #Self) ifTrue:[
- aStream nextPut:#pushSelf. ^ self
- ].
- (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 == #Super) ifTrue:[
- aStream nextPut:#pushSelf. ^ 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 ?"
-
- aStream nextPut:#pushLit.
- aStream nextPut:value
+ self subclassResponsibility
!
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'
+ self subclassResponsibility
! !
!PrimaryNode methodsFor:'printing'!
displayString
- ^ 'InterpreterVariable(' , self printString , ')'
+ self subclassResponsibility
!
printOn:aStream indent:i
- (type == #Self) ifTrue:[
- aStream nextPutAll:'self'. ^ self
- ].
- (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 == #Super) ifTrue:[
- aStream nextPutAll:'super'. ^ 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
- ].
- self halt
+ self subclassResponsibility
! !