'From Squeak3.7beta of ''1 April 2004'' [latest update: #5967] on 13 July 2004 at 1:59:56 pm'! "Change Set: ParserRefactoring Date: 6 July 2004 Author: Alexandre Bergel Using an accessor/mutator for some of the classes present in the compilation framework"! !LeafNode methodsFor: 'initialize-release' stamp: 'ab 7/13/2004 13:51'! key: object key _ object. ! ! !LeafNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:39'! code ^ code! ! !LeafNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:41'! code: aValue code := aValue! ! !ParseNode methodsFor: 'printing' stamp: 'ab 7/13/2004 13:46'! printCommentOn: aStream indent: indent | thisComment | self comment == nil ifTrue: [^ self]. aStream withStyleFor: #comment do: [1 to: self comment size do: [:index | index > 1 ifTrue: [aStream crtab: indent]. aStream nextPut: $". thisComment _ self comment at: index. self printSingleComment: thisComment on: aStream indent: indent. aStream nextPut: $"]]. self comment: nil! ! !ParseNode methodsFor: 'tiles' stamp: 'ab 7/13/2004 13:47'! addCommentToMorph: aMorph | row | (self comment isNil or: [self comment isEmpty]) ifTrue: [^ self]. row _ aMorph addTextRow: (String streamContents: [:strm | self printCommentOn: strm indent: 1]). row firstSubmorph color: (SyntaxMorph translateColor: #comment). row parseNode: (self as: CommentNode). ! ! !LeafNode methodsFor: 'initialize-release' stamp: 'ab 7/13/2004 13:51'! key: object code: byte self key: object. self code: byte! ! !LeafNode methodsFor: 'initialize-release' stamp: 'ab 7/13/2004 13:52'! name: ignored key: object code: byte self key: object. self code: byte! ! !LeafNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:42'! emitLong: mode on: aStream "Emit extended variable access." | type index | self code < 256 ifTrue: [self code < 16 ifTrue: [type _ 0. index _ self code] ifFalse: [self code < 32 ifTrue: [type _ 1. index _ self code - 16] ifFalse: [self code < 96 ifTrue: [type _ self code // 32 + 1. index _ self code \\ 32] ifFalse: [self error: 'Sends should be handled in SelectorNode']]]] ifFalse: [index _ self code \\ 256. type _ self code // 256 - 1]. index <= 63 ifTrue: [aStream nextPut: mode. ^ aStream nextPut: type * 64 + index]. "Compile for Double-exetended Do-anything instruction..." mode = LoadLong ifTrue: [aStream nextPut: DblExtDoAll. aStream nextPut: (#(64 0 96 128) at: type+1). "Cant be temp (type=1)" ^ aStream nextPut: index]. mode = Store ifTrue: [aStream nextPut: DblExtDoAll. aStream nextPut: (#(160 0 0 224) at: type+1). "Cant be temp or const (type=1 or 2)" ^ aStream nextPut: index]. mode = StorePop ifTrue: [aStream nextPut: DblExtDoAll. aStream nextPut: (#(192 0 0 0) at: type+1). "Can only be inst" ^ aStream nextPut: index]. ! ! !LeafNode methodsFor: 'code generation' stamp: 'ab 7/13/2004 13:52'! reserve: encoder "If this is a yet unused literal of type -code, reserve it." self code < 0 ifTrue: [self code: (self code: (encoder litIndex: self key) type: 0 - self code)]! ! !LeafNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:40'! sizeForValue: encoder self reserve: encoder. self code < 256 ifTrue: [^ 1]. (self code \\ 256) <= 63 ifTrue: [^ 2]. ^ 3! ! !LeafNode methodsFor: 'copying' stamp: 'ab 7/13/2004 13:53'! veryDeepFixupWith: deepCopier "If fields were weakly copied, fix them here. If they were in the tree being copied, fix them up, otherwise point to the originals!!!!" super veryDeepFixupWith: deepCopier. self key: (deepCopier references at: self key ifAbsent: [self key]). ! ! !LeafNode methodsFor: 'copying' stamp: 'ab 7/6/2004 17:42'! veryDeepInner: deepCopier "Copy all of my instance variables. Some need to be not copied at all, but shared. Warning!!!! Every instance variable defined in this class must be handled. We must also implement veryDeepFixupWith:. See DeepCopier class comment." super veryDeepInner: deepCopier. "key _ key. Weakly copied" self code: (self code veryDeepCopyWith: deepCopier). ! ! !VariableNode methodsFor: 'initialize-release' stamp: 'ab 7/13/2004 13:54'! name: varName index: i type: type "Only used for initting instVar refs" self name: varName. self key: varName index: i type: type! ! !VariableNode methodsFor: 'initialize-release' stamp: 'ab 7/13/2004 13:53'! name: string key: object code: byte "Only used for initting std variables, nil, true, false, self, etc." self name: string. self key: object. self code: byte! ! !VariableNode methodsFor: 'initialize-release' stamp: 'ab 7/13/2004 13:53'! name: varName key: objRef index: i type: type "Only used for initting global (litInd) variables" self name: varName. self key: objRef index: i type: type! ! !VariableNode methodsFor: 'testing' stamp: 'ab 7/13/2004 13:53'! assignmentCheck: encoder at: location (encoder cantStoreInto: self name) ifTrue: [^ location] ifFalse: [^ -1] ! ! !VariableNode methodsFor: 'testing' stamp: 'ab 7/6/2004 17:37'! canBeSpecialArgument "Can I be an argument of (e.g.) ifTrue:?" ^ self code < LdNil! ! !VariableNode methodsFor: 'testing' stamp: 'ab 7/6/2004 17:36'! index "This code attempts to reconstruct the index from its encoding in code." self code < 0 ifTrue:[^ nil]. self code > 256 ifTrue:[^ self code \\ 256]. ^self code - self type! ! !VariableNode methodsFor: 'testing' stamp: 'ab 7/13/2004 13:53'! isSelfPseudoVariable "Answer if this ParseNode represents the 'self' pseudo-variable." ^ (self key = 'self') | (self name = '{{self}}')! ! !VariableNode methodsFor: 'testing' stamp: 'ab 7/6/2004 17:37'! type "This code attempts to reconstruct the type from its encoding in code. This allows one to test, for instance, (aNode type = LdInstType)." | type | self code < 0 ifTrue: [^ self code negated]. self code < 256 ifFalse: [^ self code // 256]. type _ CodeBases findFirst: [:one | self code < one]. type = 0 ifTrue: [^ 5] ifFalse: [^ type - 1]! ! !VariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:37'! emitForReturn: stack on: strm (self code >= LdSelf and: [self code <= LdNil]) ifTrue: ["short returns" strm nextPut: EndMethod - 4 + (self code - LdSelf). stack push: 1 "doesnt seem right"] ifFalse: [super emitForReturn: stack on: strm]! ! !VariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:37'! emitForValue: stack on: strm self code < 256 ifTrue: [strm nextPut: (self code = LdSuper ifTrue: [LdSelf] ifFalse: [self code]). stack push: 1] ifFalse: [self emitLong: LoadLong on: strm. stack push: 1]! ! !VariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:37'! emitStorePop: stack on: strm (self code between: 0 and: 7) ifTrue: [strm nextPut: ShortStoP + self code "short stopop inst"] ifFalse: [(self code between: 16 and: 23) ifTrue: [strm nextPut: ShortStoP + 8 + self code - 16 "short stopop temp"] ifFalse: [(self code >= 256 and: [self code \\ 256 > 63 and: [self code // 256 = 4]]) ifTrue: [self emitLong: Store on: strm. strm nextPut: Pop] ifFalse: [self emitLong: StorePop on: strm]]]. stack pop: 1! ! !VariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:36'! fieldOffset "Return temp or instVar offset for this variable" self code < 256 ifTrue: [^ self code \\ 16] ifFalse: [^ self code \\ 256]! ! !VariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:36'! sizeForReturn: encoder (self code >= LdSelf and: [self code <= LdNil]) ifTrue: ["short returns" ^1]. ^super sizeForReturn: encoder! ! !VariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:38'! sizeForStore: encoder self reserve: encoder. self code < 256 ifTrue: [^ 2]. (self code \\ 256) <= 63 ifTrue: [^ 2]. ^ 3! ! !VariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:43'! sizeForStorePop: encoder self reserve: encoder. (self code < 24 and: [self code noMask: 8]) ifTrue: [^ 1]. self code < 256 ifTrue: [^ 2]. self code \\ 256 <= 63 ifTrue: [^ 2]. "extended StorePop" self code // 256 = 1 ifTrue: [^ 3]. "dbl extended StorePopInst" self code // 256 = 4 ifTrue: [^ 4]. "dbl extended StoreLitVar , Pop" self halt. "Shouldn't get here"! ! !VariableNode methodsFor: 'printing' stamp: 'ab 7/13/2004 13:54'! printOn: aStream indent: level aStream withStyleFor: #variable do: [aStream nextPutAll: self name]. ! ! !VariableNode methodsFor: 'tiles' stamp: 'ab 7/13/2004 13:54'! asMorphicSyntaxIn: parent ^ parent addToken: self name type: #variable on: self clone "don't hand out the prototype!! See VariableNode>>initialize" ! ! !VariableNode methodsFor: 'tiles' stamp: 'ab 7/13/2004 13:53'! explanation self isSelfPseudoVariable ifTrue: [^'the pseudo variable (refers to the receiver)']. ^(#('instance' 'temporary' 'LIT3' 'global') at: self type ifAbsent: ['UNK',self type printString]),' variable <',self name,'>' "LdInstType _ 1. LdTempType _ 2. LdLitType _ 3. LdLitIndType _ 4. " ! ! !VariableNode methodsFor: 'tiles' stamp: 'ab 7/13/2004 13:54'! variableGetterBlockIn: aContext | temps index ivars | (self type = 4 and: [self key isVariableBinding]) ifTrue: [ ^[self key value] ]. aContext ifNil: [^nil]. self isSelfPseudoVariable ifTrue: [^[aContext receiver]]. self type = 1 ifTrue: [ ivars _ aContext receiver class allInstVarNames. index _ ivars indexOf: self name ifAbsent: [^nil]. ^[aContext receiver instVarAt: index] ]. self type = 2 ifTrue: [ temps _ aContext tempNames. index _ temps indexOf: self name ifAbsent: [^nil]. ^[aContext tempAt: index] ]. ^nil ! ! !LiteralVariableNode methodsFor: 'code generation' stamp: 'ab 7/6/2004 17:41'! emitLoad: stack on: strm splNode ifNil:[^super emitLoad: stack on: strm]. self code < 256 ifTrue: [strm nextPut: self code] ifFalse: [self emitLong: LoadLong on: strm]. stack push: 1.! ! !LiteralVariableNode methodsFor: 'code generation' stamp: 'ab 7/13/2004 13:52'! sizeForStore: encoder | index | (self key isVariableBinding and:[self key isSpecialWriteBinding]) ifFalse:[^super sizeForStore: encoder]. self code < 0 ifTrue:[ index _ self index. self code: (self code: index type: LdLitType)]. splNode _ encoder encodeSelector: #value:. ^ (splNode size: encoder args: 1 super: false) + (super sizeForValue: encoder)! ! !LiteralVariableNode methodsFor: 'code generation' stamp: 'ab 7/13/2004 13:52'! sizeForStorePop: encoder | index | (self key isVariableBinding and:[self key isSpecialWriteBinding]) ifFalse:[^super sizeForStorePop: encoder]. self code < 0 ifTrue:[ index _ self index. self code: (self code: index type: LdLitType)]. splNode _ encoder encodeSelector: #value:. ^ (splNode size: encoder args: 1 super: false) + (super sizeForValue: encoder) + 1! ! !TempVariableNode methodsFor: 'initialize-release' stamp: 'ab 7/13/2004 13:57'! name: varName index: i type: type scope: level "Only used for initting temporary variables" self name: varName. self key: varName index: i type: type. self isArg: (hasDefs _ hasRefs _ false). self scope: level! ! !TempVariableNode methodsFor: 'testing' stamp: 'ab 7/13/2004 13:56'! assignmentCheck: encoder at: location self isArg ifTrue: [^ location] ifFalse: [^ -1]! ! !TempVariableNode methodsFor: 'printing' stamp: 'ab 7/13/2004 13:54'! printOn: aStream indent: level aStream withStyleFor: #temporaryVariable do: [aStream nextPutAll: self name]! ! !TempVariableNode methodsFor: 'tiles' stamp: 'ab 7/13/2004 13:54'! asMorphicSyntaxIn: parent ^ parent addToken: self name type: #tempVariable on: self! ! !TempVariableNode methodsFor: 'tiles' stamp: 'ab 7/13/2004 13:54'! explanation ^(self isArg ifTrue: ['Method argument'] ifFalse: ['Temporary variable']),' <',self name,'>' ! !