AllMCompilerMethods.st

!MCompiler methodsFor: 'error handling' stamp: 'yo 11/10/2010 20:06'!
interactive 

	^ false
! !

!MCompiler methodsFor: 'error handling' stamp: 'yo 11/10/2010 20:06'!
notify: aString 
! !

!MCompiler methodsFor: 'error handling' stamp: 'yo 11/10/2010 20:06'!
notify: aString at: location
! !

!MCompiler methodsFor: 'public access' stamp: 'yo 12/9/2010 22:57'!
compileNoPattern: textOrStream in: aClass context: aContext for: instance

	| tree |
	tree := self
		translate: textOrStream readStream in: aClass context: aContext
		noPattern: true for: instance.
	^ Array with: (tree generate: #(0 0 0 0)) with: tree! !

!MCompiler methodsFor: 'public access' stamp: 'yo 12/9/2010 22:58'!
compile: textOrStream in: aClass for: instance

	| tree |
	tree := self
		translate: textOrStream readStream in: aClass context: nil
		noPattern: false for: instance.
	^ Array with: (tree generate: #(0 0 0 0)) with: tree
! !

!MCompiler methodsFor: 'public access' stamp: 'yo 12/15/2010 23:46'!
evaluate: textOrStream in: aContext to: receiver

	| method selector class methodPair v |
	class _ (aContext == nil ifTrue: [receiver] ifFalse: [aContext receiver]) class.
	methodPair  := self compileNoPattern: textOrStream in: class context: aContext for: receiver.
	method _ methodPair first.
	selector _ aContext isNil
		ifTrue: [#DoIt]
		ifFalse: [#DoItIn:].
	class addSelector: selector withMethod: method.
	v := aContext isNil
		ifTrue: [receiver DoIt]
		ifFalse: [receiver DoItIn: aContext].
	class removeSelector: selector.
	^ v.
! !

!MCompiler methodsFor: 'private' stamp: 'yo 11/10/2010 20:27'!
parser

	^ parser ifNil: [parser := Parser new].
! !

!MCompiler methodsFor: 'private' stamp: 'yo 11/10/2010 21:02'!
parser: anObject

	parser := anObject.
! !

!MCompiler methodsFor: 'private' stamp: 'yo 11/10/2010 21:13'!
translate: aStream in: class context: context noPattern: noPattern for: instance
	^ self parser
			parse: aStream
			class: class
			noPattern: noPattern
			context: context for: instance.
! !


!MCompiler class methodsFor: 'as yet unclassified' stamp: 'yo 11/11/2010 00:56'!
new

	^ super new parser: Parser new.
! !


!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
assignmentCheck: encoder at: location
	"For messageNodes masquerading as variables for the debugger.
	For now we let this through - ie we allow stores ev
	into args.  Should check against numArgs, though."
	^ -1! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
canBeSpecialArgument
	"Can I be an argument of (e.g.) ifTrue:?"

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
canCascade

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isArg

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isComplex
	"Used for pretty printing to determine whether to start a new line"

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isConstantNumber  "Overridden in LiteralNode"
	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  ls 1/29/2004 21:11'!
isJust: node
	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  di 4/5/2000 11:14'!
isLiteral

	^ false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isMessage: selSymbol receiver: rcvrPred arguments: argsPred
	"See comment in MessageNode."

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isReturningIf

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isReturnSelf

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  tk 8/2/1999 18:39'!
isSelfPseudoVariable	
	"Overridden in VariableNode."
	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isSpecialConstant
	^ false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  di 10/12/1999 15:28'!
isTemp
	^ false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isUndefTemp
	^ false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isUnusedTemp
	^ false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
isVariableReference

	^false! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
nowHasDef  "Ignored in all but VariableNode"! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
nowHasRef  "Ignored in all but VariableNode"! !

!MParseNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:22  <  '!
toDoIncrement: ignored
	"Only meant for Messages or Assignments - else return nil"
	^ nil! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
emitBranchOn:
condition dist: dist pop: stack on: strm
	stack pop: 1.
	dist = 0 ifTrue: [^ strm nextPut: Pop].
	condition
		ifTrue: [self emitLong: dist code: BtpLong on: strm]
		ifFalse: [self emitShortOrLong: dist code: Bfp on: strm]! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
emitForEffect: stack on: strm

	self emitForValue: stack on: strm.
	strm nextPut: Pop.
	stack pop: 1! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
emitForReturn: stack on: strm

	self emitForValue: stack on: strm.
	strm nextPut: EndMethod! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
emitJump: dist on: strm

	dist = 0 ifFalse: [self emitShortOrLong: dist code: Jmp on: strm]! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
emitLong: dist code: longCode on: aStream 
	"Force a two-byte jump."
	| code distance |
	code _ longCode.
	distance _ dist.
	distance < 0
		ifTrue: 
			[distance _ distance + 1024.
			code _ code - 4]
		ifFalse: 
			[distance > 1023 ifTrue: [distance _ -1]].
	distance < 0
		ifTrue: 
			[self error: 'A block compiles more than 1K bytes of code']
		ifFalse: 
			[aStream nextPut: distance // 256 + code.
			aStream nextPut: distance \\ 256]! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
emitShortOrLong: dist code: shortCode on: strm
	(1 <= dist and: [dist <= JmpLimit])
		ifTrue: [strm nextPut: shortCode + dist - 1]
		ifFalse: [self emitLong: dist code: shortCode + (JmpLong-Jmp) on: strm]! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  nk 7/10/2004 10:04'!
pc
	"Used by encoder source mapping."

	^pc ifNil: [ 0 ]
! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
sizeBranchOn: condition dist: dist
	dist = 0 ifTrue: [^1].
	^ condition
		ifTrue: [2]  "Branch on true is always 2 bytes"
		ifFalse: [self sizeShortOrLong: dist]! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
sizeForEffect: encoder

	^(self sizeForValue: encoder) + 1! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
sizeForReturn: encoder

	^(self sizeForValue: encoder) + 1! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
sizeJump: dist

	dist = 0 ifTrue: [^0].
	^self sizeShortOrLong: dist! !

!MParseNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:22  <  '!
sizeShortOrLong: dist

	(1 <= dist and: [dist <= JmpLimit])
		ifTrue: [^1].
	^2! !

!MParseNode methodsFor: 'encoding' stamp: 'yo 11/9/2010 19:22  <  '!
encodeSelector: selector

	^nil! !

!MParseNode methodsFor: 'comment' stamp: 'yo 11/9/2010 19:22  <  '!
comment

	^comment! !

!MParseNode methodsFor: 'comment' stamp: 'yo 11/9/2010 19:22  <  '!
comment: newComment

	comment _ newComment! !

!MParseNode methodsFor: 'converting' stamp: 'yo 11/9/2010 19:22  <  '!
asReturnNode

	^ReturnNode new expr: self! !

!MParseNode methodsFor: 'printing' stamp: 'yo 11/9/2010 21:30'!
nodePrintOn: aStrm indent: nn
	| var aaStrm myLine |
	"Show just the sub nodes and the code."

	(aaStrm _ aStrm) ifNil: [aaStrm _ WriteStream on: (String new: 500)].
	nn timesRepeat: [aaStrm tab].
	aaStrm nextPutAll: self class name; space.
	myLine _ self printString copyWithout: Character cr.
	myLine _ myLine copyFrom: 1 to: (myLine size min: 70).
	aaStrm nextPutAll: myLine; cr.
	1 to: self class instSize do: [:ii | 
		var _ self instVarAt: ii.
		(var respondsTo: #asReturnNode) ifTrue: [var nodePrintOn: aaStrm indent: nn+1]].
	1 to: self class instSize do: [:ii | 
		var _ self instVarAt: ii.
		(var isKindOf: SequenceableCollection) ifTrue: [
				var do: [:aNode | 
					(aNode respondsTo: #asReturnNode) ifTrue: [
						aNode nodePrintOn: aaStrm indent: nn+1]]]].
	^ aaStrm
! !

!MParseNode methodsFor: 'printing' stamp: 'yo 11/10/2010 15:04'!
printCommentOn: aStream indent: indent 
	| thisComment |
	self comment == nil ifTrue: [^ self].
	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! !

!MParseNode methodsFor: 'printing' stamp: 'yo 11/9/2010 21:53'!
printOn: aStream 
	"Refer to the comment in Object|printOn:."

	aStream nextPutAll: '{'.
	self printOn: aStream indent: 0.
"	aStream nextPutAll: ((DialectStream dialect: #ST80
								contents: [:strm | self printOn: strm indent: 0])
							asString)."
	aStream nextPutAll: '}'! !

!MParseNode methodsFor: 'printing' stamp: 'yo 11/9/2010 19:22  <  '!
printOn: aStream indent: anInteger 
	"If control gets here, avoid recursion loop."

	super printOn: aStream! !

!MParseNode methodsFor: 'printing' stamp: 'yo 11/9/2010 19:22  <  '!
printOn: aStream indent: level precedence: p

	self printOn: aStream indent: level! !

!MParseNode methodsFor: 'private' stamp: 'yo 11/9/2010 19:22  <  ls 1/29/2004 21:17'!
ifNilReceiver
	"assuming this object is the receiver of an ifNil:, what object is being asked about?"
	^self! !

!MParseNode methodsFor: 'private' stamp: 'yo 11/9/2010 19:22  <  sma 5/28/2000 10:47'!
nextWordFrom: aStream setCharacter: aBlock
	| outStream char |
	outStream _ WriteStream on: (String new: 16).
	[(aStream peekFor: Character space) 
		or: [aStream peekFor: Character tab]] whileTrue.
	[aStream atEnd
		or:
			[char _ aStream next.
			char = Character cr or: [char = Character space]]]
		whileFalse: [outStream nextPut: char].
	aBlock value: char.
	^ outStream contents! !

!MParseNode methodsFor: 'private' stamp: 'yo 11/9/2010 21:52'!
printSingleComment: aString on: aStream indent: indent 
	"Print the comment string, assuming it has been indented indent tabs.
	Break the string at word breaks, given the widths in the default
	font, at 450 points."

	aStream nextPutAll: aString; cr.
! !


!MAssignmentNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:48  <  '!
toDoIncrement: var
	var = variable ifFalse: [^ nil].
	(value isMemberOf: MessageNode) 
		ifTrue: [^ value toDoIncrement: var]
		ifFalse: [^ nil]! !

!MAssignmentNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:48  <  '!
value
	^ value! !

!MAssignmentNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:48  <  '!
variable: aVariable value: expression

	variable _ aVariable.
	value _ expression! !

!MAssignmentNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:48  <  di 3/22/1999 12:00'!
variable: aVariable value: expression from: encoder

	(aVariable isMemberOf: MessageAsTempNode)
		ifTrue: ["Case of remote temp vars"
				^ aVariable store: expression from: encoder].
	variable _ aVariable.
	value _ expression! !

!MAssignmentNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:48  <  hmm 7/15/2001 21:17'!
variable: aVariable value: expression from: encoder sourceRange: range

	encoder noteSourceRange: range forNode: self.
	^self
		variable: aVariable
		value: expression
		from: encoder! !

!MAssignmentNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:49  <  di 9/5/2001 18:46'!
emitForEffect: stack on: aStream

	variable emitLoad: stack on: aStream.
	value emitForValue: stack on: aStream.
	variable emitStorePop: stack on: aStream.
	pc _ aStream position! !

!MAssignmentNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:49  <  di 9/5/2001 21:26'!
emitForValue: stack on: aStream

	variable emitLoad: stack on: aStream.
	value emitForValue: stack on: aStream.
	variable emitStore: stack on: aStream.
	pc _ aStream position! !

!MAssignmentNode methodsFor: 'code generation' stamp: 'yo 11/10/2010 21:20'!
sizeForEffect: encoder

	^(value sizeForValue: encoder)
		+ (variable sizeForStorePop: encoder)! !

!MAssignmentNode methodsFor: 'code generation' stamp: 'yo 11/10/2010 21:19'!
sizeForValue: encoder

	^(value sizeForValue: encoder)
		+ (variable sizeForStore: encoder)! !

!MAssignmentNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:47'!
printOn: aStream indent: level 
	false
		ifTrue: []
		ifFalse: [variable printOn: aStream indent: level.
			aStream
				nextPutAll: (' := ').
			value printOn: aStream indent: level + 2]! !

!MAssignmentNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:48'!
printOn: aStream indent: level precedence: p

	(false
			ifTrue: [p < 3]
			ifFalse: [p < 4])
		ifTrue: [aStream nextPutAll: '('.
				self printOn: aStream indent: level.
				aStream nextPutAll: ')']
		ifFalse: [self printOn: aStream indent: level]! !

!MAssignmentNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 19:49  <  '!
variable
	^variable! !


!MBlockNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:51  <  '!
arguments: argNodes statements: statementsCollection returns: returnBool from: encoder
	"Compile."

	arguments _ argNodes.
	statements _ statementsCollection size > 0
				ifTrue: [statementsCollection]
				ifFalse: [argNodes size > 0
						ifTrue: [statementsCollection copyWith: arguments last]
						ifFalse: [Array with: NodeNil]].
	returns _ returnBool! !

!MBlockNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:51  <  hmm 7/15/2001 22:23'!
arguments: argNodes statements: statementsCollection returns: returnBool from: encoder sourceRange: range
	"Compile."

	encoder noteSourceRange: range forNode: self.
	^self
		arguments: argNodes
		statements: statementsCollection
		returns: returnBool
		from: encoder! !

!MBlockNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:51  <  sma 3/3/2000 13:38'!
statements: statementsCollection returns: returnBool 
	"Decompile."

	| returnLast |
	returnLast _ returnBool.
	returns _ false.
	statements _ 
		(statementsCollection size > 1 
			and: [(statementsCollection at: statementsCollection size - 1) 
					isReturningIf])
				ifTrue: 
					[returnLast _ false.
					statementsCollection allButLast]
				ifFalse: [statementsCollection size = 0
						ifTrue: [Array with: NodeNil]
						ifFalse: [statementsCollection]].
	arguments _ #().
	temporaries _ #().
	returnLast ifTrue: [self returnLast]! !

!MBlockNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:51  <  '!
arguments: argNodes 
	"Decompile."

	arguments _ argNodes! !

!MBlockNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:51  <  tk 8/4/1999 22:53'!
block
	^ self! !

!MBlockNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:51  <  '!
firstArgument
	^ arguments first! !

!MBlockNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:51  <  '!
numberOfArguments

	^arguments size! !

!MBlockNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:51  <  '!
returnLast

	self returns
		ifFalse: 
			[returns _ true.
			statements at: statements size put: statements last asReturnNode]! !

!MBlockNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:51  <  '!
returnSelfIfNoOther

	self returns
		ifFalse: 
			[statements last == NodeSelf ifFalse: [statements add: NodeSelf].
			self returnLast]! !

!MBlockNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:51  <  sma 2/27/2000 22:37'!
temporaries: aCollection
	temporaries _ aCollection! !

!MBlockNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:51  <  '!
canBeSpecialArgument
	"Can I be an argument of (e.g.) ifTrue:?"

	^arguments size = 0! !

!MBlockNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:51  <  '!
isComplex

	^statements size > 1 or: [statements size = 1 and: [statements first isComplex]]! !

!MBlockNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:51  <  '!
isJustCaseError

	^ statements size = 1 and:
		[statements first
			isMessage: #caseError
			receiver: [:r | r==NodeSelf]
			arguments: nil]! !

!MBlockNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:51  <  '!
isJust: node

	returns ifTrue: [^false].
	^statements size = 1 and: [statements first == node]! !

!MBlockNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:51  <  '!
isQuick
	^ statements size = 1
		and: [statements first isVariableReference
				or: [statements first isSpecialConstant]]! !

!MBlockNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:51  <  '!
returns

	^returns or: [statements last isReturningIf]! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  '!
code

	^statements first code! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  di 11/19/1999 19:32'!
emitExceptLast: stack on: aStream
	| nextToLast |
	nextToLast _ statements size - 1.
	nextToLast < 1 ifTrue: [^ self].  "Only one statement"
	1 to: nextToLast do:
		[:i | (statements at: i) emitForEffect: stack on: aStream].
! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  '!
emitForEvaluatedEffect: stack on: aStream

	self returns
		ifTrue: 
			[self emitForEvaluatedValue: stack on: aStream.
			stack pop: 1]
		ifFalse: 
			[self emitExceptLast: stack on: aStream.
			statements last emitForEffect: stack on: aStream]! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  di 11/19/1999 19:44'!
emitForEvaluatedValue: stack on: aStream
	self emitExceptLast: stack on: aStream.
	statements last emitForValue: stack on: aStream.
! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  hmm 7/17/2001 21:02'!
emitForValue: stack on: aStream

	aStream nextPut: LdThisContext.
	stack push: 1.
	nArgsNode emitForValue: stack on: aStream.
	remoteCopyNode
		emit: stack
		args: 1
		on: aStream.
	"Force a two byte jump."
	self emitLong: size code: JmpLong on: aStream.
	stack push: arguments size.
	arguments reverseDo: [:arg | arg emitStorePop: stack on: aStream].
	self emitForEvaluatedValue: stack on: aStream.
	self returns ifFalse: [
		aStream nextPut: EndRemote.
		pc _ aStream position.
	].
	stack pop: 1! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  di 11/19/1999 19:33'!
sizeExceptLast: encoder
	| codeSize nextToLast |
	nextToLast _ statements size - 1.
	nextToLast < 1 ifTrue: [^ 0]. "Only one statement"
	codeSize _ 0.
	1 to: nextToLast do: 
		[:i | codeSize _ codeSize + ((statements at: i) sizeForEffect: encoder)].
	^ codeSize! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  '!
sizeForEvaluatedEffect: encoder

	self returns ifTrue: [^self sizeForEvaluatedValue: encoder].
	^(self sizeExceptLast: encoder)
		+ (statements last sizeForEffect: encoder)! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  '!
sizeForEvaluatedValue: encoder

	^(self sizeExceptLast: encoder)
		+ (statements last sizeForValue: encoder)! !

!MBlockNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:51  <  '!
sizeForValue: encoder
	nArgsNode _ encoder encodeLiteral: arguments size.
	remoteCopyNode _ encoder encodeSelector: #blockCopy:.
	size _ (self sizeForEvaluatedValue: encoder)
				+ (self returns ifTrue: [0] ifFalse: [1]). "endBlock"
	arguments _ arguments collect:  "Chance to prepare debugger remote temps"
				[:arg | arg asStorableNode: encoder].
	arguments do: [:arg | size _ size + (arg sizeForStorePop: encoder)].
	^1 + (nArgsNode sizeForValue: encoder) 
		+ (remoteCopyNode size: encoder args: 1 super: false) + 2 + size! !

!MBlockNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:48'!
printArgumentsOn: aStream indent: level
	arguments size = 0
		ifTrue: [^ self].
	false
		ifTrue: []
		ifFalse: [arguments
				do: [:arg | aStream nextPutAll: ':';
								 nextPutAll: arg key;
								 space].
			aStream nextPutAll: '| '].
	"If >0 args and >1 statement, put all statements on separate lines"
	statements size > 1
		ifTrue: [aStream crtab: level]! !

!MBlockNode methodsFor: 'printing' stamp: 'yo 11/9/2010 19:51  <  di 5/1/2000 23:49'!
printOn: aStream indent: level

	"statements size <= 1 ifFalse: [aStream crtab: level]."
	aStream nextPut: $[.
	self printArgumentsOn: aStream indent: level.
	self printTemporariesOn: aStream indent: level.
	self printStatementsOn: aStream indent: level.
	aStream nextPut: $]! !

!MBlockNode methodsFor: 'printing' stamp: 'yo 11/9/2010 19:51  <  di 4/3/1999 23:25'!
printStatementsOn: aStream indent: levelOrZero
	| len shown thisStatement level |
	level _ 1 max: levelOrZero.
	comment == nil
		ifFalse: 
			[self printCommentOn: aStream indent: level.
			aStream crtab: level].
	len _ shown _ statements size.
	(levelOrZero = 0 "top level" and: [statements last isReturnSelf])
		ifTrue: [shown _ 1 max: shown - 1]
		ifFalse: [(len = 1 and: [((statements at: 1) == NodeNil) & (arguments size = 0)])
					ifTrue: [shown _ shown - 1]].
	1 to: shown do: 
		[:i | 
		thisStatement _ statements at: i.
		thisStatement printOn: aStream indent: level.
		i < shown ifTrue: [aStream nextPut: $.; crtab: level].
		(thisStatement comment ~~ nil and: [thisStatement comment size > 0])
			ifTrue: 
				[i = shown ifTrue: [aStream crtab: level].
				thisStatement printCommentOn: aStream indent: level.
				i < shown ifTrue: [aStream crtab: level]]]! !

!MBlockNode methodsFor: 'printing' stamp: 'yo 11/10/2010 15:04'!
printTemporariesOn: aStream indent: level

	(temporaries == nil or: [temporaries size = 0])
		ifFalse: 
			[aStream nextPut: $|.
			temporaries do: 
				[:arg | 
				aStream
					space;
					nextPutAll: arg key].
			aStream nextPutAll: ' | '.
			"If >0 args and >1 statement, put all statements on separate lines"
			statements size > 1 ifTrue: [aStream crtab: level]]! !

!MBlockNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 19:51  <  '!
statements
	^statements! !

!MBlockNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 19:51  <  '!
statements: val
	statements _ val! !


!MBraceNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:52  <  '!
elements: collection
	"Decompile."

	elements _ collection! !

!MBraceNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:52  <  '!
elements: collection sourceLocations: locations
	"Compile."

	elements _ collection.
	sourceLocations _ locations! !

!MBraceNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:52  <  di 11/19/1999 11:06'!
matchBraceStreamReceiver: receiver messages: messages

	((receiver isMessage: #braceStream: receiver: nil arguments: [:arg | arg isConstantNumber])
		and: [messages last isMessage: #braceArray receiver: nil arguments: nil])
		ifFalse: [^ nil "no match"].

	"Appears to be a long form brace construct"
	self elements: (messages allButLast collect:
		[:msg | (msg isMessage: #nextPut: receiver: nil arguments: nil)
					ifFalse: [^ nil "not a brace element"].
		msg arguments first])! !

!MBraceNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:52  <  di 11/19/1999 11:19'!
matchBraceWithReceiver: receiver selector: selector arguments: arguments

	selector = (self selectorForShortForm: arguments size)
		ifFalse: [^ nil "no match"].

	"Appears to be a short form brace construct"
	self elements: arguments! !

!MBraceNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:53  <  '!
blockAssociationCheck: encoder
	"If all elements are MessageNodes of the form [block]->[block], and there is at
	 least one element, answer true.
	 Otherwise, notify encoder of an error."

	elements size = 0
		ifTrue: [^encoder notify: 'At least one case required'].
	elements with: sourceLocations do:
			[:x :loc |
			(x 	isMessage: #->
				receiver:
					[:rcvr |
					(rcvr isKindOf: BlockNode) and: [rcvr numberOfArguments = 0]]
				arguments:
					[:arg |
					(arg isKindOf: BlockNode) and: [arg numberOfArguments = 0]])
			  ifFalse:
				[^encoder notify: 'Association between 0-argument blocks required' at: loc]].
	^true! !

!MBraceNode methodsFor: 'testing' stamp: 'yo 11/9/2010 19:53  <  '!
numElements

	^ elements size! !

!MBraceNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 21:41'!
arrayClassNameFor: encoder

	^ #Array! !

!MBraceNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:53  <  di 11/19/1999 08:58'!
emitForValue: stack on: aStream

	^ emitNode emitForValue: stack on: aStream! !

!MBraceNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:53  <  di 1/4/2000 11:24'!
selectorForShortForm: nElements

	nElements > 4 ifTrue: [^ nil].
	^ #(braceWithNone braceWith: braceWith:with:
			braceWith:with:with: braceWith:with:with:with:) at: nElements + 1! !

!MBraceNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:53  <  yo 7/14/2009 13:47'!
sizeForValue: encoder

	emitNode _ elements size <= 4
		ifTrue: ["Short form: Array braceWith: a with: b ... "
				MessageNode new
					receiver: (encoder encodeVariable: (self arrayClassNameFor: encoder))
					selector: (self selectorForShortForm: elements size)
					arguments: elements precedence: 3 from: encoder]
		ifFalse: ["Long form: (Array braceStream: N) nextPut: a; nextPut: b; ...; braceArray"
				CascadeNode new
					receiver: (MessageNode new
								receiver: (encoder encodeVariable: (self arrayClassNameFor: encoder))
								selector: #braceStream:
								arguments: (Array with: (encoder encodeLiteral: elements size))
								precedence: 3 from: encoder)
					messages: ((elements collect: [:elt | MessageNode new receiver: nil
														selector: #nextPut:
														arguments: (Array with: elt)
														precedence: 3 from: encoder])
								copyWith: (MessageNode new receiver: nil
														selector: #braceArray
														arguments: (Array new)
														precedence: 1 from: encoder))].
	^ emitNode sizeForValue: encoder! !

!MBraceNode methodsFor: 'enumerating' stamp: 'yo 11/9/2010 19:53  <  '!
casesForwardDo: aBlock
	"For each case in forward order, evaluate aBlock with three arguments:
	 the key block, the value block, and whether it is the last case."

	| numCases case |
	1 to: (numCases _ elements size) do:
		[:i |
		case _ elements at: i.
		aBlock value: case receiver value: case arguments first value: i=numCases]! !

!MBraceNode methodsFor: 'enumerating' stamp: 'yo 11/9/2010 19:53  <  '!
casesReverseDo: aBlock
	"For each case in reverse order, evaluate aBlock with three arguments:
	 the key block, the value block, and whether it is the last case."

	| numCases case |
	(numCases _ elements size) to: 1 by: -1 do:
		[:i |
		case _ elements at: i.
		aBlock value: case receiver value: case arguments first value: i=numCases]! !

!MBraceNode methodsFor: 'printing' stamp: 'yo 11/9/2010 19:56  <  di 11/19/1999 09:17'!
printOn: aStream indent: level

	aStream nextPut: ${.
	1 to: elements size do: 
		[:i | (elements at: i) printOn: aStream indent: level.
		i < elements size ifTrue: [aStream nextPutAll: '. ']].
	aStream nextPut: $}! !


!MCascadeNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 19:57  <  '!
receiver: receivingObject messages: msgs
	" Transcript show: 'abc'; cr; show: 'def' "

	receiver _ receivingObject.
	messages _ msgs! !

!MCascadeNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:57  <  '!
emitForValue: stack on: aStream

	receiver emitForValue: stack on: aStream.
	1 to: messages size - 1 do: 
		[:i | 
		aStream nextPut: Dup.
		stack push: 1.
		(messages at: i) emitForValue: stack on: aStream.
		aStream nextPut: Pop.
		stack pop: 1].
	messages last emitForValue: stack on: aStream! !

!MCascadeNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 19:57  <  '!
sizeForValue: encoder

	| size |
	size _ (receiver sizeForValue: encoder) + (messages size - 1 * 2).
	messages do: [:aMessage | size _ size + (aMessage sizeForValue: encoder)].
	^size! !

!MCascadeNode methodsFor: 'printing' stamp: 'yo 11/9/2010 19:57  <  '!
printOn: aStream indent: level
	self printOn: aStream indent: level precedence: 0! !

!MCascadeNode methodsFor: 'printing' stamp: 'yo 11/9/2010 19:57  <  di 4/25/2000 19:17'!
printOn: aStream indent: level precedence: p 

	p > 0 ifTrue: [aStream nextPut: $(].
	messages first printReceiver: receiver on: aStream indent: level.
	1 to: messages size do: 
		[:i | (messages at: i) printOn: aStream indent: level.
		i < messages size ifTrue: 
				[aStream nextPut: $;.
				messages first precedence >= 2 ifTrue: [aStream crtab: level + 1]]].
	p > 0 ifTrue: [aStream nextPut: $)]! !

!MCascadeNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 19:57  <  tk 10/22/2000 16:55'!
receiver
	^receiver! !


!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/11/2010 00:11'!
fillDictWithString: dict with: nodeClass mapping: keys to: codeArray
	| codeStream |
	codeStream _ ReadStream on: codeArray.
	keys do: 
		[:key | dict 
				at: (String newFrom: key)
				put:  (nodeClass new name: (String newFrom: key) key: (String newFrom: key) code: codeStream next)]! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:01  <  '!
fillDict: dict with: nodeClass mapping: keys to: codeArray
	| codeStream |
	codeStream _ ReadStream on: codeArray.
	keys do: 
		[:key | dict 
				at: key
				put:  (nodeClass new name: key key: key code: codeStream next)]! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:01  <  eem 3/12/2009 16:13'!
initScopeAndLiteralTables

	scopeTable := StdVariables copy.
	litSet := StdLiterals copy.
	"comments can be left hanging on nodes from previous compilations.
	 probably better than this hack fix is to create the nodes afresh on each compilation."
	scopeTable do:
		[:varNode| varNode comment: nil].
	litSet do:
		[:varNode| varNode comment: nil].
	selectorSet := StdSelectors copy.
	litIndSet := Dictionary new: 16.
	literalStream := WriteStream on: (Array new: 32).
	addedSelectorAndMethodClassLiterals := false! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:01  <  di 12/4/1999 22:22'!
init: aClass context: aContext notifying: req
	| node n homeNode indexNode |
	requestor _ req.
	class _ aClass.
	nTemps _ 0.
	supered _ false.
	self initScopeAndLiteralTables.
	n _ -1.
	class allInstVarNames do: 
		[:variable | 
		node _ VariableNode new
					name: variable
					index: (n _ n + 1)
					type: LdInstType.
		scopeTable at: variable put: node].
	aContext == nil
		ifFalse: 
			[homeNode _ self bindTemp: 'homeContext'.
			"first temp = aContext passed as arg"
			n _ 0.
			aContext tempNames do: 
				[:variable | 
				indexNode _ self encodeLiteral: (n _ n + 1).
				node _ MessageAsTempNode new
							receiver: homeNode
							selector: #tempAt:
							arguments: (Array with: indexNode)
							precedence: 3
							from: self.
				scopeTable at: variable put: node]].
	sourceRanges _ Dictionary new: 32.
	globalSourceRanges _ OrderedCollection new: 32.
! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/10/2010 20:19'!
namespace: anObject

	namespace := anObject.
! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:01  <  '!
noteSuper

	supered _ true! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:01  <  ajh 1/24/2003 18:46'!
nTemps: n literals: lits class: cl 
	"Decompile."

	supered _ false.
	class _ cl.
	nTemps _ n.
	literalStream _ ReadStream on: lits.
	literalStream position: lits size.
	sourceRanges _ Dictionary new: 32.
	globalSourceRanges _ OrderedCollection new: 32.
! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:01  <  '!
release

	requestor _ nil! !

!MEncoder methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:01  <  ajh 7/21/2003 00:53'!
temps: tempVars literals: lits class: cl 
	"Decompile."

	supered _ false.
	class _ cl.
	nTemps _ tempVars size.
	tempVars do: [:node | scopeTable at: node name put: node].
	literalStream _ ReadStream on: lits.
	literalStream position: lits size.
	sourceRanges _ Dictionary new: 32.
	globalSourceRanges _ OrderedCollection new: 32.
! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 20:01  <  '!
cantStoreInto: varName

	^StdVariables includesKey: varName! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 20:01  <  '!
encodeLiteral: object

	^self
		name: object
		key: (class literalScannedAs: object notifying: self)
		class: LiteralNode
		type: LdLitType
		set: litSet! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 20:01  <  '!
encodeSelector: selector

	^self
		name: selector
		key: selector
		class: SelectorNode
		type: SendType
		set: selectorSet! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 20:01  <  di 12/4/1999 20:09'!
encodeVariable: name
	^ self encodeVariable: name sourceRange: nil ifUnknown: [ self undeclared: name ]! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 20:01  <  ls 1/19/2001 12:59'!
encodeVariable: name ifUnknown: action
	^self encodeVariable: name sourceRange: nil ifUnknown: action! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 12/9/2010 22:59'!
encodeVariable: name sourceRange: range ifUnknown: action
	| varNode |
	varNode _ scopeTable at: name
			ifAbsent: 
				[(self lookupInPools: name 
					ifFound: [:assoc | varNode _ self global: assoc name: name])
					ifTrue: [varNode]
					ifFalse: [action value]].
	range ifNotNil: [
		name first isUppercase ifTrue:
			[globalSourceRanges add: (Array with: name with: range with: false) ]. ].

	(varNode isTemp and: [varNode scope < 0]) ifTrue: [
		"OutOfScopeNotification signal ifFalse: [ ^self notify: 'out of scope']."
		self error: 'out of scope'.
	].
	^ varNode! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 21:48'!
environment
	"Answer the environment of the current compilation context,
	 be it in a class or global (e.g. a workspace)"
	^class == nil
		ifTrue: [System globals]
		ifFalse: [class environment]! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 20:01  <  '!
litIndex: literal
	| p |
	p _ literalStream position.
	p = 256 ifTrue:
		[self notify: 'More than 256 literals referenced. 
You must split or otherwise simplify this method.
The 257th literal is: ', literal printString. ^nil].
		"Would like to show where it is in the source code, 
		 but that info is hard to get."
	literalStream nextPut: literal.
	^ p! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/9/2010 20:01  <  di 1/7/2000 15:24'!
sharableLitIndex: literal
	"Special access prevents multiple entries for post-allocated super send special selectors"
	| p |
	p _ literalStream originalContents indexOf: literal.
	p = 0 ifFalse: [^ p-1].
	^ self litIndex: literal
! !

!MEncoder methodsFor: 'encoding' stamp: 'yo 11/10/2010 23:42'!
undeclared: name

	| sym |
	sym _ name asSymbol.
	self flag: #mobjects.
	Object superclass == nil ifTrue: [System globals at: sym put: nil].
	^self global: (System globals associationAt: sym) name: sym! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/9/2010 20:01  <  '!
autoBind: name 
	"Declare a block argument as a temp if not already declared."
	| node |
	node _ scopeTable 
			at: name
			ifAbsent: 
				[(self lookupInPools: name ifFound: [:assoc | assoc])
					ifTrue: [self notify: 'Name already used in a Pool or Global'].
				^ (self reallyBind: name) nowHasDef nowHasRef scope: 1].
	node isTemp
		ifTrue: [node scope >= 0 ifTrue:
					[^ self notify: 'Name already used in this method'].
				node nowHasDef nowHasRef scope: 1]
		ifFalse: [^ self notify: 'Name already used in this class'].
	^node! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/9/2010 20:01  <  di 10/12/1999 16:53'!
bindAndJuggle: name

	| node nodes first thisCode |
	node _ self reallyBind: name.

	"Declared temps must precede block temps for decompiler and debugger to work right"
	nodes _ self tempNodes.
	(first _ nodes findFirst: [:n | n scope > 0]) > 0 ifTrue:
		[node == nodes last ifFalse: [self error: 'logic error'].
		thisCode _ (nodes at: first) code.
		first to: nodes size - 1 do:
			[:i | (nodes at: i) key: (nodes at: i) key
							code: (nodes at: i+1) code].
		nodes last key: nodes last key code: thisCode].
	
	^ node! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/9/2010 20:01  <  jm 9/18/97 21:06'!
bindArg: name 
	"Declare an argument."
	| node |
	nTemps >= 15
		ifTrue: [^self notify: 'Too many arguments'].
	node _ self bindTemp: name.
	^ node nowHasDef nowHasRef! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/9/2010 20:01  <  crl 2/26/1999 12:18'!
bindBlockTemp: name 
	"Declare a temporary block variable; complain if it's not a field or class variable."

	| node |

	node _ scopeTable at: name ifAbsent: [^self reallyBind: name].
	node isTemp
		ifTrue: [
			node scope >= 0 ifTrue: [^ self notify: 'Name already used in this method'].
			node scope: 0]
		ifFalse: [^self notify: 'Name already used in this class'].
	^node
! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/10/2010 20:39'!
bindTemp: name 
	"Declare a temporary; error not if a field or class variable."
	scopeTable at: name ifPresent:[:node|
		"When non-interactive raise the error only if its a duplicate"
		(false)
			ifTrue:[^self notify:'Name is already defined']
			ifFalse:["Transcript 
				show: '(', name, ' is shadowed in "' , class printString, '")'"]].
	^self reallyBind: name! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/10/2010 20:39'!
bindTemp: name in: methodSelector
	"Declare a temporary; error not if a field or class variable."
	scopeTable at: name ifPresent:[:node|
		"When non-interactive raise the error only if its a duplicate"
		(false)
			ifTrue:[^self notify:'Name is already defined']
			ifFalse:["Transcript 
				show: '(', name, ' is shadowed in "' , class printString , '>>' , methodSelector printString , '")'"]].
	^self reallyBind: name! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/9/2010 20:01  <  eem 7/13/2007 14:13'!
floatTemp: node
	(node ~~ (scopeTable at: node name ifAbsent: [])
	or: [node class ~~ TempVariableNode
	or: [node code ~= (node code: nTemps - 1 type: LdTempType)]]) ifTrue:
		[self error: 'can only float the last allocated temp var'].
	nTemps := nTemps - 1! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/9/2010 20:01  <  '!
maxTemp

	^nTemps! !

!MEncoder methodsFor: 'temps' stamp: 'yo 11/9/2010 20:01  <  '!
newTemp: name

	nTemps _ nTemps + 1.
	^ TempVariableNode new
		name: name
		index: nTemps - 1
		type: LdTempType
		scope: 0! !

!MEncoder methodsFor: 'results' stamp: 'yo 11/9/2010 20:01  <  bgf 3/12/2009 17:42'!
allLiterals
	((literalStream isKindOf: WriteStream)
	 and: [ (addedSelectorAndMethodClassLiterals ifNil: [ false ]) not]) ifTrue:
		[addedSelectorAndMethodClassLiterals := true.
		 self litIndex: nil.
		 self litIndex: self associationForClass].
	^literalStream contents

	"The funky ifNil: [false], even though the init method initializes addedSAMCL,
	 is simply so that Monticello can load and compile this update without
	 killing the encoder that is compiling that update itself..."! !

!MEncoder methodsFor: 'results' stamp: 'yo 11/11/2010 18:14'!
associationForClass
	| assoc |
	assoc := System globals associationAt: class name ifAbsent: [nil].
	^assoc value == class
		ifTrue: [assoc]
		ifFalse: [Association new value: class]! !

!MEncoder methodsFor: 'results' stamp: 'yo 11/9/2010 20:01  <  '!
literals
	"Should only be used for decompiling primitives"
	^ literalStream contents! !

!MEncoder methodsFor: 'results' stamp: 'yo 11/9/2010 20:01  <  di 10/12/1999 16:12'!
tempNames 

	^ self tempNodes collect:
		[:node | (node isMemberOf: MessageAsTempNode)
					ifTrue: [scopeTable keyAtValue: node]
					ifFalse: [node key]]! !

!MEncoder methodsFor: 'results' stamp: 'yo 11/10/2010 21:35'!
tempNodes 
	^ (Array streamContents: [:tempNodes |
		scopeTable associationsDo:
			[:assn | assn value isTemp ifTrue: [tempNodes nextPut: assn value]]]) sort: [:n1 :n2 | n1 code <= n2 code]

"SortedCollection sortBlock: [:n1 :n2 | n1 code <= n2 code]."
! !

!MEncoder methodsFor: 'results' stamp: 'yo 11/10/2010 14:23'!
unusedTempNames 
	| unused name |
	unused _ OrderedCollection new.
	scopeTable associationsDo:
		[:assn | (assn value isUnusedTemp)
			ifTrue: [name _ assn value key.
					name ~= #homeContext ifTrue: [unused add: name]]].
	^ unused! !

!MEncoder methodsFor: 'error handling' stamp: 'yo 11/9/2010 20:01  <  '!
notify: string
	"Put a separate notifier on top of the requestor's window"
	| req |
	requestor == nil
		ifFalse: 
			[req _ requestor.
			self release.
			req notify: string].
	^false! !

!MEncoder methodsFor: 'error handling' stamp: 'yo 11/9/2010 20:01  <  '!
notify: string at: location

	| req |
	requestor == nil
		ifFalse: 
			[req _ requestor.
			self release.
			req notify: string at: location].
	^false! !

!MEncoder methodsFor: 'error handling' stamp: 'yo 11/9/2010 20:01  <  '!
requestor: req
	"Often the requestor is a BrowserCodeController"
	requestor _ req! !

!MEncoder methodsFor: 'source mapping' stamp: 'yo 11/9/2010 20:02  <  di 12/4/1999 22:27'!
globalSourceRanges

	^ globalSourceRanges! !

!MEncoder methodsFor: 'source mapping' stamp: 'yo 11/9/2010 20:02  <  '!
noteSourceRange: range forNode: node

	sourceRanges at: node put: range! !

!MEncoder methodsFor: 'source mapping' stamp: 'yo 11/9/2010 20:02  <  RAA 8/21/1999 06:52'!
rawSourceRanges

	^ sourceRanges ! !

!MEncoder methodsFor: 'private' stamp: 'yo 11/9/2010 20:02  <  '!
classEncoding
	"This is a hack so that the parser may findout what class it was parsing for when it wants to create a syntax error view."
	^ class! !

!MEncoder methodsFor: 'private' stamp: 'yo 11/9/2010 20:02  <  ar 8/14/2001 23:12'!
global: ref name: name

	^self
		name: name
		key: ref
		class: LiteralVariableNode
		type: LdLitIndType
		set: litIndSet! !

!MEncoder methodsFor: 'private' stamp: 'yo 11/9/2010 21:47'!
lookupInPools: varName ifFound: assocBlock

	Symbol hasInterned: varName ifTrue:[:sym|
		(class bindingOf: sym) ifNotNilDo:[:assoc| 
			assocBlock value: assoc.
			^true].
		^ false].
	(class bindingOf: varName) ifNotNilDo:[:assoc|
		assocBlock value: assoc.
		^true].
	^false! !

!MEncoder methodsFor: 'private' stamp: 'yo 11/9/2010 20:02  <  '!
name: name key: key class: leafNodeClass type: type set: dict

	| node |
	^dict 
		at: key
		ifAbsent: 
			[node _ leafNodeClass new
						name: name
						key: key
						index: nil
						type: type.
			dict at: key put: node.
			^node]! !

!MEncoder methodsFor: 'private' stamp: 'yo 11/9/2010 20:02  <  '!
reallyBind: name

	| node |
	node _ self newTemp: name.
	scopeTable at: name put: node.
	^node! !


!MLeafNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:02  <  ab 7/13/2004 13:51'!
key: object code: byte

	self key: object.
	self code: byte! !

!MLeafNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:02  <  '!
key: object index: i type: type

	self key: object code: (self code: i type: type)! !

!MLeafNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:02  <  ab 7/13/2004 13:52'!
name: ignored key: object code: byte

	self key: object.
	self code: byte! !

!MLeafNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:02  <  '!
name: literal key: object index: i type: type

	self key: object
		index: i
		type: type! !

!MLeafNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 20:02  <  '!
key

	^key! !

!MLeafNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 23:03'!
key: anObject

	key _ anObject.
! !

!MLeafNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:02  <  ab 7/6/2004 17:39'!
code

	^ code! !

!MLeafNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:02  <  ab 7/6/2004 17:41'!
code: aValue

	code := aValue! !

!MLeafNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:02  <  '!
emitForEffect: stack on: strm

	^self! !

!MLeafNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:02  <  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].
! !

!MLeafNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:02  <  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)]! !

!MLeafNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:02  <  '!
sizeForEffect: encoder

	^0! !

!MLeafNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:02  <  ab 7/6/2004 17:40'!
sizeForValue: encoder
	self reserve: encoder.
	self code < 256 ifTrue: [^ 1].
	(self code \\ 256) <= 63 ifTrue: [^ 2].
	^ 3! !

!MLeafNode methodsFor: 'private' stamp: 'yo 11/9/2010 20:03  <  '!
code: index type: type

	index isNil 
		ifTrue: [^type negated].
	(CodeLimits at: type) > index 
		ifTrue: [^(CodeBases at: type) + index].
	^type * 256 + index! !


!MLiteralNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:04  <  '!
emitForValue: stack on: strm

	code < 256
		ifTrue: [strm nextPut: code]
		ifFalse: [self emitLong: LoadLong on: strm].
	stack push: 1! !

!MLiteralNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:05  <  '!
isConstantNumber
	^ key isNumber! !

!MLiteralNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:05  <  di 4/5/2000 11:13'!
isLiteral

	^ true! !

!MLiteralNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:05  <  '!
isSpecialConstant
	^ code between: LdTrue and: LdMinus1+3! !

!MLiteralNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:05  <  '!
literalValue

	^key! !

!MLiteralNode methodsFor: 'printing' stamp: 'yo 11/10/2010 15:11'!
printOn: aStream indent: level

	(key isVariableBinding)
		ifTrue:
			[key key isNil
				ifTrue:
					[aStream nextPutAll: '###';
					 	nextPutAll: key value soleInstance name]
				ifFalse:
					[aStream nextPutAll: '##';
						nextPutAll: key key]]
		ifFalse:
			[aStream print: key]! !

!MLiteralNode methodsFor: 'evaluation' stamp: 'yo 11/9/2010 20:04  <  tk 8/4/1999 17:35'!
eval
	"When everything in me is a constant, I can produce a value.  This is only used by the Scripting system (TilePadMorph tilesFrom:in:)"

	^ key! !


!MMessageNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:29  <  di 6/6/2000 23:24'!
receiver: rcvr selector: selNode arguments: args precedence: p 
	"Decompile."

	self receiver: rcvr
		arguments: args
		precedence: p.
	self noteSpecialSelector: selNode key.
	selector _ selNode.
	"self pvtCheckForPvtSelector: encoder"
	"We could test code being decompiled, but the compiler should've checked already. And where to send the complaint?"! !

!MMessageNode methodsFor: 'initialize-release' stamp: 'yo 11/10/2010 15:03'!
receiver: rcvr selector: aSelector arguments: args precedence: p from: encoder 
	"Compile."

	| theSelector |
	self receiver: rcvr
		arguments: args
		precedence: p.
	aSelector = #':Repeat:do:'
		ifTrue: [theSelector _ #do:]
		ifFalse: [theSelector _ aSelector].
	self noteSpecialSelector: theSelector.
	(self transform: encoder)
		ifTrue: 
			[selector isNil
				ifTrue: [selector _ SelectorNode new 
							key: (MacroSelectors at: special)
							code: #macro]]
		ifFalse: 
			[selector _ encoder encodeSelector: theSelector.
			rcvr == NodeSuper ifTrue: [encoder noteSuper]].
! !

!MMessageNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:29  <  '!
receiver: rcvr selector: selName arguments: args precedence: p from: encoder sourceRange: range 
	"Compile."

	encoder noteSourceRange: range forNode: self.
	^self
		receiver: rcvr
		selector: selName
		arguments: args
		precedence: p
		from: encoder! !

!MMessageNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:29  <  tk 6/12/2008 21:44'!
selector: sel

	selector _ sel! !

!MMessageNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:29  <  '!
canCascade

	^(receiver == NodeSuper or: [special > 0]) not! !

!MMessageNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:29  <  '!
isComplex
	
	^(special between: 1 and: 10) or: [arguments size > 2 or: [receiver isComplex]]! !

!MMessageNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:29  <  '!
isMessage: selSymbol receiver: rcvrPred arguments: argsPred
	"Answer whether selector is selSymbol, and the predicates rcvrPred and argsPred
	 evaluate to true with respect to receiver and the list of arguments.  If selSymbol or
	 either predicate is nil, it means 'don't care'.  Note that argsPred takes numArgs
	 arguments.  All block arguments are ParseNodes."

	^(selSymbol isNil or: [selSymbol==selector key]) and:
		[(rcvrPred isNil or: [rcvrPred value: receiver]) and:
			[(argsPred isNil or: [argsPred valueWithArguments: arguments])]]! !

!MMessageNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:29  <  '!
isReturningIf

	^(special between: 3 and: 4)
		and: [arguments first returns and: [arguments last returns]]! !

!MMessageNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:29  <  '!
toDoIncrement: variable
	(receiver = variable and: [selector key = #+]) 
		ifFalse: [^ nil].
	arguments first isConstantNumber
		ifTrue: [^ arguments first]
		ifFalse: [^ nil]! !

!MMessageNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:29  <  '!
toDoLimit: variable
	(receiver = variable and: [selector key = #<= or: [selector key = #>=]]) 
		ifTrue: [^ arguments first]
		ifFalse: [^ nil]! !

!MMessageNode methodsFor: 'cascading' stamp: 'yo 11/9/2010 20:29  <  '!
cascadeReceiver
	"Nil out rcvr (to indicate cascade) and return what it had been."

	| rcvr |
	rcvr _ receiver.
	receiver _ nil.
	^rcvr! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/11/2010 18:13'!
noteSpecialSelector: selectorSymbol
	" special > 0 denotes specially treated messages. "

	special _ MacroSelectors indexOf: selectorSymbol.
! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  sma 3/3/2000 13:37'!
toDoFromWhileWithInit: initStmt
	"Return nil, or a to:do: expression equivalent to this whileTrue:"
	| variable increment limit toDoBlock body test |
	(selector key == #whileTrue:
		and: [(initStmt isMemberOf: AssignmentNode) and:
				[initStmt variable isTemp]])
		ifFalse: [^ nil].
	body _ arguments last statements.
	variable _ initStmt variable.
	increment _ body last toDoIncrement: variable.
	(increment == nil or: [receiver statements size ~= 1])
		ifTrue: [^ nil].
	test _ receiver statements first.
	"Note: test chould really be checked that <= or >= comparison
	jibes with the sign of the (constant) increment"
	((test isMemberOf: MessageNode)
		and: [(limit _ test toDoLimit: variable) notNil])
		ifFalse: [^ nil].
	toDoBlock _ BlockNode statements: body allButLast returns: false.
	toDoBlock arguments: (Array with: variable).
	^ MessageNode new
		receiver: initStmt value
		selector: (SelectorNode new key: #to:by:do: code: #macro)
		arguments: (Array with: limit with: increment with: toDoBlock)
		precedence: precedence! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  '!
transformAnd: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments _ 
				Array 
					with: (arguments at: 1)
					with: (BlockNode withJust: NodeFalse).
			^true]
		ifFalse: 
			[^false]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  '!
transformBoolean: encoder
	^self
		checkBlock: (arguments at: 1)
		as: 'argument'
		from: encoder! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  acg 1/28/2000 00:48'!
transformIfFalseIfTrue: encoder
	((self checkBlock: (arguments at: 1) as: 'False arg' from: encoder)
		and: [self checkBlock: (arguments at: 2) as: 'True arg' from: encoder])
		ifTrue: 
			[selector _ #ifTrue:ifFalse:.
			arguments swap: 1 with: 2.
			^true]
		ifFalse: 
			[^false]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  '!
transformIfFalse: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments _ 
				Array 
					with: (BlockNode withJust: NodeNil)
					with: (arguments at: 1).
			^true]
		ifFalse:
			[^false]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  acg 1/28/2000 21:49'!
transformIfNilIfNotNil: encoder
	((self checkBlock: (arguments at: 1) as: 'Nil arg' from: encoder)
		and: [self checkBlock: (arguments at: 2) as: 'NotNil arg' from: encoder])
		ifTrue: 
			[selector _ SelectorNode new key: #ifTrue:ifFalse: code: #macro.
			receiver _ MessageNode new
				receiver: receiver
				selector: #==
				arguments: (Array with: NodeNil)
				precedence: 2
				from: encoder.
			^true]
		ifFalse: 
			[^false]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 12/9/2010 23:00'!
transformIfNil: encoder

	(self transformBoolean: encoder) ifFalse: [^ false].
	(MacroSelectors at: special) = #ifNotNil:
	ifTrue:
		[(self checkBlock: arguments first as: 'ifNotNil arg' from: encoder) ifFalse: [^ false].

		"Transform 'ifNotNil: [stuff]' to 'ifNil: [nil] ifNotNil: [stuff]'.
		Slightly better code and more consistent with decompilation."
		self noteSpecialSelector: #ifNil:ifNotNil:.
		selector _ SelectorNode new key: (MacroSelectors at: special) code: #macro.
		arguments _ (Array with: (BlockNode withJust: NodeNil) with: arguments first).
		(self transform: encoder) ifFalse: [self error: 'compiler logic error'].
		^ true]
	ifFalse:
		[^ self checkBlock: arguments first as: 'ifNil arg' from: encoder]
! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  acg 1/28/2000 21:50'!
transformIfNotNilIfNil: encoder
	((self checkBlock: (arguments at: 1) as: 'NotNil arg' from: encoder)
		and: [self checkBlock: (arguments at: 2) as: 'Nil arg' from: encoder])
		ifTrue: 
			[selector _ SelectorNode new key: #ifTrue:ifFalse: code: #macro.
			receiver _ MessageNode new
				receiver: receiver
				selector: #==
				arguments: (Array with: NodeNil)
				precedence: 2
				from: encoder.
			arguments swap: 1 with: 2.
			^true]
		ifFalse: 
			[^false]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  acg 1/27/2000 22:29'!
transformIfTrueIfFalse: encoder
	^(self checkBlock: (arguments at: 1) as: 'True arg' from: encoder)
		and: [self checkBlock: (arguments at: 2) as: 'False arg' from: encoder]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  '!
transformIfTrue: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments _ 
				Array 
					with: (arguments at: 1)
					with: (BlockNode withJust: NodeNil).
			^true]
		ifFalse: 
			[^false]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  '!
transformOr: encoder
	(self transformBoolean: encoder)
		ifTrue: 
			[arguments _ 
				Array 
					with: (BlockNode withJust: NodeTrue)
					with: (arguments at: 1).
			^true]
		ifFalse: 
			[^false]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 12/14/2010 21:49'!
transformToDo: encoder
	" var _ rcvr. L1: [var <= arg1] Bfp(L2) [block body. var _ var + inc] 
Jmp(L1) L2: "
	| limit increment block initStmt test incStmt limitInit blockVar myRange blockRange |
	"First check for valid arguments"
	((arguments last isMemberOf: BlockNode)
			and: [arguments last numberOfArguments = 1])
		ifFalse: [^ false].
	arguments last firstArgument isVariableReference
		ifFalse: [^ false]. "As with debugger remote vars"
	arguments size = 3
		ifTrue: [increment _ arguments at: 2.
				(increment isConstantNumber and:
					[increment literalValue ~= 0]) ifFalse: [^ false]]
		ifFalse: [increment _ encoder encodeLiteral: 1].
	arguments size < 3 ifTrue:   "transform to full form"
		[selector _ SelectorNode new key: #to:by:do: code: #macro].

	"Now generate auxiliary structures"
	myRange _ encoder rawSourceRanges at: self ifAbsent: [1 to: 0].
	block _ arguments last.
	blockRange _ encoder rawSourceRanges at: block ifAbsent: [1 to: 0].
	blockVar _ block firstArgument.
	initStmt _ AssignmentNode new variable: blockVar value: receiver.
	limit _ arguments at: 1.
	limit isVariableReference | limit isConstantNumber
		ifTrue: [limitInit _ nil]
		ifFalse:  "Need to store limit in a var"
			[limit _ encoder autoBind: blockVar key , 'LimiT'.
			limit scope: -2.  "Already done parsing block"
			limitInit _ AssignmentNode new
					variable: limit
					value: (arguments at: 1)].
	test _ MessageNode new receiver: blockVar
			selector: (increment key > 0 ifTrue: [#<=] ifFalse: [#>=])
			arguments: (Array with: limit)
			precedence: precedence from: encoder
			sourceRange: (myRange first to: blockRange first).
	incStmt _ AssignmentNode new
			variable: blockVar
			value: (MessageNode new
				receiver: blockVar selector: #+
				arguments: (Array with: increment)
				precedence: precedence from: encoder)
			from: encoder
			sourceRange: (myRange last to: myRange last).
	arguments _ (Array with: limit with: increment with: block)
		, (Array with: initStmt with: test with: incStmt), (Array with: limitInit).
	^ true! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  '!
transformWhile: encoder
	(self checkBlock: receiver as: 'receiver' from: encoder)
		ifFalse: [^ false].
	arguments size = 0   "transform bodyless form to body form"
		ifTrue: [selector _ SelectorNode new
					key: (special = 10 ifTrue: [#whileTrue:] ifFalse: [#whileFalse:])
					code: #macro.
				arguments _ Array with: (BlockNode withJust: NodeNil).
				^ true]
		ifFalse: [^ self transformBoolean: encoder]! !

!MMessageNode methodsFor: 'macro transformations' stamp: 'yo 11/9/2010 20:30  <  '!
transform: encoder
	special = 0 ifTrue: [^false].
	(self perform: (MacroTransformers at: special) with: encoder)
		ifTrue: 
			[^true]
		ifFalse: 
			[special _ 0. ^false]! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  tao 8/20/97 22:24'!
emitCase: stack on: strm value: forValue

	| braceNode sizeStream thenSize elseSize |
	forValue not
		ifTrue: [^super emitForEffect: stack on: strm].
	braceNode _ arguments first.
	sizeStream _ ReadStream on: sizes.
	receiver emitForValue: stack on: strm.
	braceNode casesForwardDo:
		[:keyNode :valueNode :last |
		thenSize _ sizeStream next.
		elseSize _ sizeStream next.
		last ifFalse: [strm nextPut: Dup. stack push: 1].
		keyNode emitForEvaluatedValue: stack on: strm.
		equalNode emit: stack args: 1 on: strm.
		self emitBranchOn: false dist: thenSize pop: stack on: strm.
		last ifFalse: [strm nextPut: Pop. stack pop: 1].
		valueNode emitForEvaluatedValue: stack on: strm.
		last ifTrue: [stack pop: 1].
		valueNode returns ifFalse: [self emitJump: elseSize on: strm]].
	arguments size = 2
		ifTrue:
			[arguments last emitForEvaluatedValue: stack on: strm] "otherwise: [...]"
		ifFalse:
			[NodeSelf emitForValue: stack on: strm.
			caseErrorNode emit: stack args: 0 on: strm]! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  hmm 7/28/2001 14:39'!
emitForEffect: stack on: strm
	"For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly."
	special > 0
		ifTrue: 
			[pc _ 0.
			self perform: (MacroEmitters at: special) with: stack with: strm with: false]
		ifFalse: 
			[super emitForEffect: stack on: strm]! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  hmm 7/28/2001 14:40'!
emitForValue: stack on: strm
	"For #ifTrue:ifFalse: and #whileTrue: / #whileFalse: style messages, the pc is set to the jump instruction, so that mustBeBoolean exceptions can be shown correctly."
	special > 0
		ifTrue: 
			[pc _ 0.
			self perform: (MacroEmitters at: special) with: stack with: strm with: true]
		ifFalse: 
			[receiver ~~ nil ifTrue: [receiver emitForValue: stack on: strm].
			arguments do: [:argument | argument emitForValue: stack on: strm].
			selector
				emit: stack
				args: arguments size
				on: strm
				super: receiver == NodeSuper.
			pc _ strm position]! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  ajh 7/31/2003 11:26'!
emitIfNil: stack on: strm value: forValue

	| theNode theSize theSelector |
	theNode _ arguments first.
	theSize _ sizes at: 1.
	theSelector _ #ifNotNil:.
	receiver emitForValue: stack on: strm.
	forValue ifTrue: [strm nextPut: Dup. stack push: 1].
	strm nextPut: LdNil. stack push: 1.
	equalNode emit: stack args: 1 on: strm.
	self 
		emitBranchOn: (selector key == theSelector)
		dist: theSize 
		pop: stack 
		on: strm.
	pc _ strm position.
	forValue 
		ifTrue: 
			[strm nextPut: Pop. stack pop: 1.
			theNode emitForEvaluatedValue: stack on: strm]	
		ifFalse: [theNode emitForEvaluatedEffect: stack on: strm].! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  hmm 7/28/2001 14:23'!
emitIf: stack on: strm value: forValue
	| thenExpr thenSize elseExpr elseSize |
	thenSize _ sizes at: 1.
	elseSize _ sizes at: 2.
	(forValue not and: [(elseSize*thenSize) > 0])
		ifTrue:  "Two-armed IFs forEffect share a single pop"
			[^ super emitForEffect: stack on: strm].
	thenExpr _ arguments at: 1.
	elseExpr _ arguments at: 2.
	receiver emitForValue: stack on: strm.
	forValue
		ifTrue:  "Code all forValue as two-armed"
			[self emitBranchOn: false dist: thenSize pop: stack on: strm.
			pc _ strm position.
			thenExpr emitForEvaluatedValue: stack on: strm.
			stack pop: 1.  "then and else alternate; they don't accumulate"
			thenExpr returns not
				ifTrue:  "Elide jump over else after a return"
					[self emitJump: elseSize on: strm].
			elseExpr emitForEvaluatedValue: stack on: strm]
		ifFalse:  "One arm is empty here (two-arms code forValue)"
			[thenSize > 0
				ifTrue:
					[self emitBranchOn: false dist: thenSize pop: stack on: strm.
					pc _ strm position.
					thenExpr emitForEvaluatedEffect: stack on: strm]
				ifFalse:
					[self emitBranchOn: true dist: elseSize pop: stack on: strm.
					pc _ strm position.
					elseExpr emitForEvaluatedEffect: stack on: strm]]! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  hmm 7/28/2001 14:42'!
emitToDo: stack on: strm value: forValue 
	" var _ rcvr. L1: [var <= arg1] Bfp(L2) [block body. var _ var + inc] Jmp(L1) L2: "
	| loopSize initStmt limitInit test block incStmt blockSize |
	initStmt _ arguments at: 4.
	limitInit _ arguments at: 7.
	test _ arguments at: 5.
	block _ arguments at: 3.
	incStmt _ arguments at: 6.
	blockSize _ sizes at: 1.
	loopSize _ sizes at: 2.
	limitInit == nil
		ifFalse: [limitInit emitForEffect: stack on: strm].
	initStmt emitForEffect: stack on: strm.
	test emitForValue: stack on: strm.
	self emitBranchOn: false dist: blockSize pop: stack on: strm.
	pc _ strm position.
	block emitForEvaluatedEffect: stack on: strm.
	incStmt emitForEffect: stack on: strm.
	self emitJump: 0 - loopSize on: strm.
	forValue ifTrue: [strm nextPut: LdNil. stack push: 1]! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  hmm 7/28/2001 14:36'!
emitWhile: stack on: strm value: forValue 
	" L1: ... Bfp(L2)|Btp(L2) ... Jmp(L1) L2: "
	| cond stmt stmtSize loopSize |
	cond _ receiver.
	stmt _ arguments at: 1.
	stmtSize _ sizes at: 1.
	loopSize _ sizes at: 2.
	cond emitForEvaluatedValue: stack on: strm.
	self emitBranchOn: (selector key == #whileFalse:)  "Bfp for whileTrue"
					dist: stmtSize pop: stack on: strm.   "Btp for whileFalse"
	pc _ strm position.
	stmt emitForEvaluatedEffect: stack on: strm.
	self emitJump: 0 - loopSize on: strm.
	forValue ifTrue: [strm nextPut: LdNil. stack push: 1]! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  tao 8/20/97 22:25'!
sizeCase: encoder value: forValue

	| braceNode sizeIndex thenSize elseSize |
	forValue not
		ifTrue: [^super sizeForEffect: encoder].
	equalNode _ encoder encodeSelector: #=.
	braceNode _ arguments first.
	sizes _ Array new: 2 * braceNode numElements.
	sizeIndex _ sizes size.
	elseSize _ arguments size = 2
		ifTrue:
			[arguments last sizeForEvaluatedValue: encoder] "otherwise: [...]"
		ifFalse:
			[caseErrorNode _ encoder encodeSelector: #caseError.
			 1 + (caseErrorNode size: encoder args: 0 super: false)]. "self caseError"
	braceNode casesReverseDo:
		[:keyNode :valueNode :last |
		sizes at: sizeIndex put: elseSize.
		thenSize _ valueNode sizeForEvaluatedValue: encoder.
		last ifFalse: [thenSize _ thenSize + 1]. "Pop"
		valueNode returns ifFalse: [thenSize _ thenSize + (self sizeJump: elseSize)].
		sizes at: sizeIndex-1 put: thenSize.
		last ifFalse: [elseSize _ elseSize + 1]. "Dup"
		elseSize _ elseSize + (keyNode sizeForEvaluatedValue: encoder) +
			(equalNode size: encoder args: 1 super: false) +
			(self sizeBranchOn: false dist: thenSize) + thenSize.
		sizeIndex _ sizeIndex - 2].
	^(receiver sizeForValue: encoder) + elseSize
! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  '!
sizeForEffect: encoder

	special > 0 
		ifTrue: [^self perform: (MacroSizers at: special) with: encoder with: false].
	^super sizeForEffect: encoder! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  '!
sizeForValue: encoder
	| total argSize |
	special > 0 
		ifTrue: [^self perform: (MacroSizers at: special) with: encoder with: true].
	receiver == NodeSuper
		ifTrue: [selector _ selector copy "only necess for splOops"].
	total _ selector size: encoder args: arguments size super: receiver == NodeSuper.
	receiver == nil 
		ifFalse: [total _ total + (receiver sizeForValue: encoder)].
	sizes _ arguments collect: 
					[:arg | 
					argSize _ arg sizeForValue: encoder.
					total _ total + argSize.
					argSize].
	^total! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  acg 1/28/2000 22:00'!
sizeIfNil: encoder value: forValue

	| theNode theSize theSelector |
	equalNode _ encoder encodeSelector: #==.
	sizes _ Array new: 1.
	theNode _ arguments first.
	theSelector _ #ifNotNil:.
	forValue
		ifTrue:
			[sizes at: 1 put: (theSize _ (1 "pop" + (theNode sizeForEvaluatedValue: encoder))).
			 ^(receiver sizeForValue: encoder) +
				2 "Dup. LdNil" +
				(equalNode size: encoder args: 1 super: false) +
				(self 
					sizeBranchOn: (selector key == theSelector) 
					dist: theSize) +
				theSize]
		ifFalse:
			[sizes at: 1 put: (theSize _ (theNode sizeForEvaluatedEffect: encoder)).
			 ^(receiver sizeForValue: encoder) +
				1 "LdNil" +
				(equalNode size: encoder args: 1 super: false) +
				(self 
					sizeBranchOn: (selector key == theSelector) 
					dist: theSize) +
				theSize]

! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  '!
sizeIf: encoder value: forValue
	| thenExpr elseExpr branchSize thenSize elseSize |
	thenExpr _ arguments at: 1.
	elseExpr _ arguments at: 2.
	(forValue
		or: [(thenExpr isJust: NodeNil)
		or: [elseExpr isJust: NodeNil]]) not
			"(...not ifTrue: avoids using ifFalse: alone during this compile)"
		ifTrue:  "Two-armed IFs forEffect share a single pop"
			[^ super sizeForEffect: encoder].
	forValue
		ifTrue:  "Code all forValue as two-armed"
			[elseSize _ elseExpr sizeForEvaluatedValue: encoder.
			thenSize _ (thenExpr sizeForEvaluatedValue: encoder)
					+ (thenExpr returns
						ifTrue: [0]  "Elide jump over else after a return"
						ifFalse: [self sizeJump: elseSize]).
			branchSize _ self sizeBranchOn: false dist: thenSize]
		ifFalse:  "One arm is empty here (two-arms code forValue)"
			[(elseExpr isJust: NodeNil)
				ifTrue:
					[elseSize _ 0.
					thenSize _ thenExpr sizeForEvaluatedEffect: encoder.
					branchSize _ self sizeBranchOn: false dist: thenSize]
				ifFalse:
					[thenSize _ 0.
					elseSize _ elseExpr sizeForEvaluatedEffect: encoder.
					branchSize _ self sizeBranchOn: true dist: elseSize]].
	sizes _ Array with: thenSize with: elseSize.
	^ (receiver sizeForValue: encoder) + branchSize
			+ thenSize + elseSize! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  '!
sizeToDo: encoder value: forValue 
	" var _ rcvr. L1: [var <= arg1] Bfp(L2) [block body. var _ var + inc] Jmp(L1) L2: "
	| loopSize initStmt test block incStmt blockSize blockVar initSize limitInit |
	block _ arguments at: 3.
	blockVar _ block firstArgument.
	initStmt _ arguments at: 4.
	test _ arguments at: 5.
	incStmt _ arguments at: 6.
	limitInit _ arguments at: 7.
	initSize _ initStmt sizeForEffect: encoder.
	limitInit == nil
		ifFalse: [initSize _ initSize + (limitInit sizeForEffect: encoder)].
	blockSize _ (block sizeForEvaluatedEffect: encoder)
			+ (incStmt sizeForEffect: encoder) + 2.  "+2 for Jmp backward"
	loopSize _ (test sizeForValue: encoder)
			+ (self sizeBranchOn: false dist: blockSize)
			+ blockSize.
	sizes _ Array with: blockSize with: loopSize.
	^ initSize + loopSize
			+ (forValue ifTrue: [1] ifFalse: [0])    " +1 for value (push nil) "! !

!MMessageNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:30  <  '!
sizeWhile: encoder value: forValue 
	"L1: ... Bfp(L2) ... Jmp(L1) L2: nil (nil for value only);
	justStmt, wholeLoop, justJump."
	| cond stmt stmtSize loopSize branchSize |
	cond _ receiver.
	stmt _ arguments at: 1.
	stmtSize _ (stmt sizeForEvaluatedEffect: encoder) + 2.
	branchSize _ self sizeBranchOn: (selector key == #whileFalse:)  "Btp for whileFalse"
					dist: stmtSize.
	loopSize _ (cond sizeForEvaluatedValue: encoder)
			+ branchSize + stmtSize.
	sizes _ Array with: stmtSize with: loopSize.
	^ loopSize    " +1 for value (push nil) "
		+ (forValue ifTrue: [1] ifFalse: [0])! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:30  <  RAA 2/15/2001 19:25'!
macroPrinter

	special > 0 ifTrue: [^MacroPrinters at: special].
	^nil
! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:30  <  '!
precedence

	^precedence! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/11/2010 01:14'!
printCaseOn: aStream indent: level 
	"receiver caseOf: {[key]->[value]. ...} otherwise: [otherwise]"
	| braceNode otherwise extra |
	braceNode _ arguments first.
	otherwise _ arguments last.
	(arguments size = 1 or: [otherwise isJustCaseError])
		ifTrue: [otherwise _ nil].
	receiver
		printOn: aStream
		indent: level
		precedence: 3.
	aStream nextPutAll: ' caseOf: '.
	braceNode isVariableReference ifTrue: [braceNode printOn: aStream indent: level]
		ifFalse: 
			[aStream nextPutAll: '{';
				 crtab: level + 1.
			braceNode
				casesForwardDo: 
					[:keyNode :valueNode :last | 
					keyNode printOn: aStream indent: level + 1.
					aStream nextPutAll: ' -> '.
					valueNode isComplex
						ifTrue: 
							[aStream crtab: level + 2.
							extra _ 1]
						ifFalse: [extra _ 0].
					valueNode printOn: aStream indent: level + 1 + extra.
					last ifTrue: [aStream nextPut: $}]
						ifFalse: [aStream nextPut: $.;
								 crtab: level + 1]]].
	otherwise isNil
		ifFalse: 
			[false ifTrue: []
				ifFalse: [aStream crtab: level + 1;
						 nextPutAll: ' otherwise: '].
			otherwise isComplex
				ifTrue: 
					[aStream crtab: level + 2.
					extra _ 1]
				ifFalse: [extra _ 0].
			otherwise printOn: aStream indent: level + 1 + extra.
		]! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 12/9/2010 23:02'!
printIfNilNotNil: aStream indent: level

	self printReceiver: receiver ifNilReceiver on: aStream indent: level.

	(arguments first isJust: NodeNil) ifTrue:
		[^ self printKeywords: #ifNotNil:
				arguments: (Array with: arguments second)
				on: aStream indent: level].
	(arguments second isJust: NodeNil) ifTrue:
		[^ self printKeywords: #ifNil:
				arguments: (Array with: arguments first)
				on: aStream indent: level].
	^ self printKeywords: #ifNil:ifNotNil:
			arguments: arguments
			on: aStream indent: level! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:30  <  di 5/1/2000 23:20'!
printIfNil: aStream indent: level

	self printReceiver: receiver on: aStream indent: level.

	^self printKeywords: selector key
		arguments: (Array with: arguments first)
		on: aStream indent: level! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:49'!
printIfOn: aStream indent: level

	false ifTrue:
		[].

	receiver ifNotNil: [
		receiver printOn: aStream indent: level + 1 precedence: precedence.
	].
	(arguments last isJust: NodeNil) ifTrue:
		[^ self printKeywords: #ifTrue: arguments: (Array with: arguments first)
					on: aStream indent: level].
	(arguments last isJust: NodeFalse) ifTrue:
		[^ self printKeywords: #and: arguments: (Array with: arguments first)
					on: aStream indent: level].
	(arguments first isJust: NodeNil) ifTrue:
		[^ self printKeywords: #ifFalse: arguments: (Array with: arguments last)
					on: aStream indent: level].
	(arguments first isJust: NodeTrue) ifTrue:
		[^ self printKeywords: #or: arguments: (Array with: arguments last)
					on: aStream indent: level].
	self printKeywords: #ifTrue:ifFalse: arguments: arguments
					on: aStream indent: level! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:30  <  di 6/11/2000 15:08'!
printKeywords: key arguments: args on: aStream indent: level

	^ self printKeywords: key arguments: args on: aStream indent: level prefix: false
! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 12/9/2010 23:02'!
printKeywords: key arguments: args on: aStream indent: level prefix: isPrefix
	| keywords indent noColons arg kwd hasBrackets doCrTab |
	args size = 0 ifTrue: [aStream space; nextPutAll: key. ^ self].
	keywords _ key keywords.
	noColons _ false and: [keywords first last =  $:].
	doCrTab _ args size > 2 or:
		[(Array with: receiver) , args
			inject: false
			into: [:was :thisArg |
				was or: [(thisArg isKindOf: BlockNode)
					or: [(thisArg isKindOf: MessageNode) and: [thisArg precedence >= 3]]]]].
	1 to: (args size min: keywords size) do:
		[:i | arg _ args at: i.  kwd _ keywords at: i.
		doCrTab
			ifTrue: [aStream crtab: level+1. indent _ 1] "newline after big args"
			ifFalse: [aStream space. indent _ 0].
		noColons
			ifTrue: [aStream nextPutAll: kwd allButLast; space.
					hasBrackets _ (arg isKindOf: BlockNode) or: [arg isKindOf: BlockNode].
					hasBrackets ifFalse: [aStream nextPutAll: '(']]
			ifFalse: [aStream nextPutAll: kwd; space].
		arg printOn: aStream indent: level + 1 + indent
			 	precedence: (precedence = 2 ifTrue: [1] ifFalse: [precedence]).
		noColons
			ifTrue: [hasBrackets ifFalse: [aStream nextPutAll: ')']]]! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:46'!
printOn: aStream indent: level

	| leadingKeyword |

"may not need this check anymore - may be fixed by the #receiver: change"
	special ifNil: [^aStream nextPutAll: '** MessageNode with nil special **'].


	(special > 0)
		ifTrue: [self perform: self macroPrinter with: aStream with: level]
		ifFalse: [selector key first = $:
				ifTrue: [leadingKeyword _ selector key keywords first.
						aStream nextPutAll: leadingKeyword; space.
						self printReceiver: receiver on: aStream indent: level.
						self printKeywords: (selector key allButFirst: leadingKeyword size + 1) arguments: arguments
							on: aStream indent: level]
				ifFalse: [(false)
						ifTrue: []
						ifFalse: [self printReceiver: receiver on: aStream indent: level.
								self printKeywords: selector key arguments: arguments
									on: aStream indent: level]]]! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:30  <  di 5/30/2000 23:17'!
printOn: strm indent: level precedence: outerPrecedence

	| parenthesize |
	parenthesize _ precedence > outerPrecedence
		or: [outerPrecedence = 3 and: [precedence = 3 "both keywords"]].
	parenthesize
		ifTrue: [strm nextPutAll: '('.
				self printOn: strm indent: level.
				strm nextPutAll: ')']
		ifFalse: [self printOn: strm indent: level]! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:30  <  di 6/7/2000 08:28'!
printParenReceiver: rcvr on: aStream indent: level
					
	(rcvr isKindOf: BlockNode) ifTrue:
		[^ rcvr printOn: aStream indent: level].
	aStream nextPutAll: '('.
	rcvr printOn: aStream indent: level.
	aStream nextPutAll: ')'
! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:50'!
printReceiver: rcvr on: aStream indent: level
					
	rcvr ifNil: [^ self].

	"Force parens around keyword receiver of kwd message"
	(precedence = 3 and: [false])
		ifTrue: [rcvr printOn: aStream indent: level precedence: precedence - 1]
		ifFalse: [rcvr printOn: aStream indent: level precedence: precedence]
! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/11/2010 16:38'!
printToDoOn: aStream indent: level

	| limitNode |
	false
		ifTrue: []
		ifFalse: [self printReceiver: receiver on: aStream indent: level].

	(arguments last == nil or: [(arguments last isMemberOf: AssignmentNode) not])
		ifTrue: [limitNode _ arguments first]
		ifFalse: [limitNode _ arguments last value].
	(selector key = #to:by:do:
			and: [(arguments at: 2) isConstantNumber
				and: [(arguments at: 2) key = 1]])
		ifTrue: [self printKeywords: #to:do:
					arguments: (Array with: limitNode with: (arguments at: 3))
					on: aStream indent: level prefix: true]
		ifFalse: [self printKeywords: selector key
					arguments: (Array with: limitNode) , (arguments allButFirst: 1)
					on: aStream indent: level prefix: true]! !

!MMessageNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:50'!
printWhileOn: aStream indent: level

	false
		ifTrue: []
		ifFalse: [self printReceiver: receiver on: aStream indent: level.
				(arguments isEmpty not and: [ arguments first isJust: NodeNil]) ifTrue:
						[selector _ SelectorNode new
								key: (selector key == #whileTrue:
									ifTrue: [#whileTrue] ifFalse: [#whileFalse])
								code: #macro.
						arguments _ Array new].
				self printKeywords: selector key arguments: arguments
					on: aStream indent: level]! !

!MMessageNode methodsFor: 'private' stamp: 'yo 11/9/2010 20:30  <  hg 10/2/2001 21:08'!
checkBlock: node as: nodeName from: encoder

	node canBeSpecialArgument ifTrue: [^node isMemberOf: BlockNode].
	((node isKindOf: BlockNode) and: [node numberOfArguments > 0])
		ifTrue:	[^encoder notify: '<- ', nodeName , ' of ' ,
					(MacroSelectors at: special) , ' must be a 0-argument block']
		ifFalse: [^encoder notify: '<- ', nodeName , ' of ' ,
					(MacroSelectors at: special) , ' must be a block or variable']! !

!MMessageNode methodsFor: 'private' stamp: 'yo 11/9/2010 20:30  <  acg 1/28/2000 00:57'!
ifNilReceiver

	^receiver! !

!MMessageNode methodsFor: 'private' stamp: 'yo 11/9/2010 20:30  <  tk 8/2/1999 18:40'!
pvtCheckForPvtSelector: encoder
	"If the code being compiled is trying to send a private message (e.g. 'pvtCheckForPvtSelector:') to anyone other than self, then complain to encoder."

	selector isPvtSelector ifTrue:
		[receiver isSelfPseudoVariable ifFalse:
			[encoder notify: 'Private messages may only be sent to self']].! !

!MMessageNode methodsFor: 'private' stamp: 'yo 11/9/2010 20:30  <  '!
receiver: rcvr arguments: args precedence: p

	receiver _ rcvr.
	arguments _ args.
	sizes _ Array new: arguments size.
	precedence _ p! !

!MMessageNode methodsFor: 'private' stamp: 'yo 11/9/2010 20:30  <  '!
transformCase: encoder

	| caseNode |
	caseNode _ arguments first.
	(caseNode isKindOf: BraceNode)
		ifTrue:
			[^(caseNode blockAssociationCheck: encoder) and:
			 	[arguments size = 1 or:
					[self checkBlock: arguments last as: 'otherwise arg' from: encoder]]].
	(caseNode canBeSpecialArgument and: [(caseNode isMemberOf: BlockNode) not])
		ifTrue:
			[^false]. "caseOf: variable"
	^encoder notify: 'caseOf: argument must be a brace construct or a variable'! !

!MMessageNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 20:30  <  '!
arguments
	^arguments! !

!MMessageNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 20:30  <  tk 10/27/2000 15:11'!
arguments: list
	arguments _ list! !

!MMessageNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 20:30  <  '!
receiver
	^receiver! !

!MMessageNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 20:30  <  RAA 2/14/2001 14:07'!
receiver: val
	"14 feb 2001 - removed return arrow"

	receiver _ val! !

!MMessageNode methodsFor: 'equation translation' stamp: 'yo 11/9/2010 20:30  <  '!
selector
	^selector! !


!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:38'!
asStorableNode: encoder
	"This node is a message masquerading as a temporary variable.
	It currently has the form {homeContext tempAt: offset}.
	We need to generate code for {expr storeAt: offset inTempFrame: homeContext},
	where the expr, the block argument, is already on the stack.
	This, in turn will get turned into {homeContext tempAt: offset put: expr}
	at runtime if nobody disturbs storeAt:inTempFrame: in Object (not clean)"
	^ MessageAsTempNode new
		receiver: nil  "suppress code generation for reciever already on stack"
		selector: #storeAt:inTempFrame:
		arguments: (arguments copyWith: receiver)
		precedence: precedence
		from: encoder! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 10/12/1999 17:29'!
code
	"Allow synthetic temp nodes to be sorted by code"
	^ arguments first literalValue! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:39'!
emitStorePop: stack on: codeStream
	"This node has the form {expr storeAt: offset inTempFrame: homeContext},
	where the expr, the block argument, is already on the stack."
	^ self emitForEffect: stack on: codeStream! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:35'!
isTemp
	"Masquerading for debugger access to temps."
	^ true! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:39'!
nowHasDef
	"For compatibility with temp scope protocol"
! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:39'!
nowHasRef
	"For compatibility with temp scope protocol"
! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:39'!
scope
	"For compatibility with temp scope protocol"
	^ -1! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:39'!
scope: ignored
	"For compatibility with temp scope protocol"
! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:39'!
sizeForStorePop: encoder
	"This node has the form {expr storeAt: offset inTempFrame: homeContext},
	where the expr, the block argument, is already on the stack."
	^ self sizeForEffect: encoder! !

!MMessageAsTempNode methodsFor: 'access to remote temps' stamp: 'yo 11/9/2010 20:31  <  di 3/22/1999 09:40'!
store: expr from: encoder 
	"ctxt tempAt: n -> ctxt tempAt: n put: expr (see Assignment).
	For assigning into temps of a context being debugged."

	selector key ~= #tempAt: 
		ifTrue: [^self error: 'cant transform this message'].
	^ MessageAsTempNode new
		receiver: receiver
		selector: #tempAt:put:
		arguments: (arguments copyWith: expr)
		precedence: precedence
		from: encoder! !


!MMethodNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:33  <  tk 8/3/1999 12:47'!
block
	^ block! !

!MMethodNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:33  <  ajh 1/24/2003 17:37'!
selector: symbol

	selectorOrFalse _ symbol! !

!MMethodNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:33  <  '!
selector: selOrFalse arguments: args precedence: p temporaries: temps block: blk encoder: anEncoder primitive: prim 
	"Initialize the receiver with respect to the arguments given."

	encoder _ anEncoder.
	selectorOrFalse _ selOrFalse.
	precedence _ p.
	arguments _ args.
	temporaries _ temps.
	block _ blk.
	primitive _ prim! !

!MMethodNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:33  <  ar 1/4/2002 00:23'!
selector: selOrFalse arguments: args precedence: p temporaries: temps block: blk encoder: anEncoder primitive: prim properties: propDict
	"Initialize the receiver with respect to the arguments given."

	encoder := anEncoder.
	selectorOrFalse := selOrFalse.
	precedence := p.
	arguments := args.
	temporaries := temps.
	block := blk.
	primitive := prim.
	properties := propDict.! !

!MMethodNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:33  <  ajh 1/22/2003 17:53'!
sourceText: stringOrText

	sourceText _ stringOrText! !

!MMethodNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:33  <  '!
encoder
	^ encoder! !

!MMethodNode methodsFor: 'code generation' stamp: 'yo 12/9/2010 11:01'!
generate: trailer 
	"The receiver is the root of a parse tree. Answer a CompiledMethod. The
	argument, trailer, is the references to the source code that is stored with 
	every CompiledMethod."

	| literals blkSize method nArgs nLits primErrNode stack strm |
	self generate: trailer ifQuick: 
		[:m |
		literals := encoder allLiterals.
		(nLits := literals size) > 255 ifTrue:
			[^self error: 'Too many literals referenced'].
		1 to: nLits do: [:lit | m literalAt: lit put: (literals at: lit)].
		properties ifNotNil: [m properties: properties].
		^m].
	primErrNode := nil. "self primitiveErrorVariableName ifNotNil:
						[encoder fixTemp: self primitiveErrorVariableName]."
	nArgs := arguments size.
	blkSize := (block sizeForEvaluatedValue: encoder)
				+ (primErrNode ifNil: [0] ifNotNil: [2 "We force store-long (129)"]).
	(nLits := (literals := encoder allLiterals) size) > 255 ifTrue:
		[^self error: 'Too many literals referenced'].
	method := CompiledMethod	"Dummy to allocate right size"
				newBytes: blkSize
				trailerBytes: trailer 
				nArgs: nArgs
				nTemps: encoder maxTemp
				nStack: 0
				nLits: nLits
				primitive: primitive.
	strm := WriteStream on: method.
	"strm nextPutAll: method."

	"ReadWriteStream with: method."
	"strm position: method initialPC - 1."
	strm basicPosition: method initialPC - 1.
	stack := ParseStack new init.
	"primErrNode ifNotNil: [primErrNode emitStore: stack on: strm]."
	block emitForEvaluatedValue: stack on: strm.
	stack position ~= 1 ifTrue:
		[^self error: 'Compiler stack discrepancy'].
	strm position ~= (method size - trailer size) ifTrue:
		[^self error: 'Compiler code size discrepancy'].
	method needsFrameSize: stack size.
	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
	properties ifNotNil: [method properties: properties].
	^ method! !

!MMethodNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 21:42'!
generate: trailer ifQuick: methodBlock
	| v |
	(primitive = 0 and: [arguments size = 0 and: [block isQuick]])
		ifFalse: [^ self].
	v _ block code.
	v < 0
		ifTrue: [^ self].
	v = LdSelf
		ifTrue: [^ methodBlock value: (CompiledMethod toReturnSelfTrailerBytes: trailer)].
	(v between: LdTrue and: LdMinus1 + 3)
		ifTrue: [^ methodBlock value: (CompiledMethod toReturnConstant: v - LdSelf trailerBytes: trailer)].
	v < ((CodeBases at: LdInstType) + (CodeLimits at: LdInstType))
		ifTrue: [^ methodBlock value: (CompiledMethod toReturnField: v trailerBytes: trailer)].
	v // 256 = 1
		ifTrue: [^ methodBlock value: (CompiledMethod toReturnField: v \\ 256 trailerBytes: trailer)]! !

!MMethodNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:33  <  ajh 7/6/2003 15:25'!
parserClass
	"Which parser produces this class of parse node"

	^ Parser! !

!MMethodNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:33  <  eem 11/29/2008 18:53'!
properties
	^properties! !

!MMethodNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:33  <  yo 8/30/2002 14:07'!
selector 
	"Answer the message selector for the method represented by the receiver."

	(selectorOrFalse isSymbol)
		ifTrue: [^selectorOrFalse].
	^selectorOrFalse key.
! !

!MMethodNode methodsFor: 'converting' stamp: 'yo 11/9/2010 21:54'!
decompileString 
	"Answer a string description of the parse tree whose root is the receiver."

	^ ''
"
	^ (DialectStream dialect: #ST80 contents: [:strm | self printOn: strm])
		asString
"! !

!MMethodNode methodsFor: 'converting' stamp: 'yo 11/9/2010 21:54'!
decompileText 
	"Answer a string description of the parse tree whose root is the receiver."

	^ ''.
"
	^ DialectStream
		dialect: (Preferences printAlternateSyntax ifTrue: [#SQ00] ifFalse: [#ST80])
		contents: [:strm | self printOn: strm]"! !

!MMethodNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:33  <  ajh 1/22/2003 17:39'!
methodClass

	^ encoder classEncoding! !

!MMethodNode methodsFor: 'printing' stamp: 'yo 11/11/2010 16:39'!
printOn: aStream 

	precedence = 1
		ifTrue: 
			[aStream nextPutAll: self selector]
		ifFalse: 
			[self selector keywords with: arguments do: 
				[:kwd :arg | 
				false
					ifTrue: []
					ifFalse: [aStream nextPutAll: kwd; space].
				aStream nextPutAll: arg key.
				(false and: [kwd last =  $:])
					ifTrue: [aStream nextPutAll: ') ']
					ifFalse: [aStream space]]].
	comment == nil ifFalse: 
			[aStream crtab: 1.
			self printCommentOn: aStream indent: 1].
	temporaries size > 0 ifTrue: 
			[aStream crtab: 1.
			false
				ifTrue: []
				ifFalse: [aStream nextPutAll: '|'].
			temporaries do: 
						[:temp | aStream space; nextPutAll: temp key].
			false
				ifTrue: []
				ifFalse: [aStream nextPutAll: ' |']].
	primitive > 0 ifTrue:
		[(primitive between: 255 and: 519) ifFalse:  " Dont decompile <prim> for, eg, ^ self "
			[aStream crtab: 1.
			self printPrimitiveOn: aStream]].
	self printPropertiesOn: aStream.
	self printPragmasOn: aStream.
	aStream crtab: 1.
	^ block printStatementsOn: aStream indent: 0! !

!MMethodNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:33  <  eem 12/1/2008 14:35'!
printPragmasOn: aStream
	properties ifNil: [^self].
	properties pragmas do:
		[:pragma|
		"Primitives are printed in printPrimitiveOn:; skip these"
		(Parser primitivePragmaSelectors includes: pragma keyword) ifFalse:
			[aStream crtab: 1.
			 pragma printOn: aStream]]! !

!MMethodNode methodsFor: 'printing' stamp: 'yo 11/9/2010 21:57'!
printPrimitiveOn: aStream
	"Print the primitive on aStream"
	| primDecl |
	primitive = 0 ifTrue:
		[^self].
	primitive = 120 ifTrue: "External call spec"
		[^aStream print: encoder literals first].
	aStream nextPutAll: '<primitive: '.
	primitive = 117
		ifTrue:
			[primDecl := encoder literals at: 1.
			 (primDecl at: 2) asString printOn: aStream.
			 (primDecl at: 1) ifNotNilDo:
				[:moduleName|
				aStream nextPutAll:' module: '.
				moduleName asString printOn: aStream]]
		ifFalse:
			[aStream print: primitive].
	self primitiveErrorVariableName ifNotNilDo:
		[:primitiveErrorVariableName|
		 aStream nextPutAll: ' error: '; nextPutAll: primitiveErrorVariableName].
	aStream nextPut: $>.
! !

!MMethodNode methodsFor: 'printing' stamp: 'yo 11/11/2010 16:19'!
printPropertiesOn: aStream
	properties ifNil: [^self].
	properties propertyKeysAndValuesDo:
		[:prop :val|
		aStream crtab: 1; nextPut: $<.
		prop = #on:in:
			ifTrue:
				[prop keywords with: val do:
					[:k :v | aStream nextPutAll: k; space; nextPutAll: v; space]]
			ifFalse:
				[prop = #on
					ifTrue: [aStream nextPutAll: prop; nextPutAll:': '; nextPutAll: val] 
					ifFalse: [aStream nextPutAll: prop; nextPutAll:': '; print: val]]. 
		aStream nextPut: $>]! !

!MMethodNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:33  <  ajh 1/24/2003 17:41'!
sourceText

	^ sourceText ifNil: [self printString]! !

!MMethodNode methodsFor: 'printing' stamp: 'yo 11/9/2010 20:33  <  '!
tempNames
	^ encoder tempNames! !

!MMethodNode methodsFor: 'accessing' stamp: 'yo 11/10/2010 21:18'!
primitiveErrorVariableName
	"Answer the primitive error code temp name, or nil if none."
	(primitive isInteger and: [primitive > 0]) ifTrue:
		[properties pragmas do:
			[:pragma| | kwds ecIndex |
			((kwds := pragma keyword keywords) first = 'primitive:'
			and: [(ecIndex := kwds indexOf: 'error:') > 0]) ifTrue:
				[^pragma argumentAt: ecIndex]]].
	^nil

	"(Parser new parse: (MethodNode sourceCodeAt: #primitiveErrorVariableName) class: Parser) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111 error: ''foo''> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111 error: foo> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: ''foo'' error: foo module: ''bar''> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: ''foo'' module: ''bar'' error: foo> self primitiveFailed' class: Object) primitiveErrorVariableName"

	"(Parser new parse: 'foo <primitive: 111 error: foo> self primitiveFailed' class: Object) generate"! !


!MParseNode class methodsFor: 'class initialization' stamp: 'yo 11/9/2010 19:23  <  ajh 8/12/2002 11:10'!
blockReturnCode

	^ EndRemote! !

!MParseNode class methodsFor: 'class initialization' stamp: 'yo 12/16/2010 01:43'!
initialize
	"ParseNode initialize"
	LdInstType _ 1.
	LdTempType _ 2.
	LdLitType _ 3.
	LdLitIndType _ 4.
	SendType _ 5.
	CodeBases _ #(0 16 32 64 208 ).
	CodeLimits _ #(16 16 32 32 16 ).
	LdSelf _ 112.
	LdTrue _ 113.
	LdFalse _ 114.
	LdNil _ 115.
	LdMinus1 _ 116.
	LoadLong _ 128.
	Store _ 129.
	StorePop _ 130.
	self initialize2.
	self initialize3.
	VariableNode initialize1.! !

!MParseNode class methodsFor: 'class initialization' stamp: 'yo 12/16/2010 01:42'!
initialize2

	ShortStoP _ 96.
	SendLong _ 131.
	DblExtDoAll _ 132.
	SendLong2 _ 134.
	LdSuper _ 133.
	Pop _ 135.
	Dup _ 136.
	LdThisContext _ 137.
	EndMethod _ 124.
	EndRemote _ 125.
	Jmp _ 144.
	Bfp _ 152.
! !

!MParseNode class methodsFor: 'class initialization' stamp: 'yo 12/16/2010 01:42'!
initialize3

	JmpLimit _ 8.
	JmpLong _ 164.  "code for jmp 0"
	BtpLong _ 168.
	SendPlus _ 176.
	Send _ 208.
	SendLimit _ 16! !

!MParseNode class methodsFor: 'class initialization' stamp: 'yo 11/9/2010 19:23  <  ajh 8/6/2002 12:04'!
popCode

	^ Pop! !


!MBlockNode class methodsFor: 'instance creation' stamp: 'yo 11/9/2010 19:58  <  sma 3/3/2000 13:34'!
statements: statements returns: returns
	^ self new statements: statements returns: returns! !

!MBlockNode class methodsFor: 'instance creation' stamp: 'yo 11/9/2010 19:58  <  yo 5/17/2004 23:03'!
withJust: aNode
	^ self statements: (OrderedCollection with: aNode) returns: false! !


!MMessageNode class methodsFor: 'class initialization' stamp: 'yo 11/9/2010 20:55  <  acg 1/28/2000 21:58'!
initialize		"MessageNode initialize"
	MacroSelectors _ 
		#(ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
			and: or:
			whileFalse: whileTrue: whileFalse whileTrue
			to:do: to:by:do:
			caseOf: caseOf:otherwise:
			ifNil: ifNotNil:  ifNil:ifNotNil: ifNotNil:ifNil:).
	MacroTransformers _ 
		#(transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformIfFalseIfTrue:
			transformAnd: transformOr:
			transformWhile: transformWhile: transformWhile: transformWhile:
			transformToDo: transformToDo:
			transformCase: transformCase:
			transformIfNil: transformIfNil:  transformIfNilIfNotNil: transformIfNotNilIfNil:).
	MacroEmitters _ 
		#(emitIf:on:value: emitIf:on:value: emitIf:on:value: emitIf:on:value:
			emitIf:on:value: emitIf:on:value:
			emitWhile:on:value: emitWhile:on:value: emitWhile:on:value: emitWhile:on:value:
			emitToDo:on:value: emitToDo:on:value:
			emitCase:on:value: emitCase:on:value:
			emitIfNil:on:value: emitIfNil:on:value: emitIf:on:value: emitIf:on:value:).
	MacroSizers _ 
		#(sizeIf:value: sizeIf:value: sizeIf:value: sizeIf:value:
			sizeIf:value: sizeIf:value:
			sizeWhile:value: sizeWhile:value: sizeWhile:value: sizeWhile:value:
			sizeToDo:value: sizeToDo:value:
			sizeCase:value: sizeCase:value:
			sizeIfNil:value: sizeIfNil:value: sizeIf:value: sizeIf:value: ).
	MacroPrinters _ 
		#(printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent:
			printIfOn:indent: printIfOn:indent:
			printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent:
			printToDoOn:indent: printToDoOn:indent:
			printCaseOn:indent: printCaseOn:indent:
			printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent:)! !


!MParseStack methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 21:11  <  '!
init

	length _ position _ 0! !

!MParseStack methodsFor: 'accessing' stamp: 'yo 11/9/2010 21:11  <  '!
pop: n

	(position _ position - n) < 0 
		ifTrue: [self error: 'Parse stack underflow']! !

!MParseStack methodsFor: 'accessing' stamp: 'yo 11/9/2010 21:11  <  '!
push: n

	(position _ position + n) > length 
		ifTrue: [length _ position]! !

!MParseStack methodsFor: 'accessing' stamp: 'yo 11/9/2010 21:11  <  '!
size

	^length! !

!MParseStack methodsFor: 'results' stamp: 'yo 11/9/2010 21:11  <  '!
position

	^position! !

!MParseStack methodsFor: 'printing' stamp: 'yo 11/9/2010 21:11  <  '!
printOn: aStream
	
	super printOn: aStream.
	aStream nextPutAll: ' at '; print: position; nextPutAll: ' of '; print: length! !


!MReturnNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:34  <  '!
expr: e

	expr _ e! !

!MReturnNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:34  <  '!
expr: e encoder: encoder sourceRange: range

	expr _ e.
	encoder noteSourceRange: range forNode: self! !

!MReturnNode methodsFor: 'converting' stamp: 'yo 11/9/2010 20:34  <  '!
asReturnNode! !

!MReturnNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:35  <  '!
isReturnSelf

	^expr == NodeSelf! !

!MReturnNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:35  <  '!
isSpecialConstant

	^expr isSpecialConstant! !

!MReturnNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:35  <  '!
isVariableReference

	^expr isVariableReference! !

!MReturnNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:35  <  '!
code

	^expr code! !

!MReturnNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:35  <  '!
emitForReturn: stack on: strm

	expr emitForReturn: stack on: strm.
	pc _ strm position! !

!MReturnNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:35  <  '!
emitForValue: stack on: strm

	expr emitForReturn: stack on: strm.
	pc _ strm position! !

!MReturnNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:35  <  '!
sizeForReturn: encoder

	^expr sizeForReturn: encoder! !

!MReturnNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:35  <  '!
sizeForValue: encoder

	^expr sizeForReturn: encoder! !

!MReturnNode methodsFor: 'printing' stamp: 'yo 11/10/2010 14:51'!
printOn: aStream indent: level

	false
		ifTrue: []
		ifFalse: [aStream nextPutAll: '^ '.
				expr printOn: aStream indent: level].
	expr printCommentOn: aStream indent: level.
! !


!MScanner methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:58  <  '!
initScanner

	buffer _ WriteStream on: (String new: 40).
	typeTable _ TypeTable! !

!MScanner methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:58  <  '!
scan: inputStream 
	"Bind the input stream, fill the character buffers and first token buffer."

	source _ inputStream.
	self step.
	self step.
	self scanToken! !

!MScanner methodsFor: 'public access' stamp: 'yo 11/9/2010 20:58  <  '!
scanFieldNames: stringOrArray
	"Answer an Array of Strings that are the identifiers in the input string, 
	stringOrArray. If passed an Array, just answer with that Array, i.e., 
	assume it has already been scanned."

	| strm |
	(stringOrArray isMemberOf: Array)
		ifTrue: [^stringOrArray].
	self scan: (ReadStream on: stringOrArray asString).
	strm _ WriteStream on: (Array new: 10).
	[tokenType = #doIt]
		whileFalse: 
			[tokenType = #word ifTrue: [strm nextPut: token].
			self scanToken].
	^strm contents

	"Scanner new scanFieldNames: 'abc  def ghi' ('abc' 'def' 'ghi' )"! !

!MScanner methodsFor: 'public access' stamp: 'yo 11/9/2010 20:58  <  sw 1/28/2001 23:31'!
scanMessageParts: sourceString
	"Return an array of the form (comment keyword comment arg comment keyword comment arg comment) for the message pattern of this method.  Courtesy of Ted Kaehler, June 1999"

	| coll nonKeywords |
	coll _ OrderedCollection new.
	self scan: (ReadStream on: sourceString asString).
	nonKeywords _ 0.
	[tokenType = #doIt] whileFalse:
		[(currentComment == nil or: [currentComment isEmpty])
			ifTrue: [coll addLast: nil]
			ifFalse: [coll addLast: currentComment removeFirst.
				[currentComment isEmpty] whileFalse:
					[coll at: coll size put: (coll last, ' ', currentComment removeFirst)]].
		(token numArgs < 1 or: [(token = #|) & (coll size > 1)])
			ifTrue: [(nonKeywords _ nonKeywords + 1) > 1 ifTrue: [^ coll]]
						"done with header"
			ifFalse: [nonKeywords _ 0].
		coll addLast: token.
		self scanToken].
	(currentComment == nil or: [currentComment isEmpty])
		ifTrue: [coll addLast: nil]
		ifFalse: [coll addLast: currentComment removeFirst.
			[currentComment isEmpty] whileFalse: [
				coll at: coll size put: (coll last, ' ', currentComment removeFirst)]].
	^ coll! !

!MScanner methodsFor: 'public access' stamp: 'yo 11/9/2010 20:58  <  '!
scanStringStruct: textOrString 
	"The input is a string whose elements are identifiers and parenthesized
	 groups of identifiers.  Answer an array reflecting that structure, representing
	 each identifier by an uninterned string."

	self scan: (ReadStream on: textOrString asString).
	self scanStringStruct.
	^token

	"Scanner new scanStringStruct: 'a b (c d) (e f g)'"! !

!MScanner methodsFor: 'public access' stamp: 'yo 11/9/2010 20:58  <  '!
scanTokens: textOrString 
	"Answer an Array that has been tokenized as though the input text, 
	textOrString, had appeared between the array delimitors #( and ) in a 
	Smalltalk literal expression."

	self scan: (ReadStream on: textOrString asString).
	self scanLitVec.
	^token

	"Scanner new scanTokens: 'identifier keyword: 8r31 ''string'' .'"! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/9/2010 20:58  <  '!
advance

	| prevToken |
	prevToken _ token.
	self scanToken.
	^prevToken! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/9/2010 20:58  <  '!
nextLiteral
	"Same as advance, but -4 comes back as a number instead of two tokens"

	| prevToken |
	prevToken _ self advance.
	(prevToken == #- and: [token isKindOf: Number])
		ifTrue: 
			[^self advance negated].
	^prevToken! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/9/2010 20:58  <  di 4/23/2000 22:11'!
revertToCheckpoint: checkpoint
	"Revert to the state when checkpoint was made."

	| myCopy |
	myCopy _ checkpoint first.
	1 to: self class instSize do:
		[:i | self instVarAt: i put: (myCopy instVarAt: i)].
	source _ checkpoint second.
	currentComment _ checkpoint third! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/11/2010 16:28'!
scanLitVec

	| s |
	s _ WriteStream on: (Array new: 16).
	[tokenType = #rightParenthesis or: [tokenType = #doIt]]
		whileFalse: 
			[tokenType = #leftParenthesis
				ifTrue: 
					[self scanToken; scanLitVec]
				ifFalse: 
					[tokenType = #word | (tokenType = #keyword) | (tokenType = #colon)
						ifTrue: 
							[self scanLitWord.
							token = #true ifTrue: [token _ true].
							token = #false ifTrue: [token _ false].
							token = #nil ifTrue: [token _ nil]]
						ifFalse:
							[(token == #- 
									and: [((typeTable at: hereChar asciiValue ifAbsent: [#xLetter])) = #xDigit])
								ifTrue: 
									[self scanToken.
									token _ token negated]]].
			s nextPut: token.
			self scanToken].
	token _ s contents! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/9/2010 20:58  <  yo 8/28/2002 17:52'!
scanLitWord
	"Accumulate keywords and asSymbol the result."

	| t |
	[(typeTable at: hereChar asciiValue ifAbsent: [#xLetter]) = #xLetter] whileTrue: [
		t _ token.
		self xLetter.
		token _ t , token
	].
	token _ token asSymbol.
! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/9/2010 20:58  <  '!
scanStringStruct

	| s |
	s _ WriteStream on: (Array new: 16).
	[tokenType = #rightParenthesis or: [tokenType = #doIt]]
		whileFalse: 
			[tokenType = #leftParenthesis
				ifTrue: 
					[self scanToken; scanStringStruct]
				ifFalse: 
					[tokenType = #word ifFalse:
						[^self error: 'only words and parens allowed']].
			s nextPut: token.
			self scanToken].
	token _ s contents! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/9/2010 20:58  <  yo 8/28/2002 22:21'!
scanToken

	[(tokenType _ typeTable at: hereChar asciiValue ifAbsent: [#xLetter]) == #xDelimiter]
		whileTrue: [self step].  "Skip delimiters fast, there almost always is one."
	mark _ source position - 1.
	(tokenType at: 1) = $x "x as first letter"
		ifTrue: [self perform: tokenType "means perform to compute token & type"]
		ifFalse: [token _ self step asSymbol "else just unique the first char"].
	^ token.
! !

!MScanner methodsFor: 'expression types' stamp: 'yo 11/9/2010 20:58  <  '!
step

	| c |
	c _ hereChar.
	hereChar _ aheadChar.
	source atEnd
		ifTrue: [aheadChar _ 30 asCharacter "doit"]
		ifFalse: [aheadChar _ source next].
	^c! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/9/2010 20:58  <  yo 8/28/2002 17:40'!
xBinary

	tokenType _ #binary.
	token _ self step asSymbol.
	[| type | 
	type _ typeTable at: hereChar asciiValue ifAbsent: [#xLetter].
	type == #xBinary and: [hereChar ~= $-]] whileTrue: [
		token _ (token, (String with: self step)) asSymbol].
! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/9/2010 20:58  <  md 11/14/2003 17:14'!
xColon		"Allow := for assignment by converting to #_ "
	aheadChar = $= ifTrue:
		[self step.
		tokenType _ #leftArrow.
		self step.
		^ token _ #'_'].
	"Otherwise, just do what normal scan of colon would do"
	tokenType _ #colon.
	^ token _ self step asSymbol! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/9/2010 20:58  <  '!
xDelimiter
	"Ignore blanks, etc."

	self scanToken! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/9/2010 20:58  <  tao 4/23/98 12:55'!
xDigit
	"Form a number."

	tokenType _ #number.
	(aheadChar = 30 asCharacter and: [source atEnd
			and:  [source skip: -1. source next ~= 30 asCharacter]])
		ifTrue: [source skip: -1 "Read off the end last time"]
		ifFalse: [source skip: -2].
	token _ [Number readFrom: source] ifError: [:err :rcvr | self offEnd: err].
	self step; step! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/9/2010 20:58  <  '!
xDollar
	"Form a Character literal."

	self step. "pass over $"
	token _ self step.
	tokenType _ #number "really should be Char, but rest of compiler doesn't know"! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/9/2010 20:58  <  yo 8/28/2002 17:31'!
xDoubleQuote

    "Collect a comment."
    "wod 1/10/98: Allow 'empty' comments by testing the first character
for $"" rather than blindly adding it to the comment being collected."
    | aStream stopChar |
    stopChar _ 30 asCharacter.
    aStream _ WriteStream on: (String new: 200).
    self step.
    [hereChar = $"]
        whileFalse:
            [(hereChar = stopChar and: [source atEnd])
                ifTrue: [^self offEnd: 'Unmatched comment quote'].
            aStream nextPut: self step.].
    self step.
    currentComment == nil
        ifTrue: [currentComment _ OrderedCollection with: aStream
contents]
        ifFalse: [currentComment add: aStream contents].
    self scanToken.
! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/10/2010 13:56'!
xLetter
	"Form a word or keyword."

	| type c |
	buffer reset.
	[c _ hereChar asciiValue.
	(type _ typeTable at: c ifAbsent: [#xLetter]) == #xLetter or: [type == #xDigit]]
		whileTrue: ["open code step for speed"
			buffer nextPut: hereChar.
			hereChar _ aheadChar.
			source atEnd
				ifTrue: [aheadChar _ 30 asCharacter
					"doit"]
				ifFalse: [aheadChar _ source next]].
	(type == #colon or: [type == #xColon and: [aheadChar ~= $=]])
		ifTrue: [buffer nextPut: self step.
			["Allow any number of embedded colons in literal symbols"
			(typeTable at: hereChar asciiValue ifAbsent: [#xLetter])
				== #xColon]
				whileTrue: [buffer nextPut: self step].
			tokenType _ #keyword]
		ifFalse: [tokenType _ #word].
	token _ buffer contents.
! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/9/2010 20:58  <  ar 4/10/2005 22:46'!
xLitQuote
	"Symbols and vectors: #(1 (4 5) 2 3) #ifTrue:ifFalse: #'abc'."

	| start |
	start _ mark.
	self step. "litQuote"
	self scanToken.
	tokenType = #leftParenthesis
		ifTrue: 
			[self scanToken; scanLitVec.
			mark _ start+1.
			tokenType == #doIt
				ifTrue: [self offEnd: 'Unmatched parenthesis']]
		ifFalse: 
			[(#(word keyword colon ) includes: tokenType) 
				ifTrue:
					[self scanLitWord]
				ifFalse:
					[(tokenType==#literal)
						ifTrue:
							[(token isSymbol)
								ifTrue: "##word"
									[token _ token "May want to move toward ANSI here"]]
						ifFalse:
							[tokenType==#string ifTrue: [token _ token asSymbol]]]].
	mark _ start.
	tokenType _ #literal

"	#(Pen)
	#Pen
	#'Pen'
	##Pen
	###Pen
"! !

!MScanner methodsFor: 'multi-character scans' stamp: 'yo 11/10/2010 15:03'!
xSingleQuote
	"String."

	self step.
	buffer reset.
	[hereChar = $' and: [aheadChar = $' ifTrue: [self step. false] ifFalse: [true]]] whileFalse: [
		buffer nextPut: self step.
		(hereChar = 30 asCharacter and: [source atEnd])
			ifTrue: [^self offEnd: 'Unmatched string quote']].
	self step.
	token _ buffer contents.
	tokenType _ #string.
! !

!MScanner methodsFor: 'error handling' stamp: 'yo 11/9/2010 20:58  <  yo 8/28/2002 17:43'!
errorMultibyteCharacter

	self error: 'multi-byte character is found at unexpected place'.
! !

!MScanner methodsFor: 'error handling' stamp: 'yo 11/9/2010 20:58  <  '!
notify: string 
	"Refer to the comment in Object|notify:." 
	self error: string! !

!MScanner methodsFor: 'error handling' stamp: 'yo 11/9/2010 20:58  <  '!
offEnd: aString 
	"Parser overrides this"

	^self notify: aString! !


!MParser methodsFor: 'public access' stamp: 'yo 11/10/2010 13:38  <  '!
encoder
	^ encoder! !

!MParser methodsFor: 'public access' stamp: 'yo 11/10/2010 20:51'!
parseSelector: aString 
	"Answer the message selector for the argument, aString, which should 
	parse successfully up to the temporary declaration or the end of the 
	method header."

	^self
		initPattern: aString
		return: [:pattern | pattern at: 1]! !

!MParser methodsFor: 'public access' stamp: 'yo 11/10/2010 20:56'!
parse: sourceStream class: class noPattern: noPattern context: ctxt for: anInstance
        "Answer a MethodNode for the argument, sourceStream, that is the root of 
        a parse tree. Parsing is done with respect to the argument, class, to find 
        instance, class, and pool variables; and with respect to the argument, 
        ctxt, to find temporary variables. Errors in parsing are reported to the 
        argument, req, if not nil; otherwise aBlock is evaluated. The argument 
        noPattern is a Boolean that is true if the the sourceStream does not 
        contain a method header (i.e., for DoIts)."

	| methNode myStream parser s p |
	parser _ self.
	myStream _ sourceStream.
	p _ myStream position.
	s _ myStream upToEnd.
	myStream position: p.
	parser init: myStream.
	doitFlag _ noPattern.
	methNode _ [parser method: noPattern context: ctxt
                                encoder: ((Encoder new init: class context: ctxt notifying: parser) namespace: anInstance)] ifError: [self error: 'parser error'].
        encoder _ parseNode _ nil. "break cycles & mitigate refct overflow"
	   methNode sourceText: s.
        ^ methNode! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  '!
argumentName

	hereType == #word
		ifFalse: [^self expected: 'Argument name'].
	^self advance! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  eem 6/2/2009 10:26'!
assignment: varNode
	" var ':=' expression => AssignmentNode."
	| loc start |
	(loc := varNode assignmentCheck: encoder at: prevMark + requestorOffset) >= 0
		ifTrue: [^self notify: 'Cannot store into' at: loc].
	start := self startOfNextToken.
	self advance.
	self expression ifFalse: [^self expected: 'Expression'].
	parseNode := AssignmentNode new
				variable: varNode
				value: parseNode
				from: encoder
				sourceRange: (start to: self endOfLastToken).
	varNode nowHasDef.
	^true! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 15:14'!
blockExpression
	"[ ({:var} |) (| {temps} |) (statements) ] => BlockNode."

	| variableNodes temporaryBlockVariables start |

	variableNodes _ OrderedCollection new.
	start _ prevMark + requestorOffset.
	"Gather parameters."
	[self match: #colon] whileTrue: [variableNodes add: (encoder autoBind: self argumentName)].
	(variableNodes size > 0 & (hereType ~~ #rightBracket) and: [(self match: #verticalBar) not]) ifTrue: [^self expected: 'Vertical bar'].

	temporaryBlockVariables _ self temporaryBlockVariables.
	self statements: variableNodes innerBlock: true.
	parseNode temporaries: temporaryBlockVariables.

	(self match: #rightBracket) ifFalse: [^self expected: 'Period or right bracket'].

	encoder noteSourceRange: (self endOfLastToken to: self endOfLastToken) forNode: parseNode.

	"The scope of the parameters and temporary block variables is no longer active."
	temporaryBlockVariables do: [:variable | variable scope: -1].
	variableNodes do: [:variable | variable scope: -1]! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  di 3/8/2000 09:36'!
braceExpression
	" { elements } => BraceNode."

	| elements locations loc more |
	elements _ OrderedCollection new.
	locations _ OrderedCollection new.
	self advance.
	more _ hereType ~~ #rightBrace.
	[more]
		whileTrue: 
			[loc _ hereMark + requestorOffset.
			self expression
				ifTrue: 
					[elements addLast: parseNode.
					locations addLast: loc]
				ifFalse:
					[^self expected: 'Variable or expression'].
			(self match: #period)
				ifTrue: [more _ hereType ~~ #rightBrace]
				ifFalse: [more _ false]].
	parseNode _ BraceNode new elements: elements sourceLocations: locations.
	(self match: #rightBrace)
		ifFalse: [^self expected: 'Period or right brace'].
	^true! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  '!
cascade
	" {; message} => CascadeNode."

	| rcvr msgs |
	parseNode canCascade
		ifFalse: [^self expected: 'Cascading not'].
	rcvr _ parseNode cascadeReceiver.
	msgs _ OrderedCollection with: parseNode.
	[self match: #semicolon]
		whileTrue: 
			[parseNode _ rcvr.
			(self messagePart: 3 repeat: false)
				ifFalse: [^self expected: 'Cascade'].
			parseNode canCascade
				ifFalse: [^self expected: '<- No special messages'].
			parseNode cascadeReceiver.
			msgs addLast: parseNode].
	parseNode _ CascadeNode new receiver: rcvr messages: msgs! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  di 11/19/1999 07:43'!
expression

	(hereType == #word and: [tokenType == #leftArrow])
		ifTrue: [^ self assignment: self variable].
	hereType == #leftBrace
		ifTrue: [self braceExpression]
		ifFalse: [self primaryExpression ifFalse: [^ false]].
	(self messagePart: 3 repeat: true)
		ifTrue: [hereType == #semicolon ifTrue: [self cascade]].
	^ true! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  di 4/5/2000 08:27'!
keylessMessagePartTest: level repeat: repeat
! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 20:41'!
messagePart: level repeat: repeat

	| start receiver selector args precedence words keywordStart |
	[receiver _ parseNode.
	(hereType == #keyword and: [level >= 3])
		ifTrue: 
			[start _ self startOfNextToken.
			selector _ WriteStream on: (String new: 32).
			args _ OrderedCollection new.
			words _ OrderedCollection new.
			[hereType == #keyword]
				whileTrue: 
					[keywordStart _ self startOfNextToken + requestorOffset.
					selector nextPutAll: self advance.
					words add: (keywordStart to: self endOfLastToken + requestorOffset).
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 2 repeat: true.
					args add: parseNode].
			(Symbol hasInterned: selector contents ifTrue: [ :sym | selector _ sym])
				ifFalse: [ selector _ selector contents asSymbol].
			precedence _ 3]
		ifFalse: [((hereType == #binary or: [hereType == #verticalBar])
				and: [level >= 2])
				ifTrue: 
					[start _ self startOfNextToken.
					selector _ self advance asOctetString asSymbol.
					self primaryExpression ifFalse: [^self expected: 'Argument'].
					self messagePart: 1 repeat: true.
					args _ Array with: parseNode.
					precedence _ 2]
				ifFalse: [hereType == #word
						ifTrue: 
							[start _ self startOfNextToken.
							selector _ self advance.
							args _ #().
							words _ OrderedCollection with: (start  + requestorOffset to: self endOfLastToken + requestorOffset).
							(Symbol hasInterned: selector ifTrue: [ :sym | selector _ sym])
								ifFalse: [ selector _ selector asSymbol].
							precedence _ 1]
						ifFalse: [^args notNil]]].
	parseNode _ MessageNode new
				receiver: receiver
				selector: selector
				arguments: args
				precedence: precedence
				from: encoder
				sourceRange: (start to: self endOfLastToken).
	repeat]
		whileTrue: [].
	^true! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 20:38'!
method: doit context: ctxt encoder: encoderToUse
	" pattern [ | temporaries ] block => MethodNode."

	| sap blk prim temps messageComment methodNode |
	properties := AdditionalMethodState new.
	encoder := encoderToUse.
	sap := self pattern: doit inContext: ctxt.
	"sap={selector, arguments, precedence}"
	properties selector: (sap at: 1).
	(sap at: 2) do: [:argNode | argNode isArg: true].
	doit ifFalse: [self pragmaSequence].
	temps := self temporaries.
	messageComment := currentComment.
	currentComment := nil.
	doit ifFalse: [self pragmaSequence].
	prim := self pragmaPrimitives.
	self statements: #() innerBlock: doit.
	blk := parseNode.
	doit ifTrue: [blk returnLast]
		ifFalse: [blk returnSelfIfNoOther].
	hereType == #doIt ifFalse: [^self expected: 'Nothing more'].
	methodNode := self newMethodNode comment: messageComment.
	^methodNode
		selector: (sap at: 1)
		arguments: (sap at: 2)
		precedence: (sap at: 3)
		temporaries: temps
		block: blk
		encoder: encoder
		primitive: prim
		properties: properties! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  di 5/30/2000 21:59'!
newMethodNode

	^ MethodNode new! !

!MParser methodsFor: 'expression types' stamp: 'yo 12/9/2010 22:16'!
pattern: fromDoit inContext: ctxt 
	" unarySelector | binarySelector arg | keyword arg {keyword arg} =>  
	{selector, arguments, precedence}."
	| args selector |
	doitFlag _ fromDoit.
	fromDoit ifTrue:
			[ctxt == nil
				ifTrue: [^ Array with: #DoIt with: #() with: 1]
				ifFalse: [^ Array with: #DoItIn: with: (Array with: (encoder encodeVariable: 'homeContext')) with: 3]].

	hereType == #word ifTrue: [^ Array with: self advance asSymbol with: #() with: 1].

	(hereType == #binary or: [hereType == #verticalBar])
		ifTrue: 
			[selector _ self advance asSymbol.
			args _ Array with: (encoder bindArg: self argumentName).
			^ Array with: selector with: args with: 2].

	hereType == #keyword
		ifTrue: 
			[selector _ WriteStream on: (String new: 32).
			args _ OrderedCollection new.
			[hereType == #keyword]
				whileTrue: 
					[selector nextPutAll: self advance.
					args addLast: (encoder bindArg: self argumentName)].
			^ Array with: selector contents asSymbol with: args with: 3].

	^ self expected: 'Message pattern'! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 20:38'!
primaryExpression 
	hereType == #word 
		ifTrue: 
			[parseNode _ self variable.
			parseNode nowHasRef.
			^ true].
	hereType == #leftBracket
		ifTrue: 
			[self advance.
			self blockExpression.
			^true].
	hereType == #leftBrace
		ifTrue: 
			[self braceExpression.
			^true].
	hereType == #leftParenthesis
		ifTrue: 
			[self advance.
			self expression ifFalse: [^self expected: 'expression'].
			(self match: #rightParenthesis)
				ifFalse: [^self expected: 'right parenthesis'].
			^true].
	(hereType == #string or: [hereType == #number or: [hereType == #literal]])
		ifTrue: 
			[parseNode _ encoder encodeLiteral: self advance.
			^true].
	(here == #- and: [tokenType == #number])
		ifTrue: 
			[self advance.
			parseNode _ encoder encodeLiteral: self advance negated.
			^true].
	^false! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 15:14'!
statements: argNodes innerBlock: inner

	| stmts returns start more blockComment |
	stmts _ OrderedCollection new.
	"give initial comment to block, since others trail statements"
	blockComment _ currentComment.
	currentComment _ nil.
	returns _ false.
	more _ hereType ~~ #rightBracket.
	[more]
		whileTrue: 
		[start _ self startOfNextToken.
		(returns _ self matchReturn)
			ifTrue: 
				[self expression
					ifFalse: [^self expected: 'Expression to return'].
				self addComment.
				stmts addLast: (parseNode isReturningIf
					ifTrue: [parseNode]
					ifFalse: [ReturnNode new
							expr: parseNode
							encoder: encoder
							sourceRange: (start to: self endOfLastToken)])]
			ifFalse: 
				[self expression
					ifTrue: 
						[self addComment.
						stmts add: parseNode]
					ifFalse: 
						[self addComment.
						stmts size = 0
							ifTrue: 
								[stmts addLast: 
									(encoder encodeVariable:
										(inner ifTrue: ['nil'] ifFalse: ['self']))]]].
		returns 
			ifTrue: 
				[self match: #period.
				(hereType == #rightBracket or: [hereType == #doIt])
					ifFalse: [^self expected: 'End of block']].
		more _ returns not and: [self match: #period]].
	parseNode _ BlockNode new
				arguments: argNodes
				statements: stmts
				returns: returns
				from: encoder.
	parseNode comment: blockComment.
	^ true! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 20:43'!
temporaries
	" [ '|' (variable)* '|' ]"
	| vars theActualText |
	(self match: #verticalBar) ifFalse: 
		["no temps"
		doitFlag ifTrue: [tempsMark _ 1.
			^ #()].
		tempsMark _ (prevEnd ifNil: [0]) + 1.
		tempsMark _ hereMark	"formerly --> prevMark + prevToken".

		tempsMark > 0 ifTrue:
			[theActualText _ source contents.
			[tempsMark < theActualText size and: [(theActualText at: tempsMark) isSeparator]]
				whileTrue: [tempsMark _ tempsMark + 1]].
			^ #()].
	vars _ OrderedCollection new.
	[hereType == #word]
		whileTrue: [vars add: (encoder bindTemp: self advance)].
	(self match: #verticalBar) ifTrue: 
		[tempsMark _ prevMark.
		^ vars].
	^ self expected: 'Vertical bar'! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 13:39  <  crl 2/26/1999 12:22'!
temporaryBlockVariables
	"Scan and answer temporary block variables."

	| variables |

	(self match: #verticalBar) ifFalse: [
		"There are't any temporary variables."
		^#()].

	variables _ OrderedCollection new.
	[hereType == #word] whileTrue: [variables addLast: (encoder bindBlockTemp: self advance)].
	(self match: #verticalBar) ifTrue: [^variables].
	^self expected: 'Vertical bar'! !

!MParser methodsFor: 'expression types' stamp: 'yo 11/10/2010 20:33'!
variable

	| varName varStart varEnd |
	varStart _ self startOfNextToken + requestorOffset.
	varName _ self advance.
	varEnd _ self endOfLastToken + requestorOffset.
	^ encoder encodeVariable: varName
		sourceRange: (varStart to: varEnd)
		ifUnknown: []! !

!MParser methodsFor: 'scanning' stamp: 'yo 11/10/2010 13:39  <  hmm 7/16/2001 20:12'!
advance
	| this |
	prevMark _ hereMark.
	prevEnd _ hereEnd.
	this _ here.
	here _ token.
	hereType _ tokenType.
	hereMark _ mark.
	hereEnd _ source position - (source atEnd ifTrue: [hereChar == 30 asCharacter ifTrue: [0] ifFalse: [1]] ifFalse: [2]).
	self scanToken.
	"Transcript show: 'here: ', here printString, ' mark: ', hereMark printString, ' end: ', hereEnd printString; cr."
	^this! !

!MParser methodsFor: 'scanning' stamp: 'yo 11/10/2010 13:39  <  hmm 7/16/2001 19:23'!
endOfLastToken

	^ prevEnd ifNil: [mark]! !

!MParser methodsFor: 'scanning' stamp: 'yo 11/10/2010 13:39  <  di 6/7/2000 08:44'!
matchReturn

	^ self match: #upArrow! !

!MParser methodsFor: 'scanning' stamp: 'yo 11/10/2010 13:39  <  '!
matchToken: thing 
	"Matches the token, not its type."

	here = thing ifTrue: [self advance. ^true].
	^false! !

!MParser methodsFor: 'scanning' stamp: 'yo 11/10/2010 13:39  <  '!
match: type 
	"Answer with true if next tokens type matches."

	hereType == type
		ifTrue: 
			[self advance.
			^true].
	^false! !

!MParser methodsFor: 'scanning' stamp: 'yo 11/10/2010 13:39  <  '!
startOfNextToken
	"Return starting position in source of next token."

	hereType == #doIt ifTrue: [^source position + 1].
	^hereMark! !

!MParser methodsFor: 'temps' stamp: 'yo 11/10/2010 13:39  <  '!
bindArg: name

	^ self bindTemp: name! !

!MParser methodsFor: 'temps' stamp: 'yo 11/10/2010 13:39  <  '!
bindTemp: name

	^name! !

!MParser methodsFor: 'error handling' stamp: 'yo 11/10/2010 13:39  <  hmm 7/18/2001 21:45'!
expected: aString 
	"Notify a problem at token 'here'."

	tokenType == #doIt ifTrue: [hereMark _ hereMark + 1].
	hereType == #doIt ifTrue: [hereMark _ hereMark + 1].
	^ self notify: aString , ' expected' at: hereMark + requestorOffset! !

!MParser methodsFor: 'error handling' stamp: 'yo 11/10/2010 20:35'!
fail

	self log: 'compilation failed'.
! !

!MParser methodsFor: 'error handling' stamp: 'yo 11/10/2010 13:39  <  '!
notify: aString 
	"Notify problem at token before 'here'."

	^self notify: aString at: prevMark + requestorOffset! !

!MParser methodsFor: 'error handling' stamp: 'yo 11/10/2010 20:54'!
notify: string at: location

	^self fail! !

!MParser methodsFor: 'error handling' stamp: 'yo 11/10/2010 13:39  <  di 2/9/1999 15:43'!
offEnd: aString 
	"Notify a problem beyond 'here' (in lookAhead token). Don't be offEnded!!"

	requestorOffset == nil
		ifTrue: [^ self notify: aString at: mark]
		ifFalse: [^ self notify: aString at: mark + requestorOffset]
! !

!MParser methodsFor: 'private' stamp: 'yo 11/10/2010 13:39  <  '!
addComment

	parseNode ~~ nil
		ifTrue: 
			[parseNode comment: currentComment.
			currentComment _ nil]! !

!MParser methodsFor: 'private' stamp: 'yo 11/10/2010 20:56'!
initPattern: aString return: aBlock

	| result |
	self
		init: (ReadStream on: aString asString).
	encoder _ self.
	result _ aBlock value: (self pattern: false inContext: nil).
	encoder _ nil.  "break cycles"
	^result! !

!MParser methodsFor: 'private' stamp: 'yo 11/10/2010 20:50'!
init: sourceStream

	super scan: sourceStream.
	prevMark _ hereMark _ mark.
	requestorOffset _ 0.
	self advance! !

!MParser methodsFor: 'primitives' stamp: 'yo 11/10/2010 13:39  <  '!
allocateLiteral: lit
	encoder litIndex: lit! !

!MParser methodsFor: 'primitives' stamp: 'yo 11/11/2010 00:46'!
externalFunctionDeclaration
	"Parse the function declaration for a call to an external library."
	^ 0.
! !

!MParser methodsFor: 'primitives' stamp: 'yo 11/10/2010 13:39  <  '!
primitive
	| n |
	(self matchToken: #<) ifFalse: [^ 0].
	n _ self primitiveDeclarations.
	(self matchToken: #>) ifFalse: [^ self expected: '>'].
	^ n! !

!MParser methodsFor: 'primitives' stamp: 'yo 12/14/2010 21:49'!
primitiveDeclarations
	| prim module |
	(self matchToken: 'primitive:') ifFalse:[^self externalFunctionDeclaration].
	prim _ here.
	(self match: #number) ifTrue:[^prim].	"Indexed primitives"
	(self match: #string) ifFalse:[^self expected:'Integer or String'].
	(self matchToken: 'module:') ifTrue:[
		module _ here.
		(self match: #string) ifFalse:[^self expected: 'String'].
		module _ module asSymbol].
	(self allocateLiteral: (Array with: module with: prim asSymbol with: 0), (Array with: 0)).
	^117! !

!MParser methodsFor: 'primitives' stamp: 'yo 11/10/2010 13:39  <  eem 12/1/2008 09:17'!
primitive: anIntegerOrString
	"Create indexed primitive."
	
	^self primitive: anIntegerOrString error: nil! !

!MParser methodsFor: 'primitives' stamp: 'yo 11/10/2010 13:39  <  eem 12/1/2008 09:21'!
primitive: anIntegerOrString error: errorCodeVariableOrNil
	"Create indexed primitive with optional error code."
	
	^anIntegerOrString isInteger
		ifTrue:
			[errorCodeVariableOrNil ifNotNil:
				[encoder floatTemp: (encoder bindTemp: errorCodeVariableOrNil) nowHasDef].
			 anIntegerOrString]
		ifFalse:
			[anIntegerOrString isString
				ifTrue: [self primitive: anIntegerOrString module: nil error: errorCodeVariableOrNil]
				ifFalse: [self expected: 'Indexed primitive']]! !

!MParser methodsFor: 'primitives' stamp: 'yo 11/10/2010 13:39  <  eem 12/1/2008 09:20'!
primitive: aNameString error: errorCodeVariableOrNil module: aModuleStringOrNil
	"Create named primitive with optional error code."
	
	^self primitive: aNameString module: aModuleStringOrNil error: errorCodeVariableOrNil! !

!MParser methodsFor: 'primitives' stamp: 'yo 11/10/2010 13:39  <  eem 12/1/2008 09:21'!
primitive: aNameString module: aModuleStringOrNil
	"Create named primitive."
	
	^self primitive: aNameString module: aModuleStringOrNil error: nil! !

!MParser methodsFor: 'primitives' stamp: 'yo 12/14/2010 21:49'!
primitive: aNameString module: aModuleStringOrNil error: errorCodeVariableOrNil
	"Create named primitive with optional error code."
	
	(aNameString isString and: [ aModuleStringOrNil isNil or: [ aModuleStringOrNil isString ] ])
		ifFalse: [ ^ self expected: 'Named primitive' ].
	self allocateLiteral: (Array with:  
		(aModuleStringOrNil isNil 
			ifFalse: [ aModuleStringOrNil asSymbol ])
		with: aNameString asSymbol
		with: 0), (Array with: 0).
	errorCodeVariableOrNil ifNotNil:
		[encoder floatTemp: (encoder bindTemp: errorCodeVariableOrNil) nowHasDef].
	^117! !

!MParser methodsFor: 'pragmas' stamp: 'yo 11/10/2010 13:40  <  eem 11/29/2008 16:44'!
addPragma: aPragma
	properties := properties copyWith: aPragma! !

!MParser methodsFor: 'pragmas' stamp: 'yo 12/9/2010 10:44'!
pragmaLiteral: selectorSoFar
	"Read a pragma literal.  As a nicety we allow a variable name (rather
	 than a literal string) as the second argument to primitive:error:"

	(hereType == #string or: [ hereType == #literal or: [ hereType == #number ] ])
		ifTrue: [ ^ self advance ].
	(here == $# and: [ tokenType == #word ])
		ifTrue: [ ^ self advance ].
	(here == #- and: [ tokenType == #number ])
		ifTrue: [ ^ (self advance; advance) negated ].
	here = 'true' ifTrue: [^ true].
	here = 'false' ifTrue: [^ false].
	here = 'nil' ifTrue: [^ nil].
	"This nicety allows one to supply a primitive error
	 temp as a variable name, rather than a string."
	((selectorSoFar beginsWith: 'primitive:')
	 and: [(selectorSoFar endsWith: 'error:')
	 and: [hereType == #word]]) ifTrue:
		[^self advance].
	^self expected: 'Literal constant'! !

!MParser methodsFor: 'pragmas' stamp: 'yo 11/10/2010 13:40  <  eem 12/1/2008 14:33'!
pragmaPrimitives
	| primitives |
	properties isEmpty ifTrue:
		[^0].
	primitives := properties pragmas select:
					[:pragma|
					self class primitivePragmaSelectors includes: pragma keyword].
	primitives isEmpty ifTrue:
		[^0].
	primitives size > 1 ifTrue:
		[^self notify: 'Ambigous primitives'].
	^self perform: primitives first keyword withArguments: primitives first arguments! !

!MParser methodsFor: 'pragmas' stamp: 'yo 11/10/2010 13:40  <  lr 10/5/2006 09:47'!
pragmaSequence
	"Parse a sequence of method pragmas."
	
	[ true ] whileTrue: [
		(self matchToken: #<)
			ifFalse: [ ^ self ].
		self pragmaStatement.
		(self matchToken: #>)
			ifFalse: [ ^ self expected: '>' ] ]! !

!MParser methodsFor: 'pragmas' stamp: 'yo 11/10/2010 20:41'!
pragmaStatement
	"Read a single pragma statement. Parse all generic pragmas in the form of: <key1: val1 key2: val2 ...> and remember them, including primitives."
	
	| selector arguments words index keyword |
	(hereType = #keyword or: [ hereType = #word or: [ hereType = #binary ] ])
		ifFalse: [  ^ self expected: 'pragma declaration' ].

	" This is a ugly hack into the compiler of the FFI package. FFI should be changed to use propre pragmas that can be parsed with the code here. "
	(here = #apicall: or: [ here = #cdecl: ])
		ifTrue: [ ^ self externalFunctionDeclaration ].

	selector := String new.
	arguments := OrderedCollection new.
	words := OrderedCollection new.
	[ hereType = #keyword or: [ (hereType = #word or: [ hereType = #binary ]) and: [ selector isEmpty ] ] ] whileTrue: [
		index := self startOfNextToken + requestorOffset.
		selector := selector , self advance.
		words add: (index to: self endOfLastToken + requestorOffset).
		(selector last = $: or: [ selector first isLetter not ])
			ifTrue: [ arguments add: (self pragmaLiteral: selector) ] ].
	selector numArgs ~= arguments size
		ifTrue: [ ^ self expected: 'pragma argument' ].
	(Symbol hasInterned: selector 
		ifTrue: [ :value | keyword := value]) 
		ifFalse: [ 
			keyword := selector asSymbol].
	self addPragma: (Pragma keyword: keyword arguments: arguments asArray).
	^ true! !


!MScanner class methodsFor: 'class initialization' stamp: 'yo 12/14/2010 01:26'!
initialize
	| newTable |
	"newTable _ Array new: 65536 withAll: #xBinary. ""default"
	newTable := Array new: 256.
	newTable atAllPut: #xBinary.
	"newTable atAll: #(9 10 12 13 32 ) put: #xDelimiter." "tab lf ff cr space"
	#(9 10 12 13 32 ) do: [:i | newTable at: i put: #xDelimiter]. 
	"newTable atAll: ($0 asciiValue to: $9 asciiValue) put: #xDigit."
	 ($0 asciiValue to: $9 asciiValue) do: [:i | newTable at: i put: #xDigit].

	1 to: newTable size - 1
		do: [:index |
			(Character value: index) isLetter
				ifTrue: [newTable at: index put: #xLetter]].

	TypeTable := newTable.
	newTable at: 30 put: #doIt.
	newTable at: $" asciiValue put: #xDoubleQuote.
	newTable at: $# asciiValue put: #xLitQuote.
	newTable at: $$ asciiValue put: #xDollar.
	newTable at: $' asciiValue put: #xSingleQuote.
	newTable at: $: asciiValue put: #xColon.
	newTable at: $( asciiValue put: #leftParenthesis.
	newTable at: $) asciiValue put: #rightParenthesis.
	newTable at: $. asciiValue put: #period.
	newTable at: $; asciiValue put: #semicolon.
	newTable at: $[ asciiValue put: #leftBracket.
	newTable at: $] asciiValue put: #rightBracket.
	newTable at: ${ asciiValue put: #leftBrace.
	newTable at: $} asciiValue put: #rightBrace.
	newTable at: $^ asciiValue put: #upArrow.
	newTable at: $_ asciiValue put: #leftArrow.
	newTable at: $| asciiValue put: #verticalBar.

	"Scanner initialize"! !

!MScanner class methodsFor: 'instance creation' stamp: 'yo 11/9/2010 20:57  <  '!
new

	^super new initScanner! !

!MScanner class methodsFor: 'testing' stamp: 'yo 11/9/2010 20:57  <  ar 4/11/2005 00:12'!
isLiteralSymbol: aSymbol 
	"Test whether a symbol can be stored as # followed by its characters.  
	Symbols created internally with asSymbol may not have this property, 
	e.g. '3' asSymbol."
	| i ascii type |
	i _ aSymbol size.
	i = 0 ifTrue: [^ false].
	i = 1 ifTrue: [('$''"()#0123456789' includes: (aSymbol at: 1))
		ifTrue: [^ false] ifFalse: [^ true]].
	ascii _ (aSymbol at: 1) asciiValue.
	"TypeTable should have been origined at 0 rather than 1 ..."
	ascii = 0 ifTrue: [^ false].
	type _ TypeTable at: ascii ifAbsent:[#xLetter].
	(type == #xColon or: [type == #verticalBar or: [type == #xBinary]]) ifTrue: [
		i = 1 ifTrue: [^ true] ifFalse: [^ false]
	].
	type == #xLetter ifTrue: 
			[[i > 1]
				whileTrue: 
					[ascii _ (aSymbol at: i) asciiValue.
					ascii = 0 ifTrue: [^ false].
					type _ TypeTable at: ascii ifAbsent:[#xLetter].
					(type == #xLetter or: [type == #xDigit or: [type == #xColon]])
						ifFalse: [^ false].
					i _ i - 1].
			^ true].
	^ false! !

!MScanner class methodsFor: 'tracing' stamp: 'bf 12/2/2010 23:29'!
implicitMessages
	^Dictionary with: #scanToken -> (self selectors select: [:sel | sel first = $x])! !


!MParser class methodsFor: 'accessing' stamp: 'yo 11/10/2010 13:40  <  eem 12/1/2008 14:32'!
primitivePragmaSelectors
	"Answer the selectors of pragmas that specify VM primitives.
	 Needed for compile and decomple."
	^#(primitive:
		primitive:error:
		primitive:error:module:
		primitive:module:
		primitive:module:error:)! !


!MSelectorNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:05  <  '!
emit: stack args: nArgs on: strm

	self emit: stack
		args: nArgs
		on: strm
		super: false! !

!MSelectorNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:05  <  '!
emit: stack args: nArgs on: aStream super: supered
	| index |
	stack pop: nArgs.
	(supered not and: [code - Send < SendLimit and: [nArgs < 3]]) ifTrue:
		["short send"
		code < Send
			ifTrue: [^ aStream nextPut: code "special"]
			ifFalse: [^ aStream nextPut: nArgs * 16 + code]].
	index _ code < 256 ifTrue: [code - Send] ifFalse: [code \\ 256].
	(index <= 31 and: [nArgs <= 7]) ifTrue: 
		["extended (2-byte) send [131 and 133]"
		aStream nextPut: SendLong + (supered ifTrue: [2] ifFalse: [0]).
		^ aStream nextPut: nArgs * 32 + index].
	(supered not and: [index <= 63 and: [nArgs <= 3]]) ifTrue:
		["new extended (2-byte) send [134]"
		aStream nextPut: SendLong2.
		^ aStream nextPut: nArgs * 64 + index].
	"long (3-byte) send"
	aStream nextPut: DblExtDoAll.
	aStream nextPut: nArgs + (supered ifTrue: [32] ifFalse: [0]).
	aStream nextPut: index! !

!MSelectorNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:05  <  di 1/7/2000 12:32'!
size: encoder args: nArgs super: supered
	| index |
	self reserve: encoder.
	(supered not and: [code - Send < SendLimit and: [nArgs < 3]])
		ifTrue: [^1]. "short send"
	(supered and: [code < Send]) ifTrue: 
		["super special:"
		code _ self code: (encoder sharableLitIndex: key) type: 5].
	index _ code < 256 ifTrue: [code - Send] ifFalse: [code \\ 256].
	(index <= 31 and: [nArgs <= 7])
		ifTrue: [^ 2]. "medium send"
	(supered not and: [index <= 63 and: [nArgs <= 3]])
		ifTrue: [^ 2]. "new medium send"
	^ 3 "long send"! !

!MSelectorNode methodsFor: 'printing' stamp: 'yo 11/10/2010 15:05'!
printOn: aStream indent: level 
	key == nil
		ifTrue: [aStream nextPutAll: '<key==nil>']
		ifFalse: [aStream nextPutAll: key]! !

!MSelectorNode methodsFor: 'inappropriate' stamp: 'yo 11/9/2010 20:05  <  '!
emitForEffect: stack on: strm

	self shouldNotImplement! !

!MSelectorNode methodsFor: 'inappropriate' stamp: 'yo 11/9/2010 20:05  <  '!
emitForValue: stack on: strm

	self shouldNotImplement! !

!MSelectorNode methodsFor: 'inappropriate' stamp: 'yo 11/9/2010 20:05  <  '!
sizeForEffect: encoder

	self shouldNotImplement! !

!MSelectorNode methodsFor: 'inappropriate' stamp: 'yo 11/9/2010 20:05  <  '!
sizeForValue: encoder

	self shouldNotImplement! !

!MSelectorNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:05  <  '!
isPvtSelector
	"Answer if this selector node is a private message selector."

	^key isPvtSelector! !


!MVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:26  <  '!
asStorableNode: encoder
	^ self! !

!MVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:26  <  tk 9/28/2001 11:33'!
name: string
	"Change name"

	name _ string.
! !

!MVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:26  <  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! !

!MVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:26  <  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! !

!MVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:26  <  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! !

!MVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:26  <  ab 7/13/2004 13:53'!
assignmentCheck: encoder at: location

	(encoder cantStoreInto: self name)
		ifTrue: [^ location]
		ifFalse: [^ -1]
! !

!MVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:26  <  ab 7/6/2004 17:37'!
canBeSpecialArgument
	"Can I be an argument of (e.g.) ifTrue:?"

	^ self code < LdNil! !

!MVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:26  <  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! !

!MVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:26  <  ab 7/13/2004 13:53'!
isSelfPseudoVariable
	"Answer if this ParseNode represents the 'self' pseudo-variable."

	^ (self key = 'self') | (self name = '{{self}}')! !

!MVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:26  <  '!
isVariableReference

	^true! !

!MVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:26  <  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]! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  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]! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  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]! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  ar 8/14/2001 23:14'!
emitLoad: stack on: strm
	"Do nothing"! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  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! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  '!
emitStore: stack on: strm

	self emitLong: Store on: strm! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  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]! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  ab 7/6/2004 17:36'!
sizeForReturn: encoder

	(self code >= LdSelf and: [self code <= LdNil])
		ifTrue: ["short returns" ^1].
	^super sizeForReturn: encoder! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/11/2010 16:27'!
sizeForStorePop: encoder
	self reserve: encoder.
	(self code < 24 and: [(self code bitAnd: 8) = 0]) 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"! !

!MVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:26  <  ab 7/6/2004 17:38'!
sizeForStore: encoder
	self reserve: encoder.
	self code < 256 ifTrue: [^ 2].
	(self code \\ 256) <= 63 ifTrue: [^ 2].
	^ 3! !

!MVariableNode methodsFor: 'printing' stamp: 'yo 11/10/2010 15:05'!
printOn: aStream indent: level 
	aStream nextPutAll: self name.! !

!MVariableNode methodsFor: 'accessing' stamp: 'yo 11/9/2010 20:26  <  tk 1/30/2001 13:45'!
name
	^ name! !


!MLiteralVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:27  <  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.! !

!MLiteralVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:27  <  ar 8/16/2001 12:12'!
emitStorePop: stack on: strm
	splNode ifNil:[^super emitStorePop: stack on: strm].
	self emitStore: stack on: strm.
	strm nextPut: Pop.
	stack pop: 1.! !

!MLiteralVariableNode methodsFor: 'code generation' stamp: 'yo 11/9/2010 20:27  <  ar 8/16/2001 12:12'!
emitStore: stack on: strm
	splNode ifNil:[^super emitStore: stack on: strm].
	splNode
			emit: stack
			args: 1
			on: strm
			super: false.! !

!MLiteralVariableNode methodsFor: 'code generation' stamp: 'yo 11/11/2010 16:17'!
sizeForStorePop: encoder
	| index |
	(self key isVariableBinding and:[false]) 
		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! !

!MLiteralVariableNode methodsFor: 'code generation' stamp: 'yo 11/11/2010 16:17'!
sizeForStore: encoder
	| index |
	(self key isVariableBinding and:[false]) 
		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)! !


!MTempVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:28  <  '!
isArg: aBoolean

	isAnArg _ aBoolean.
	isAnArg ifTrue: [hasDefs _ true]! !

!MTempVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:28  <  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! !

!MTempVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:28  <  '!
nowHasDef
	hasDefs _ true! !

!MTempVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:28  <  '!
nowHasRef
	hasRefs _ true! !

!MTempVariableNode methodsFor: 'initialize-release' stamp: 'yo 11/9/2010 20:28  <  '!
scope: level
	"Note scope of temporary variables.
	Currently only the following distinctions are made:
		0	outer level: args and user-declared temps
		1	block args and doLimiT temps
		-1	a block temp that is no longer active
		-2	a block temp that held limit of to:do:"
	scope _ level! !

!MTempVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:28  <  ab 7/13/2004 13:56'!
assignmentCheck: encoder at: location

	self isArg ifTrue: [^ location]
			ifFalse: [^ -1]! !

!MTempVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:28  <  '!
isArg
	^ isAnArg! !

!MTempVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:28  <  '!
isTemp
	^ true! !

!MTempVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:28  <  '!
isUndefTemp
	^ hasDefs not! !

!MTempVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:28  <  '!
isUnusedTemp
	^ hasRefs not! !

!MTempVariableNode methodsFor: 'testing' stamp: 'yo 11/9/2010 20:28  <  '!
scope
	^ scope! !

!MTempVariableNode methodsFor: 'printing' stamp: 'yo 11/10/2010 15:05'!
printOn: aStream indent: level 
	aStream nextPutAll: self name! !


!MVariableNode class methodsFor: 'class initialization' stamp: 'yo 12/16/2010 01:26'!
initialize1   "VariableNode initialize1."
	| encoder |
	encoder _ Encoder new.
	StdVariables _ EqualityDictionary new: 16.
	encoder
		fillDictWithString: StdVariables
		with: VariableNode
		mapping: #('self' 'thisContext' 'super' 'nil' 'false' 'true' )
		to: (Array with: LdSelf with: LdThisContext with: LdSuper)
				, (Array with: LdNil with: LdFalse with: LdTrue).
	StdSelectors _ EqualityDictionary new: 64.
	encoder
		fillDict: StdSelectors
		with: SelectorNode
		mapping: ((1 to: System specialSelectorSize) collect: 
							[:i | System specialSelectorAt: i])
		to: (SendPlus to: SendPlus + 31).
	StdLiterals _ LiteralDictionary new: 16.
	encoder
		fillDict: StdLiterals
		with: LiteralNode
		mapping: #(-1 0 1 2 )
		to: (LdMinus1 to: LdMinus1 + 3).
	encoder initScopeAndLiteralTables.
	self initialize2: encoder.
"
	NodeNil _ encoder encodeVariable: (String newFrom: 'nil').
	NodeTrue _ encoder encodeVariable: (String newFrom: 'true').
	NodeFalse _ encoder encodeVariable: (String newFrom: 'false').
	NodeSelf _ encoder encodeVariable: (String newFrom: 'self').
	NodeThisContext _ encoder encodeVariable: (String newFrom: 'thisContext').
	NodeSuper _ encoder encodeVariable: (String newFrom: 'super')"! !

!MVariableNode class methodsFor: 'class initialization' stamp: 'yo 12/16/2010 01:27'!
initialize2: encoder    "VariableNode initialize1."

	NodeNil _ encoder encodeVariable: (String newFrom: 'nil').
	NodeTrue _ encoder encodeVariable: (String newFrom: 'true').
	NodeFalse _ encoder encodeVariable: (String newFrom: 'false').
	NodeSelf _ encoder encodeVariable: (String newFrom: 'self').
	NodeThisContext _ encoder encodeVariable: (String newFrom: 'thisContext').
	NodeSuper _ encoder encodeVariable: (String newFrom: 'super')! !