SystemOrganization addCategory: #'NewCompiler-Syntax'!
SystemOrganization addCategory: #'NewCompiler-Bytecodes'!
SystemOrganization addCategory: #'NewCompiler-IR'!
SystemOrganization addCategory: #'NewCompiler-Semantics'!
SystemOrganization addCategory: #'NewCompiler-Extras'!
SystemOrganization addCategory: #'NewCompiler-Tests'!
SystemOrganization addCategory: #'NewCompiler-Standalone'!
SystemOrganization addCategory: #'NewCompiler-Tools'!

!RBDoItNode methodsFor: '*newcompiler' stamp: 'ajh 6/28/2004 13:52'!
compiledMethod

	^ self ir compiledMethod! !

!RBDoItNode methodsFor: '*newcompiler' stamp: 'md 2/21/2006 14:41'!
generate
	"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."

	^self generate: #(0 0 0 0)! !

!RBDoItNode methodsFor: '*newcompiler' stamp: 'ajh 3/10/2003 20:23'!
generate: trailer

	^ self generateIR compiledMethodWith: trailer! !

!RBDoItNode methodsFor: '*newcompiler' stamp: 'ajh 6/23/2004 19:52'!
generateIR

	^ ir _ ASTTranslator new
		visitNode: self;
		ir! !

!RBDoItNode methodsFor: '*newcompiler' stamp: 'pmm 8/16/2006 21:34'!
generateWith: trailer using: aCompiledMethodClass

	^ self generateIR compiledMethodWith: trailer using: aCompiledMethodClass! !

!RBDoItNode methodsFor: '*newcompiler' stamp: 'ajh 3/10/2003 20:25'!
ir

	^ ir ifNil: [self generateIR]! !

!RBDoItNode methodsFor: '*newcompiler' stamp: 'md 3/16/2006 18:47'!
verifyIn: classOrScope
	"Look up vars in classOrScope.  My tree will be annotated with bindings to LexicalScopes and ScopeVars."

	ASTChecker new
		scope: classOrScope parseScope;
		visitNode: self.
	Preferences compileBlocksAsClosures ifFalse: [ 
		NonClosureScopeFixer new visitNode: self.
	]
	! !

!MethodPragmaTest methodsFor: '*newcompiler-override' stamp: 'md 7/26/2006 14:59'!
testCompileInvalid
	"Invalid pragmas should properly raise an error."

	self should: [ self compile: '<>' selector: #zork ] raise: SmaCCParserError .
	self should: [ self compile: '<1>' selector: #zork ] raise: SmaCCParserError.	
	self should: [ self compile: '<#123>' selector: #zork ] raise: SmaCCParserError.
	
	self should: [ self compile: '<foo bar>' selector: #zork ] raise: SmaCCParserError.
	self should: [ self compile: '<foo 1>' selector: #zork ] raise: SmaCCParserError.
	self should: [ self compile: '<foo bar zork>' selector: #zork ] raise: SmaCCParserError.
	self should: [ self compile: '<foo bar 1>' selector: #zork ] raise: SmaCCParserError.
	
self should: [ self compile: '<foo: bar:>' selector: #zork ] raise: SmaCCParserError.
	self should: [ self compile: '<foo: #bar: zork:>' selector: #zork ] raise: SmaCCParserError.! !

Stream subclass: #SelectSqueakTokenStream
	instanceVariableNames: 'selectBlock nextValue atEnd stream'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SelectSqueakTokenStream commentStamp: 'ms 9/17/2006 19:24' prior: 0!
A SelectSqueakTokenStream is Decorator of stream to select token expected.

Instance Variables
	atEnd:		<Object>
	nextValue:		<Object>
	selectBlock:		<Object>
	stream:		<Object>

atEnd
	- xxxxx

nextValue
	- xxxxx

selectBlock
	- xxxxx

stream
	- xxxxx
!

!SelectSqueakTokenStream class methodsFor: 'instance creation' stamp: 'ms 9/19/2006 01:14'!
selectComment: aTokenStream

	^self basicNew initialize; select: [:each | each notEaten and: [each isComment]] on: aTokenStream; yourself
	
	! !

!SelectSqueakTokenStream class methodsFor: 'instance creation' stamp: 'ms 9/17/2006 20:00'!
selectCommentNewLineOn: aTokenStream

	^self basicNew initialize; select: [:each | each notEaten and: [each isComment or: [each isNewLine]]] on: aTokenStream; yourself
	
	! !

!SelectSqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/17/2006 19:27'!
atEnd
     ^atEnd! !

!SelectSqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/19/2006 00:44'!
contents

     | temp tempStream |
     temp := OrderedCollection with: nextValue.
	tempStream := stream contents.
     tempStream do: [:each | (selectBlock value: each) 
               ifTrue: [temp add: each]].
     ^temp! !

!SelectSqueakTokenStream methodsFor: 'accessing' stamp: 'ms 10/14/2006 15:38'!
next
     | temp |
     temp := nextValue.
     stream do: [:each | (selectBlock value: each) 
               ifTrue: [nextValue := each.  ^temp]].
     atEnd := true.
	nextValue := nil.
     ^temp! !

!SelectSqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/19/2006 15:16'!
peek
   
	^nextValue! !

!SelectSqueakTokenStream methodsFor: 'private' stamp: 'ms 9/19/2006 12:54'!
select: aBlock on: aStream

       selectBlock := aBlock.
       stream := aStream.
       atEnd := false.
       self next! !

Stream subclass: #SqueakTokenStream
	instanceVariableNames: 'token goNext'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SqueakTokenStream class methodsFor: 'instance creation' stamp: 'ms 9/17/2006 19:05'!
backwardOn: aToken

	^(self basicNew) initialize; backwardOn: aToken; yourself
! !

!SqueakTokenStream class methodsFor: 'instance creation' stamp: 'ms 9/19/2006 14:42'!
forwardOn: aToken

	^(self basicNew) initialize; forwardOn: aToken
! !

!SqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/17/2006 19:00'!
atEnd
	
	^token isNil! !

!SqueakTokenStream methodsFor: 'initialize' stamp: 'ms 9/19/2006 00:41'!
backwardOn: aToken
	
	token := aToken.
	goNext := #previous! !

!SqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/19/2006 00:42'!
contents
	
	| cont nextToken |
	cont := OrderedCollection new.
	nextToken := token.
	[nextToken isNil] whileFalse: [cont add: nextToken. nextToken := nextToken perform: goNext].
	^cont asArray! !

!SqueakTokenStream methodsFor: 'initialize' stamp: 'ms 9/19/2006 00:41'!
forwardOn: aToken
	
	token := aToken.
	goNext := #next! !

!SqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/19/2006 02:09'!
next
	
	| next |
	next := token.
	self atEnd ifFalse:[token :=  token perform: goNext].
	^next! !

!SqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/19/2006 01:03'!
peek
	
	^token! !

!SqueakTokenStream methodsFor: 'accessing' stamp: 'ms 9/19/2006 13:08'!
selectCommentNewLine

	^SelectSqueakTokenStream selectCommentNewLineOn: self! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'ms 10/27/2006 14:38'!
addComment
	"add comment on the tree"

	ASTCommenter new
		visitNode: self! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/6/2007 19:55'!
afterComment
	^ self propertyAt: #afterComment ifAbsent: [nil]! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/6/2007 19:56'!
afterComment: aString
	aString ifNil: [^self removeProperty: #afterComment ifAbsent: []].
	self propertyAt: #afterComment put: aString.! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/6/2007 19:57'!
beforeComment
	^ self propertyAt: #beforeComment ifAbsent: [nil]! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/6/2007 19:58'!
beforeComment: anOrderedCollection
	anOrderedCollection ifNil: [^self removeProperty: #beforeComment ifAbsent: []].
	self propertyAt: #beforeComment put: anOrderedCollection.! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/6/2007 19:58'!
insideComment
	^ self propertyAt: #insideComment ifAbsent: [nil]! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/6/2007 19:58'!
insideComment: aCollection
	aCollection ifNil: [^self removeProperty: #insideComment ifAbsent: []].
	self propertyAt: #insideComment put: aCollection.! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:36'!
peekAfterComment
	
	| tokenStream token |
	self afterComment ifNil:[
		self afterComment: OrderedCollection new.
		tokenStream := (SqueakTokenStream forwardOn: self lastToken next).
		[token := tokenStream next.
		 token isNewLine or:[tokenStream atEnd] or: [token isSignificant]]
				whileFalse: [
					token isComment ifTrue:[self afterComment add: token eatToken]].
		self afterComment do: [:each | self comments add: (each start to: each stop)]
	].
	^self afterComment! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:35'!
peekAfterCommentUntil: aToken
	
	| tokenStream token |
	self afterComment ifNil:[
		self afterComment: OrderedCollection new.
		tokenStream := (SqueakTokenStream forwardOn: self lastToken) selectCommentNewLine.
		[token := tokenStream next.
		 aToken = token or:[token isNewLine or:[tokenStream atEnd]]] 
				whileFalse: [self afterComment add: token eatToken].
		self afterComment do: [:each | self comments add: (each start to: each stop)]
	].
	^self afterComment! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:40'!
peekBeforeComment
	| tokenStream token countNewLine |
	self beforeComment ifNil: 
			[countNewLine := 0.
			self beforeComment: OrderedCollection new.
			tokenStream := (SqueakTokenStream backwardOn: self firstToken) 
						selectCommentNewLine.
			
			[token := tokenStream next.
			token isNewLine ifTrue: [countNewLine := countNewLine + 1].
			(token isSignificant or: [countNewLine > 1]) or: [tokenStream atEnd]] 
					whileFalse: 
						[countNewLine > 0 
							ifTrue: [token isComment ifTrue: [self beforeComment add: token eatToken]]].
			self beforeComment do: [:each | self comments add: (each start to: each stop)]].
	^ self beforeComment! !

!RBProgramNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:43'!
peekInsideComment
	
	| tokenStream token |
	self insideComment ifNil:[
		self insideComment: OrderedCollection new.
		tokenStream := (SqueakTokenStream forwardOn: self firstToken).
		[token := tokenStream next.
		 token = self lastToken or:[tokenStream atEnd]]
				whileFalse: [(token isComment and:[token notEaten]) 
								ifTrue:[self insideComment add: token eatToken]].
		self insideComment do: [:each | self comments add: (each start to: each stop)]
	].
	^self insideComment! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'md 4/14/2007 10:44'!
asBlock

	^ (RBBlockNode
		arguments: self arguments
		body: body)
		privIR: self ir;
		scope: self scope! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'ajh 6/28/2004 13:52'!
compiledMethod

	^ self ir compiledMethod! !

!RBMethodNode methodsFor: '*newcompiler-semantics' stamp: 'ajh 7/8/2004 20:56'!
freeNames
	"Filter out hidden ones that have space in there name such as 'top env'"

	^ ((self freeVars collect: [:var | var name])
		reject: [:name | name includes: $ ]) asSortedCollection! !

!RBMethodNode methodsFor: '*newcompiler-semantics' stamp: 'md 4/13/2007 15:09'!
freeVars
	"Return children variable node bindings that refer to variables outside my scope (ignoring global vars)"

	| freeVars |
	freeVars := Set new.
	self scope: self owningScope.
	self nodesDo: [:node | | var |
		(node isVariable or: [node isReturn and: [node binding notNil]]) ifTrue: [
			var := node binding.
			(self scope hasOuter: var scope) ifTrue: [
				var isGlobal ifFalse: [
					freeVars add: var]]]].
	^ freeVars! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'md 2/21/2006 14:42'!
generate
	"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."

	^self generate: #(0 0 0 0)! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'ajh 3/10/2003 20:21'!
generate: trailer

	^ self generateIR compiledMethodWith: trailer! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'ajh 6/23/2004 19:52'!
generateIR

	^ ir _ ASTTranslator new
		visitNode: self;
		ir! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'pmm 8/16/2006 21:34'!
generateWith: trailer using: aCompiledMethodClass

	^ self generateIR compiledMethodWith: trailer using: aCompiledMethodClass! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'ajh 3/10/2003 20:20'!
ir

	^ ir ifNil: [self generateIR]! !

!RBMethodNode methodsFor: '*newcompiler-semantics' stamp: 'ajh 6/30/2004 14:07'!
owningBlock

	^ self! !

!RBMethodNode methodsFor: '*newcompiler-semantics' stamp: 'md 4/8/2007 17:58'!
owningScope

	^ self scope! !

!RBMethodNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:37'!
peekAfterComment

	| tokenStream token countNewLine |
	self afterComment ifNil:[
		countNewLine := 0.
		self afterComment: OrderedCollection new.
		tokenStream := (SqueakTokenStream forwardOn: self lastTokenOfPatternMethod) selectCommentNewLine.
		[token := tokenStream next.
		 token isNewLine ifTrue: [countNewLine := countNewLine + 1.]. 
		 (countNewLine = 2) or: [tokenStream atEnd]] 
				whileFalse: [countNewLine = 1 ifTrue: [token isComment ifTrue:[self afterComment add: token eatToken]]].
		self afterComment do: [:each | self comments add: (each start to: each stop)]
	].
	^self afterComment
	
	! !

!RBMethodNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:41'!
peekBeforeComment
	| tokenStream token |
	self beforeComment ifNil: 
			[
			self beforeComment: OrderedCollection new.
			tokenStream := (SqueakTokenStream backwardOn: self firstToken) 
						selectCommentNewLine.
			[token := tokenStream next.
			token isNil] 
					whileFalse: 
						[token isComment ifTrue: [self beforeComment add: token eatToken]].
			self beforeComment do: [:each | self comments add: (each start to: each stop)]].
	^ self beforeComment! !

!RBMethodNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:44'!
peekInsideComment
	
	| tokenStream token |
	self insideComment ifNil:[
		self insideComment: OrderedCollection new.
		tokenStream := (SqueakTokenStream forwardOn: self firstToken).
		[token := tokenStream next.
		 tokenStream atEnd]
				whileFalse: [(token isComment and:[token notEaten]) 
								ifTrue:[self insideComment add: token eatToken]].
		self insideComment do: [:each | self comments add: (each start to: each stop)]
	].
	^self insideComment! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'ajh 3/3/2003 12:07'!
privIR: irMethod

	ir _ irMethod! !

!RBMethodNode methodsFor: '*newcompiler-semantics' stamp: 'ajh 3/16/2003 08:32'!
scope

	^ scope ifNil: [
		self verifyIn: nil parseScope.
		scope
	  ]! !

!RBMethodNode methodsFor: '*newcompiler-semantics' stamp: 'ajh 2/26/2003 15:46'!
scope: aSemMethodScope

	scope := aSemMethodScope! !

!RBMethodNode methodsFor: '*newcompiler-debugging' stamp: 'ajh 2/27/2003 23:58'!
sourceMap
	"Return a mapping from bytecode pcs to source code ranges"

	^ self ir sourceMap! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'md 2/27/2006 17:50'!
sourceText: aText
	self flag: #fixme! !

!RBMethodNode methodsFor: '*newcompiler-debugging' stamp: 'ajh 6/29/2004 16:06'!
tempNames
	"All temp names in context order"

	^ self scope tempVars allButFirst "without self" collect: [:var | var name]! !

!RBMethodNode methodsFor: '*newcompiler' stamp: 'md 3/16/2006 18:48'!
verifyIn: classOrScope
	"Look up vars in classOrScope.  My tree will be annotated with bindings to LexicalScopes and ScopeVars."

	ASTChecker new
		scope: classOrScope parseScope;
		visitNode: self.
		
	Preferences compileBlocksAsClosures ifFalse: [ 
		NonClosureScopeFixer new visitNode: self.
	]! !

TestCase subclass: #BytecodeDecompilerTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!BytecodeDecompilerTest methodsFor: 'examples' stamp: 'md 2/24/2005 15:04'!
exampleWhileTrue
	"Override the superclass for performance reasons."
	| index firstIndex lastIndex aBlock array |
	index _ firstIndex.  
	[index <= lastIndex]
		whileTrue:
			[aBlock value: (array at: index).
			index _ index + 1]! !

!BytecodeDecompilerTest methodsFor: 'tests' stamp: 'md 3/22/2005 15:01'!
testDecompileObject
	self shouldnt: [
			Object methodDict values do: [:meth |
					meth ir.
			]
	] raise: Error.! !

!BytecodeDecompilerTest methodsFor: 'tests' stamp: 'md 2/24/2005 15:20'!
testDecompilerOrderedCollectionDo
	| cm decompiledIR  |
	cm := OrderedCollection>>#do:.

	decompiledIR := BytecodeDecompiler new decompile: cm.

	self shouldnt: [decompiledIR compiledMethodWith: #(0)] raise: Error.! !

!BytecodeDecompilerTest methodsFor: 'tests' stamp: 'md 3/22/2005 15:55'!
testRecompileIRObject
	self shouldnt: [
			Object methodDict values do: [:meth |
					(meth ir) compiledMethodWith: #(0).
			] displayingProgress: 'recompiling'
	] raise: Error.! !

!BytecodeDecompilerTest methodsFor: 'tests' stamp: 'md 2/24/2005 15:26'!
testWhileTrue
	| cm decompiledIR aCompiledMethod |
	cm := (self class)>>#testWhileTrue.

	decompiledIR := BytecodeDecompiler new decompile: cm.
	
	self shouldnt: [aCompiledMethod := decompiledIR compiledMethodWith: #(0)] raise: Error.! !

TestCase subclass: #BytecodeGeneratorTest
	instanceVariableNames: 'a'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!BytecodeGeneratorTest methodsFor: 'setup' stamp: 'md 10/13/2004 14:16'!
setUp
	a := 2! !

!BytecodeGeneratorTest methodsFor: 'tests' stamp: 'md 10/13/2004 14:20'!
testExample
	| cm |
	
	cm := BytecodeGenerator new
		numArgs: 1;
		pushInstVar: 2;
		pushTemp: 1;
		send: #>;
		if: false goto: #else;
		pushLiteral: 'yes';
		returnTop;
		label: #else;
		pushLiteral: 'no';
		returnTop;
		compiledMethod.

	self assert: (cm isKindOf: CompiledMethod).
	self assert: (cm valueWithReceiver: self arguments: #(1)) = 'yes' .
	self assert: (cm valueWithReceiver: self arguments: #(3)) = 'no' .	
	^cm
	! !

TestCase subclass: #ClosureCompilerTest
	instanceVariableNames: 'iVar'
	classVariableNames: 'Test'
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!ClosureCompilerTest class methodsFor: 'as yet unclassified' stamp: 'md 10/19/2004 12:24'!
Test
	^Test! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 21:04'!
exampleAndAnd1
	^1 = 1 and: [ 2 = 2 ] and: [ 3 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 20:57'!
exampleAndAnd2
	^1 = 1 and: [ 2 = 2 ] and: [ 2 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 20:58'!
exampleAndAnd3
	^1 = 2 and: [ 2 = 2 ] and: [ 3 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 20:59'!
exampleAndAnd4
	^1 = 1 and: [ 2 = 3 ] and: [ 3 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 20:58'!
exampleAndAnd5
	^1 = 2 and: [ 2 = 3 ] and: [ 3 = 4 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/24/2006 20:17'!
exampleAndAnd6
	^1 = 2 and: [ 2 = 3 ] and: [ 3 = 4 ] and: [ 1 / 0 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 11:15'!
exampleBlockExternal
	| t |
	t := 1.
	^[t] value.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 15:39'!
exampleBlockExternal2
	| t1 t2 |
	t1 :=  t2 := 1.
	^[t1 + t2] value.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 15:38'!
exampleBlockExternalArg
	| t  |
	t := 1.
	^[:a | t + a] value: 1.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 15:40'!
exampleBlockExternalNested
	| t s |
	t := s := 1.
	^[[s] value +   t   ] value.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 15:42'!
exampleBlockInternal
	
	^[ | t | t := 1.    t] value.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/19/2006 13:30'!
exampleIfNotNilDo
	^1 even ifNotNilDo: [ :arg | arg not ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/19/2006 13:32'!
exampleIfNotNilDoReturnNil
	^nil ifNotNilDo: [ :arg | arg not ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 7/25/2006 15:24'!
exampleIfNotNilReturnNil
	^"nil ifNotNil: [ :arg | arg not ]"self! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 21:00'!
exampleOrOr1
	^1 = 1 or: [ 2 = 2 ] or: [ 3 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 21:00'!
exampleOrOr2
	^1 = 1 or: [ 2 = 2 ] or: [ 2 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 21:00'!
exampleOrOr3
	^1 = 2 or: [ 2 = 2 ] or: [ 3 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 21:00'!
exampleOrOr4
	^1 = 1 or: [ 2 = 3 ] or: [ 3 = 3 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/20/2006 21:00'!
exampleOrOr5
	^1 = 2 or: [ 2 = 3 ] or: [ 3 = 4 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'pmm 7/24/2006 20:17'!
exampleOrOr6
	^1 = 2 or: [ 2 = 3 ] or: [ 3 = 4 ] or: [ 4 = 4 ] or: [ 1 / 0 ]! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/14/2004 17:45'!
exampleReturn1
	^1! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 09:21'!
exampleSimpleBlock
	^[1].! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 11:08'!
exampleSimpleBlockArgument1
	^[:a | a ] value: 1.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 11:09'!
exampleSimpleBlockArgument2
	^[:a :b | a + b ] value: 1 value: 1.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 11:09'!
exampleSimpleBlockArgument3
	^[:a :b :c | a + b + c ] value: 1 value: 1 value: 1.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 11:09'!
exampleSimpleBlockArgument4
	^[:a :b :c :d | a + b + c  + d] value: 1 value: 1 value: 1 value: 1. ! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/15/2004 11:11'!
exampleSimpleBlockArgument5
	^[:a :b :c :d :e| a + b + c  + d + e] valueWithArguments: #(1 1 1 1 1). ! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 11/11/2004 14:22'!
exampleSimpleBlockLocal
	^[ :each | | t |  t:= each. t   ] value: 5.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 11/11/2004 14:42'!
exampleSimpleBlockLocalIf
	^true ifTrue: [ | hallo |  hallo := 1 . hallo].! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 11/11/2004 14:56'!
exampleSimpleBlockLocalIfNested
	^true ifTrue: [| hallo |  [  hallo := 1 . hallo] value] .! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 11/11/2004 15:47'!
exampleSimpleBlockLocalWhile
	|a|
	a := true.
	^[: b | [a] whileTrue: [ | hallo |  a := false. hallo := 1 . hallo]]value: 1.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 11/11/2004 17:37'!
exampleSimpleBlockNested
	| a match dict | 

	a  := #(a b c d).
	dict := Dictionary new.


	a doWithIndex: [:each :index |
		(match := a indexOf: each) > 0 ifTrue:
			[dict at: index put: (a at: match)]].

	^ dict.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/16/2004 21:26'!
exampleSimpleBlockiVar
	^[iVar] value.! !

!ClosureCompilerTest methodsFor: 'examples' stamp: 'md 10/16/2004 20:20'!
exampleiVar
	iVar := 1.
	^iVar.! !

!ClosureCompilerTest methodsFor: 'running' stamp: 'md 10/16/2004 21:28'!
setUp
	iVar := 1.! !

!ClosureCompilerTest methodsFor: 'tests' stamp: 'pmm 7/24/2006 20:18'!
testAndAnd

	self assert: self exampleAndAnd1.
	self deny: self exampleAndAnd2.
	self deny: self exampleAndAnd3.
	self deny: self exampleAndAnd4.
	self deny: self exampleAndAnd5.
	self shouldnt: [ self exampleAndAnd6 ] raise: ZeroDivide! !

!ClosureCompilerTest methodsFor: 'tests - bugs' stamp: 'md 10/19/2004 12:32'!
testBackJump

	| src ast method |
	src :=  JPEGReadWriter  sourceCodeAt: #idctBlockInt:qt:.
	
	ast := ClosureCompiler new parseClosure: src in: JPEGReadWriter notifying: nil.

	method := ast ir compiledMethod.! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:18'!
testBlockExternal

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleBlockExternal.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	self assert: (method valueWithReceiver: self arguments: #()) = 1.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:18'!
testBlockExternal2

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleBlockExternal2.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	self assert: (method valueWithReceiver: self arguments: #()) = 2.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:18'!
testBlockExternalArg

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleBlockExternalArg.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	self assert: (method valueWithReceiver: self arguments: #()) = 2.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:18'!
testBlockExternalNested

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleBlockExternalNested.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	self assert: (method valueWithReceiver: self arguments: #()) = 2.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:18'!
testBlockInternal

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleBlockInternal.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	self assert: (method valueWithReceiver: self arguments: #()) = 1.
! !

!ClosureCompilerTest methodsFor: 'tests - bugs' stamp: 'md 10/19/2004 14:20'!
testClassVar

	| src ast method |
	src :=  Float class sourceCodeAt: #nan.
	
	ast := ClosureCompiler new parseClosure: src in: Float class notifying: nil.


	self shouldnt: [ method := ast ir compiledMethod] raise: Error.
	self assert: (method valueWithReceiver: nil arguments: #()) isNaN.! !

!ClosureCompilerTest methodsFor: 'tests' stamp: 'md 10/27/2004 17:02'!
testCompile

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleReturn1.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.
	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: nil arguments: #()) = 1.! !

!ClosureCompilerTest methodsFor: 'tests' stamp: 'pmm 7/19/2006 13:31'!
testIfNotNilDo

	self assert: self exampleIfNotNilDo! !

!ClosureCompilerTest methodsFor: 'tests' stamp: 'pmm 7/19/2006 13:33'!
testIfNotNilDoReturnNil

	self assert: self exampleIfNotNilDoReturnNil isNil! !

!ClosureCompilerTest methodsFor: 'tests' stamp: 'pmm 7/19/2006 13:33'!
testIfNotNilReturnNil

	self assert: self exampleIfNotNilReturnNil isNil! !

!ClosureCompilerTest methodsFor: 'tests - bugs' stamp: 'md 10/17/2004 16:25'!
testMinusEndOfLine
	| src  |

	src :=  'test ^#-'.

	self shouldnt: [ ClosureCompiler new parseClosure: src in: self class notifying: nil] raise: Error.
	! !

!ClosureCompilerTest methodsFor: 'tests' stamp: 'pmm 7/24/2006 20:19'!
testOrOr

	self assert: self exampleOrOr1.
	self assert: self exampleOrOr2.
	self assert: self exampleOrOr3.
	self assert: self exampleOrOr4.
	self deny: self exampleOrOr5.
	self shouldnt: [ self exampleOrOr6 ] raise: ZeroDivide! !

!ClosureCompilerTest methodsFor: 'tests - bugs' stamp: 'md 10/19/2004 14:57'!
testParseSymbolColon
	| src  |

	src :=  'test ^#:'.
	self shouldnt: [Compiler new parse: src in: self class notifying: nil] raise: Error.
	self shouldnt: [ClosureCompiler new parseClosure: src in: self class notifying: nil] raise: Error.
	! !

!ClosureCompilerTest methodsFor: 'tests - bugs' stamp: 'md 10/17/2004 16:31'!
testScannExponent
	| src  |

	src :=  'test ^1.0e-14'.
	self shouldnt: [Compiler new parse: src in: self class notifying: nil] raise: Error.
	self shouldnt: [ClosureCompiler new parseClosure: src in: self class notifying: nil] raise: Error.
	! !

!ClosureCompilerTest methodsFor: 'tests - bugs' stamp: 'md 10/17/2004 16:31'!
testScannExponent2
	| src  |

	src :=  'test ^#(2r1e26 2r111e26)'.
	self shouldnt: [Compiler new parse: src in: self class notifying: nil] raise: Error.
	self shouldnt: [ClosureCompiler new parseClosure: src in: self class notifying: nil] raise: Error.
	! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 11/11/2004 17:31'!
testSimpleBloccNested

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockNested.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	self assert: (method valueWithReceiver: self arguments: #()) = ClosureCompilerTest new exampleSimpleBlockNested.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:18'!
testSimpleBlock

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlock.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) value = 1.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:18'!
testSimpleBlockArgument1

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockArgument1.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 1.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:17'!
testSimpleBlockArgument2

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockArgument2.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 2.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:17'!
testSimpleBlockArgument3

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockArgument3.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 3.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:17'!
testSimpleBlockArgument4

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockArgument4.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 4.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/19/2004 11:17'!
testSimpleBlockArgument5

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockArgument5.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 5.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 11/11/2004 14:21'!
testSimpleBlockLocal

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockLocal.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 5.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 11/11/2004 14:42'!
testSimpleBlockLocalIf

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockLocalIf.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 1.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 11/11/2004 14:53'!
testSimpleBlockLocalIfNested

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockLocalIfNested.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = 1.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 11/11/2004 15:55'!
testSimpleBlockLocalWhile

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockLocalWhile.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.

	self assert: (method valueWithReceiver: self arguments: #()) = nil.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 10/16/2004 21:27'!
testSimpleBlockiVar

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleSimpleBlockiVar.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	self assert: (method valueWithReceiver: self arguments: #()) = 1.
! !

!ClosureCompilerTest methodsFor: 'testing - oldBlocks' stamp: 'md 11/10/2004 15:43'!
testSimpleiVar

	| src ast ir method |

	src :=  self class sourceCodeAt: #exampleiVar.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.
	method := ir compiledMethod.
	
	self assert: (method valueWithReceiver: self arguments: #()) = 1.
! !

TestCase subclass: #IRBuilderTest
	instanceVariableNames: ''
	classVariableNames: 'TestToPush'
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!IRBuilderTest class methodsFor: 'as yet unclassified' stamp: 'ms 7/12/2006 18:43'!
testToPush
	^TestToPush! !

!IRBuilderTest class methodsFor: 'as yet unclassified' stamp: 'ms 7/12/2006 18:43'!
testToPush: anObject

	TestToPush := anObject! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/13/2006 10:10'!
expectedFailures

	^ #(testPushThisEnv testStoreThisEnv)! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:50'!
isThisEverCalled
	"Redefinition for testing the #send:toSuperOf:"
! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:32'!
testDup

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: 3;
		pushDup;
		
		send: #=;
		
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = true).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:32'!
testInstVar

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"

		pushInstVar: 1;
		pushInstVar: 2;
		send: #+;
		
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: (3@4) arguments: #() ) = 7).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:32'!
testJumpAheadTo

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushTemp: #self	;
			
		jumpAheadTo: #end;
		pushLiteral: 3;
		jumpAheadTarget: #end;	
		
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:32'!
testJumpAheadToIf

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushTemp: #self	;
		pushLiteral: true;
		
		"jumpAhaedTo pop the first element of thz stack"
		jumpAheadTo: #end if: true;
		pushLiteral: 3;
		jumpAheadTarget: #end;	
		
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:33'!
testJumpBackTo

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushTemp: #self	;
		pushLiteral: false;
		jumpBackTarget: #begin;
		
		"jumpAhaedTo pop the first element of the stack"
		jumpAheadTo: #end if: true;
		pushLiteral: true;
		jumpBackTo: #begin;
		jumpAheadTarget: #end;	
		
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:52'!
testLiteralArray

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: #(test 4 you); 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = #(test 4 you)).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:49'!
testLiteralBoolean

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: true; 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = true).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:50'!
testLiteralCharacter

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: $e; 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = $e).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:54'!
testLiteralFloat

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: 2.0; 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2.0).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:54'!
testLiteralInteger

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: 2; 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:50'!
testLiteralNil

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: nil; 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: 4 arguments: #() ) = nil).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:53'!
testLiteralString

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: 'hello'; 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 'hello').

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 12/1/2006 20:39'!
testLiteralSymbole

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteral: #you; 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = #you).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:28'!
testLiteralVariableClass

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteralVariable: Object binding;	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = Object).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:33'!
testLiteralVariableClassVariable

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteralVariable: (DateAndTime bindingOf: #LocalTimeZone); 	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = DateAndTime localTimeZone).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 17:27'!
testLiteralVariableGlobale

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
			
		pushLiteralVariable: (Smalltalk associationAt: #Smalltalk);	
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = Smalltalk).

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:33'!
testPopTop

	| iRMethod aCompiledMethod |
	iRMethod _ IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushTemp: #self	;
			
		pushLiteral: false;
		popTop;
		
		returnTop;
		ir.

	aCompiledMethod _ iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = nil).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:33'!
testPushReceiver

	| iRMethod aCompiledMethod receiver |
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushReceiver;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.
	
	receiver :=  (5@8).

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: receiver arguments: #() ) == receiver).
! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:33'!
testPushTempArgument

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		numRargs: 3;
		addTemps: #(self a b);		"receiver and args declarations"
		pushTemp: #a;
		pushTemp: #b;
		send: #+;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #(2 8) ) = 10).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:33'!
testPushTempSelf

	| iRMethod aCompiledMethod |
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushTemp: #self;
		send: #class;
		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) == UndefinedObject).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:33'!
testPushTempTemp

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self a);		"receiver and args declarations"
	
		pushTemp: #a;

		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: 5 arguments: #() ) = nil).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:33'!
testPushThisContext

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self a);		"receiver and args declarations"
	
		pushThisContext;
		send: #receiver;

		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: 5 arguments: #() ) = 5).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:47'!
testPushThisEnv

	| iRMethod aCompiledMethod receiver |
	self error: 'TODO I don''t know what it mean'.
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
	
		pushThisEnv;
		send: #receiver;

		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	receiver := Object new.
	
	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: receiver arguments: #()) == receiver)
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:41'!
testSendSuper

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
	
		pushReceiver;
		send: #isThisEverCalled toSuperOf: IRBuilderTest;

		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self should: [(aCompiledMethod valueWithReceiver: (IRBuilderTest new) arguments: #())] raise: Halt.
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:34'!
testStorIntoVariable

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
	
		pushLiteral: 4;
		storeIntoLiteralVariable: (IRBuilderTest bindingOf: #TestToPush);

		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.


	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     aCompiledMethod valueWithReceiver: nil arguments: #().
	self assert: (IRBuilderTest testToPush = 4).
	IRBuilderTest testToPush: nil.

	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:48'!
testStoreTemp

	| iRMethod aCompiledMethod  |
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self a);		"receiver and args declarations"
	
		pushLiteral: 34;
		storeTemp: #a;
		popTop;
		pushTemp: #a;

		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 34).
	! !

!IRBuilderTest methodsFor: 'testing' stamp: 'ms 7/12/2006 23:50'!
testStoreThisEnv

	| iRMethod aCompiledMethod  |
	self error: 'TODO don''t know what it mean'.
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self a);		"receiver and args declarations"
	
		pushLiteral: 34;
		storeTemp: #a;
		popTop;
		pushTemp: #a;

		returnTop;
		ir.

	aCompiledMethod := iRMethod compiledMethod.

	self assert: (aCompiledMethod isKindOf: CompiledMethod).
     self assert: ((aCompiledMethod valueWithReceiver: nil arguments: #() ) = 34).
	! !

TestCase subclass: #IRDecompilerTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!IRDecompilerTest commentStamp: '<historical>' prior: 0!
This class tests decompilation if IR Nodes to RB Nodes (class IRDecompiler) !

!IRDecompilerTest methodsFor: 'examples' stamp: 'md 11/15/2004 16:08'!
exampleBlockParam
	^[:a| a].! !

!IRDecompilerTest methodsFor: 'examples' stamp: 'md 11/15/2004 17:10'!
exampleBlockSelf
	^[self].! !

!IRDecompilerTest methodsFor: 'examples' stamp: 'md 3/9/2005 14:14'!
exampleIf
	^ true ifTrue: [1 + 3]. ! !

!IRDecompilerTest methodsFor: 'examples' stamp: 'md 11/17/2004 13:55'!
exampleParam: a

	| ttttt |

	[:t |  ^ttttt]   ! !

!IRDecompilerTest methodsFor: 'examples' stamp: 'md 10/20/2004 17:49'!
exampleSimpleBlock
	^[1].! !

!IRDecompilerTest methodsFor: 'testing' stamp: 'md 7/13/2006 09:34'!
expectedFailures
	^#(testDecompileBlockParam)! !

!IRDecompilerTest methodsFor: 'testing' stamp: 'md 11/15/2004 17:09'!
testDecompileBlock

	| ir ast src |

	src :=  self class sourceCodeAt: #exampleSimpleBlock.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.

	ast := IRDecompiler new decompileIR: ir.
	self assert: (ast compiledMethod valueWithReceiver: nil arguments: #()) value = 1. ! !

!IRDecompilerTest methodsFor: 'testing' stamp: 'ms 1/7/2007 01:15'!
testDecompileBlockParam
	"self debug: #testDecompileBlockParam"
	| cm ir ast |

	cm := (self class)>>#exampleBlockParam.

	ir := BytecodeDecompiler new decompile: cm.
	
	ast := IRDecompiler new decompileIR: ir.


	self assert: ((ast compiledMethod valueWithReceiver: nil arguments: #()) value: 2) = 2. ! !

!IRDecompilerTest methodsFor: 'testing' stamp: 'md 11/17/2004 12:31'!
testDecompileBlockSelf

	| ir ast src |

	src :=  self class sourceCodeAt: #exampleBlockSelf.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.
     
	ir := ast ir.
	
	ast := IRDecompiler new decompileIR: ir.

	self assert: (ast compiledMethod valueWithReceiver: self arguments: #()) value = self. ! !

!IRDecompilerTest methodsFor: 'testing' stamp: 'md 3/9/2005 18:42'!
testDecompileIfTrue

	| ir src ast |
	"cm := self class>>#exampleIf.

	ir := BytecodeDecompiler new decompile: cm."

	src :=  self class sourceCodeAt: #exampleIf.
	
	ast := ClosureCompiler new parseClosure: src in: self class notifying: nil.

	ir := ast ir.

	ast := IRDecompiler new decompileIR: ir.
	! !

TestCase subclass: #IRTransformTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!IRTransformTest methodsFor: 'testing' stamp: 'md 10/13/2004 14:09'!
testAdd
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		returnTop;
		ir.

	(iRMethod allSequences last) last delete.
	(iRMethod allSequences last) last delete.

	(iRMethod allSequences last)
			add: (IRInstruction pushLiteral: 2).

	(iRMethod allSequences last)
			add: (IRInstruction returnTop).

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing' stamp: 'md 10/13/2004 14:09'!
testAddBefore
	
	| iRMethod aCompiledMethod ret |

	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		returnTop;
		ir.

	(iRMethod allSequences last) last delete.
	(iRMethod allSequences last) last delete.

	ret :=  (IRInstruction returnTop).

	(iRMethod allSequences last)
			add: ret.

	(iRMethod allSequences last)
			add: (IRInstruction pushLiteral: 2) before: ret.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing' stamp: 'md 10/13/2004 14:09'!
testAddIntructions
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		returnTop;
		ir.

	(iRMethod allSequences last) last delete.
	(iRMethod allSequences last) last delete.

	(iRMethod allSequences last)
			addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)}.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing' stamp: 'md 10/12/2004 16:31'!
testAddIntructionsBefore
	
	| iRMethod aCompiledMethod push |

	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		returnTop;
		ir.

	push := (iRMethod allSequences last) at: (iRMethod allSequences size - 1) .

	(iRMethod allSequences last)
			addInstructions: {(IRInstruction pushLiteral: 2). (IRInstruction returnTop)} before: push.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing' stamp: 'md 10/13/2004 11:08'!
testAddIntructionsBeforeFromLList
	
	| iRMethod aCompiledMethod push llist col |

	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		returnTop;
		ir.

	push := (iRMethod allSequences last) at: (iRMethod allSequences size - 1) .

	llist := LinkedList new.
	llist add: (IRInstruction pushLiteral: 2).
	llist add: (IRInstruction returnTop).

	col := llist asOrderedCollection.

	(iRMethod allSequences last)
			addInstructions:  col before: push.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing' stamp: 'md 10/13/2004 14:09'!
testDelete
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		pushLiteral: 2;	
		returnTop;
		ir.

	((iRMethod allSequences last) 
		detect: [:each | each isConstant: [:c | c == 2]]) delete.
			

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 1].
! !

!IRTransformTest methodsFor: 'testing' stamp: 'ms 7/13/2006 10:13'!
testReplace
	| iRMethod aCompiledMethod |
	
	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		returnTop;
		ir.
	
	(iRMethod allSequences last at: 1) 
			replaceWith: (IRInstruction pushLiteral: 2).

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

!IRTransformTest methodsFor: 'testing' stamp: 'md 2/22/2005 11:58'!
testReplaceInstr
	
	| iRMethod aCompiledMethod |

	iRMethod := IRBuilder new
		numRargs: 1;
		addTemps: #(self);		"receiver and args declarations"
		pushLiteral: 1;				
		returnTop;
		ir.
	
	(iRMethod allSequences last at: 1) 
			replaceWithInstructions: {(IRInstruction pushLiteral: 2)}.

	aCompiledMethod := iRMethod compiledMethod.
	self should: [(aCompiledMethod valueWithReceiver: nil arguments: #() ) = 2].
! !

TestCase subclass: #NonClosureScopeFixerTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!NonClosureScopeFixerTest methodsFor: 'example' stamp: 'md 3/16/2006 18:00'!
exampleSimple
	| a |
	a := 1.
	^[:b | a + b] value: 1.! !

!NonClosureScopeFixerTest methodsFor: 'tests' stamp: 'md 3/17/2006 11:38'!
testSimple
	| text ast |
	
	text := self class sourceCodeAt: #exampleSimple.
	self assert: text isText.
	ast := Parser2 new parse: text class: self class.
	self assert: (ast isKindOf: RBMethodNode).
	
	self assert: ast scope isMethodScope.
	NonClosureScopeFixer new visitNode: ast.! !

TestCase subclass: #PragmaTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!PragmaTest methodsFor: 'accessing' stamp: 'ms 9/4/2006 00:25'!
expectedFailures

	Smalltalk at: #ExternalFunction ifAbsent:[^#(#testApicall #testCdecl #testCdeclNoModule)].
	^#()! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/19/2006 00:12'!
methodApicall
	^'methodApicall: aHWND
		<apicall: Win32HDC ''GetDC'' (Win32Window bool bool*) module: ''user32.dll''>
		^self externalCallFailed'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/19/2006 00:15'!
methodCdecl
	^'XCloseDisplay: aDisplay
		<cdecl: void ''XCloseDisplay'' (X11Display*) module:''X11''>
		^self externalCallFailed'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/25/2006 08:36'!
methodCdeclNoModule
	^'ffiTestShort: c1 with: c2 with: c3 with: c4
		"FFITester ffiTestShort: $A with: 65 with: 65.0 with: $A"
		<cdecl: short ''ffiTestShorts'' (short short short short)>
		^self externalCallFailed'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:03'!
methodDoublePragma
	^'methodDoublePragma
		<hello: 5>
		<hello: 2>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 20:56'!
methodDoublePrimitive
	^'methodDoublePrimitive
		<primitive: 5>
		<primitive: 2>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/26/2006 22:53'!
methodNoPragma
	^'methodNoPragma: aNum
		^aNum'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:04'!
methodPragmaAfterBeforTemps
	^'methodPragmaAfterBeforTemps
		<hello: 5>
		| aTemp |
		<world: #ok>
		<blue: true>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/20/2006 20:49'!
methodPragmaTwoParam
	^'methodDoublePragma
		<hello: 5 by: 2>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/25/2006 07:56'!
methodPragmaUnarayMessage
	^'methodPragmaUnarayMessage
		<hello>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:05'!
methodPrimitive
	^'methodPrimitive
		<primitive: 4>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:05'!
methodPrimitivePragma
	^'methodPrimitivePragma
		<hello: 1>
		<primitive: 4>
		<hello: 1>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/22/2006 13:31'!
methodPrimitiveString
	^'methodPrimitiveString
		<primitive: ''aFunctionName''>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/22/2006 13:33'!
methodPrimitiveStringModule
	^'methodPrimitiveStringModule
		<primitive: ''aFunctionName'' module: ''aModuleName''>'! !

!PragmaTest methodsFor: 'method-tested' stamp: 'ms 7/16/2006 21:06'!
methodSinglePragma
	^'methodSinglePragma
		<hello: 5>'! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/19/2006 00:10'!
testApicall
	| aRBMethode |
	aRBMethode := ClosureCompiler new parseClosure: self methodApicall in: self class notifying: [nil].
	
	self assert: ((aRBMethode compiledMethod literalAt: 1) isKindOf: ExternalLibraryFunction).
	self assert: (aRBMethode compiledMethod primitive = 120)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/19/2006 00:15'!
testCdecl
	| aRBMethode |
	aRBMethode := ClosureCompiler new parseClosure: self methodCdecl in: self class notifying: [nil].
	
	self assert: ((aRBMethode compiledMethod literalAt: 1) isKindOf: ExternalLibraryFunction).
	self assert: (aRBMethode compiledMethod primitive = 120)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/25/2006 08:37'!
testCdeclNoModule
	| aRBMethode |
	aRBMethode := ClosureCompiler new parseClosure: self methodCdeclNoModule in: self class notifying: [nil].
	
	self assert: ((aRBMethode compiledMethod literalAt: 1) isKindOf: ExternalLibraryFunction).
	self assert: (aRBMethode compiledMethod primitive = 120)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/16/2006 21:03'!
testDoublePragma
	| aRBMethode |
	"self debug: #testDoublePragma"
	aRBMethode := ClosureCompiler new parseClosure: self methodDoublePragma in: self class notifying: [nil].
	
	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:).
	self assert: (aRBMethode compiledMethod pragmas second keyword = #hello:)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 9/4/2006 00:24'!
testDoublePrimitive
	"self debug: #testDoublePrimitive"
	self should: [ClosureCompiler new parseClosure: self methodDoublePrimitive in: self class notifying: [^nil]] raise: Warning! !

!PragmaTest methodsFor: 'testing' stamp: 'pmm 8/19/2006 22:18'!
testIsPrimitve
	| aRBMethode |

	aRBMethode := ClosureCompiler new parseClosure: self methodPrimitive in: self class notifying: [nil].
	
	self assert: aRBMethode isPrimitive! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/26/2006 22:54'!
testNoPragma
	"self debug: #testDoublePrimitive"
	self shouldnt: [ClosureCompiler new parseClosure: self methodNoPragma in: self class notifying: nil] raise: Error! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 9/10/2006 20:21'!
testPragmaAfterBeforTemp
	"self debug: #testPragmaAfterBeforTemp"
	| aRBMethode |
	aRBMethode := ClosureCompiler new parseClosure: self methodPragmaAfterBeforTemps in: self class notifying: nil.


	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:).
	self assert: (aRBMethode compiledMethod pragmas second keyword = #world:)
	! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/20/2006 20:50'!
testPragmaTwoParam
	"self debug: #testPragmaAfterBeforTemp"
	| aRBMethode |
	aRBMethode := ClosureCompiler new parseClosure: self methodPragmaTwoParam in: self class notifying: nil.


	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:by:)
	! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/25/2006 07:57'!
testPragmaUnarayMessage
	| aRBMethode |

	aRBMethode := ClosureCompiler new parseClosure: self methodPragmaUnarayMessage in: self class notifying: [nil].
	
	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/16/2006 21:05'!
testPrimitiveNumber
	| aRBMethode |

	aRBMethode := ClosureCompiler new parseClosure: self methodPrimitive in: self class notifying: [nil].
	
	self assert: (aRBMethode compiledMethod primitive = 4)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 9/4/2006 00:33'!
testPrimitivePragmaNumber
	| aRBMethode |

	aRBMethode := ClosureCompiler new parseClosure: self methodPrimitivePragma in: self class notifying: [^nil].
	
	self assert: (aRBMethode compiledMethod primitive = 4)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/22/2006 13:31'!
testPrimitiveString
	| aRBMethode |

	aRBMethode := ClosureCompiler new parseClosure: self methodPrimitiveString in: self class notifying: [nil].
	
	self assert: (aRBMethode compiledMethod primitive = 117)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/22/2006 13:33'!
testPrimitiveStringModule
	| aRBMethode |

	aRBMethode := ClosureCompiler new parseClosure: self methodPrimitiveStringModule in: self class notifying: [nil].
	
	self assert: (aRBMethode compiledMethod primitive = 117)! !

!PragmaTest methodsFor: 'testing' stamp: 'ms 7/16/2006 21:06'!
testSinglePragma
	| aRBMethode |
	aRBMethode := ClosureCompiler new parseClosure: self methodSinglePragma in: self class notifying: [nil].
	self assert: (aRBMethode compiledMethod pragmas first keyword = #hello:)
	! !

TestCase subclass: #SourceCode2BytecodeTest
	instanceVariableNames: 'instVar'
	classVariableNames: 'ClassVar'
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!SourceCode2BytecodeTest commentStamp: 'kwl 10/14/2006 10:43' prior: 0!
I provide at least one test which corresponds to a message sent by InstructionStream>>#interpretNextInstructionFor: to its client.!

!SourceCode2BytecodeTest methodsFor: 'compiling' stamp: 'kwl 10/14/2006 13:52'!
compile2methodNode: sourceStream 
	"Compile code without logging the source in the changes file"
	| methodNode |
	methodNode := ClosureCompiler new
				from: sourceStream
				class: self class
				classified: nil
				context: nil
				notifying: nil;
				
				translate: sourceStream
				noPattern: false
				ifFail: [^ nil].
	^ CompiledMethodWithNode generateMethodFromNode: methodNode trailer: #(0 0 0 0 )! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:53'!
testDoDup
	| selector methodNode scanner |
	selector := (methodNode := self compile2methodNode: 'duplicateTopBytecode 3 + 4; yourself') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #doDup description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:01'!
testDoPop
	| selector methodNode scanner |
	selector := (methodNode := self compile2methodNode: 'popStackBytecode 3 + 4') selector.
	scanner := InstructionStream on: methodNode method.
	3
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #doPop description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:11'!
testPrimAdd
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimAdd 3 + 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#+. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:32'!
testPrimAt
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimAt self at: 3') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#at:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:38'!
testPrimAtEnd
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimSize self atEnd') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#atEnd. false. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:30'!
testPrimAtPut
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimAtPut self at: 3 put: 4') selector.
	scanner := InstructionStream on: methodNode method.
	3
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#at:put:. false. 2}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:27'!
testPrimBitAnd
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimBitAnd 3 bitAnd: 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#bitAnd:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:28'!
testPrimBitOr
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimBitOr 3 bitOr: 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#bitOr:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:24'!
testPrimBitShift
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimBitShift 3 bitShift: 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#bitShift:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:54'!
testPrimBlockCopy
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimBlockCopy [nil] value') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#blockCopy:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:44'!
testPrimClass
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimClass self class') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#class. false. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:17'!
testPrimDivide
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimDivide 3 / 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#/. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:57'!
testPrimDoWith
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodeDoWith self do: #something') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#do:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:16'!
testPrimEqual
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimEqual 3 = 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'='. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:15'!
testPrimGreaterOrEqual
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimGreaterOrEqual 3 >= 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'>='. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:14'!
testPrimGreaterThan
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimGreaterThan 3 > 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#>. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:39'!
testPrimIdentity
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimIdentity 3 == 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#==. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:14'!
testPrimLessOrEqual
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimLessOrEqual 3 <= 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#<=. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:13'!
testPrimLessThan
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimLessThan 3 < 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#<. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:21'!
testPrimMakePoint
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimMakePoint 3 @ 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'@'. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:19'!
testPrimMod
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimMod 3 \\ 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#\\. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:17'!
testPrimMultiply
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimMultiply 3 * 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#'*'. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:59'!
testPrimNew
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimNew super new') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#new. true. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:00'!
testPrimNewWith
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodeNewWith self new: 3') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#new:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:36'!
testPrimNext
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimSize self next') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#next. false. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:38'!
testPrimNextPut
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimNextPut self nextPut: 3') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#nextPut:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:16'!
testPrimNotEqual
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimNotEqual 3 ~= 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#~=. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:01'!
testPrimPointX
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimPointX self x') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#x. false. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:01'!
testPrimPointY
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimPointY self y') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#y. false. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:26'!
testPrimQuo
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimQuo 3 // 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#//. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:32'!
testPrimSize
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimSize self size') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#size. false. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:12'!
testPrimSubtract
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimSubtract 3 - 4') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#-. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:55'!
testPrimValue
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodePrimValue self value') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#value. false. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:57'!
testPrimValueWith
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodeValueWith self value: 3') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#value:. false. 1}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 12:03'!
testPushActiveContextBytecode
	| selector methodNode scanner |
	selector := (methodNode := self compile2methodNode: 'pushActiveContextBytecode thisContext yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self assert: scanner peekInstruction selector == #pushActiveContext
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:35'!
testPushConstantFalseBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushConstantFalseBytecode false yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == false])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:37'!
testPushConstantMinusOneBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushConstantMinusOneBytecode -1 yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == -1])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:36'!
testPushConstantNilBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushConstantNilBytecode nil yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == nil])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:39'!
testPushConstantOneBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushConstantOneBytecode 1 yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:33'!
testPushConstantTrueBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushConstantTrueBytecode true yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self assert: ((did := scanner peekInstruction) selector == #pushConstant:
					and: [did arguments first == true])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:39'!
testPushConstantTwoBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushConstantTwoBytecode 2 yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == 2])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:38'!
testPushConstantZeroBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushConstantZeroBytecode 0 yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushConstant:
				and: [did arguments first == 0])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:33'!
testPushLiteralConstantBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushLiteralConstantBytecode #() yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self assert: ((did := scanner peekInstruction) selector == #pushConstant:
					and: [did arguments first = #()])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 10:42'!
testPushLiteralVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushLiteralVariableBytecode ClassVar yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushLiteralVariable:
				and: [did arguments first = (#ClassVar -> nil)])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:27'!
testPushReceiverBytecode
	| selector methodNode scanner |
	selector := (methodNode := self compile2methodNode: 'pushReceiverBytecode ^ self yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self assert: scanner peekInstruction selector == #pushReceiver
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:39'!
testPushReceiverVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushReceiverVariableBytecode instVar yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushReceiverVariable:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 20:11'!
testPushTemporaryVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'pushTemporaryVariableBytecode: t0 t0 yourself') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner peekInstruction) selector == #pushTemporaryVariable:
				and: [did arguments first == 0])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:48'!
testReturnFalseBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'returnFalseBytecode 3 + 4. ^ false') selector.
	scanner := InstructionStream on: methodNode method.
	4
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #methodReturnConstant:
				and: [did arguments first == false])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:49'!
testReturnNilBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'returnNilBytecode 3 + 4. ^ nil') selector.
	scanner := InstructionStream on: methodNode method.
	4
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #methodReturnConstant:
				and: [did arguments first == nil])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:47'!
testReturnReceiver
	| selector methodNode scanner |
	selector := (methodNode := self compile2methodNode: 'returnReceiver 3 + 4. ^ self') selector.
	scanner := InstructionStream on: methodNode method.
	4
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #methodReturnReceiver
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'ms 11/11/2006 19:23'!
testReturnTopFromBlock
	| selector methodNode scanner |
	selector := (methodNode := self compile2methodNode: 'returnTopFromBlock ^[ia]') selector.
	scanner := InstructionStream on: methodNode method.
	5
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #blockReturnTop
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:53'!
testReturnTopFromMethod
	| selector methodNode scanner |
	selector := (methodNode := self compile2methodNode: 'returnTopFromMethod ^ 3 + 4') selector.
	scanner := InstructionStream on: methodNode method.
	3
		timesRepeat: [scanner nextInstruction].
	self assert: scanner peekInstruction selector == #methodReturnTop
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 19:48'!
testReturnTrueBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'returnTrueBytecode 3 + 4. ^ true') selector.
	scanner := InstructionStream on: methodNode method.
	4
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #methodReturnConstant:
				and: [did arguments first == true])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 10:56'!
testStoreAndPopLiteralVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'storeAndPopLiteralVariableBytecode ClassVar := nil') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #popIntoLiteralVariable:
				and: [did arguments first = (#ClassVar -> nil)])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:39'!
testStoreAndPopReceiverVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'storeAndPopReceiverVariableBytecode instVar := self') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #popIntoReceiverVariable:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/12/2006 20:16'!
testStoreAndPopTemporaryVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'storeAndPopTemporaryVariableBytecode | t0 t1 | t1 := t0') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #popIntoTemporaryVariable:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 10:53'!
testStoreIntoLiteralVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'storeIntoLiteralVariableBytecode ^ (ClassVar := nil)') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #storeIntoLiteralVariable:
				and: [did arguments first = (#ClassVar -> nil)])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:40'!
testStoreIntoReceiverVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'storeIntoReceiverVariableBytecode ^ (instVar := self)') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #storeIntoReceiverVariable:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 10:51'!
testStoreIntoTemporaryVariableBytecode
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'storeIntoTemporaryVariableBytecode | t0 t1 | ^ (t1 := t0)') selector.
	scanner := InstructionStream on: methodNode method.
	self
		assert: ((did := scanner nextInstruction; peekInstruction) selector == #storeIntoTemporaryVariable:
				and: [did arguments first == 1])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:04'!
testSuperSend
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodeSuperSend super yourself') selector.
	scanner := InstructionStream on: methodNode method.
	1
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#yourself. true. 0}])
		description: 'Failed ' , selector! !

!SourceCode2BytecodeTest methodsFor: 'tests' stamp: 'kwl 10/14/2006 13:04'!
testSuperSendWith
	| selector methodNode scanner did |
	selector := (methodNode := self compile2methodNode: 'bytecodeSuperSendWith super new: 0') selector.
	scanner := InstructionStream on: methodNode method.
	2
		timesRepeat: [scanner nextInstruction].
	self
		assert: ((did := scanner peekInstruction) selector == #send:super:numArgs:
				and: [did arguments = {#new:. true. 1}])
		description: 'Failed ' , selector! !

TestCase subclass: #SqueakMethodPatternTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!SqueakMethodPatternTest methodsFor: 'tests' stamp: 'ms 11/25/2006 10:08'!
testParseMethodPattern
	
	| ast  |
	self shouldnt:[ast := SqueakParser parseMethodPattern: 'zork ^foo'] raise: Error.
	self assert: ast selector = #zork! !

TestCase subclass: #SqueakParserTest
	instanceVariableNames: 'rbMethod'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 11/17/2006 16:54'!
assertCommentOn: rbNode

	rbNode peekInsideComment 
		do: [:each | self assert: each value = '"0 remove"'].
	rbNode peekBeforeComment do: 
			[:each | 
			self assert: each value ~= '"0 remove"'.
			self assert: (each value indexOf: $b) > 0].
	rbNode peekAfterComment do: 
			[:each | 
			self assert: each value ~= '"0 remove"'.
			self assert: (each value indexOf: $a) > 0]! !

!SqueakParserTest methodsFor: 'util' stamp: 'ms 7/15/2006 10:50'!
keyword: anObject
	"For test"
	^anObject copy! !

!SqueakParserTest methodsFor: 'util' stamp: 'ms 9/20/2006 00:09'!
methodDescribeWithAllComment: "36b" anObject "34a" And: a "35a"
	"This is a method to see where are comment
	 Comment mark 0 remove tell you that nobody can contain it except the node 
	 who contain the comment(e.g. between firstToken and lastToken
	"
	
	"21b"
	<hello: "0 remove" 'you' "0 remove" > "22a"
	
	"2b"
	| ok |
	
	"3b"
	[
	
	"4b"
	^anObject copy "5a"
	
	]. "6a"

	[ 
	"7b" 
	 :each 
	 "8b"
	 || temp | "30a"
	
	 "0 remove"
	].
	
	"9b"
	(ok := 3). "10a"
	
	"11b"
	#( 3 4 5). "12a"
	
	[
	"13b"
	| "14b" 
	 temp "15a"
	 "0 remove"
	|
	
	"16b"
	self "17a" 
	
	"0 remove"
	].

	"19b"
	nil. "20a"
	
	"23b"
	true not; "0 remove" whileTrue: [
		
		"31b"
		-6 "32a".
		
		^self
			
	]. "25a"
	
	"26b"
	3 + 3. "27a"
	
	"28b"
	^Object new. "29a"
	
	"0 remove"
	"0 remove"
	
	
	
	! !

!SqueakParserTest methodsFor: 'runing' stamp: 'ms 9/19/2006 23:18'!
setUp
	
	rbMethod := SqueakParser parseMethod: (SqueakParserTest>>#methodDescribeWithAllComment:And:) getSource.
	rbMethod addComment
	! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnAssignment
	| rbNode |
	rbNode := rbMethod body statements third.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnBlock
	| rbNode |
	rbNode := rbMethod body statements first.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode.
	rbNode := rbMethod body statements second arguments first.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 1.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 0.
	self assertCommentOn: rbNode.
	rbNode := rbMethod body statements second.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 1.
	self assert: rbNode peekInsideComment size = 1.
	self assert: rbNode peekBeforeComment size = 0.
	self assert: rbNode peekAfterComment size = 0.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnCascade
	| rbNode |
	rbNode := rbMethod body statements seventh.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 3.
	self assert: rbNode peekInsideComment size = 1.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode.
	rbNode := rbMethod body statements seventh messages second arguments first 
				body statements 
				first.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnLiteral
	| rbNode |
	rbNode := rbMethod body statements fourth.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode.
	rbNode := rbMethod body statements sixth.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnMessage
	| rbNode |
	rbNode := rbMethod body statements eighth.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnMethod
	self assert: rbMethod comments notEmpty.
	self assert: rbMethod comments size = 3.
	self assert: rbMethod peekInsideComment size = 2.
	self assert: rbMethod peekBeforeComment size = 0.
	self assert: rbMethod peekAfterComment size = 1.
	self assertCommentOn: rbMethod! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnMethodArguments
	| rbNode |
	rbNode := rbMethod arguments first.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode.
	rbNode := rbMethod arguments second.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 1.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 0.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnMethodSequence
	| rbNode |
	rbNode := rbMethod body.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 1.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 0.
	self assertCommentOn: rbNode.
	rbNode := rbMethod body statements second body.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 1.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 0.
	self assertCommentOn: rbNode.
	rbNode := rbMethod body statements second body temporaries first.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 1.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 0.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnPragmas
	| rbNode |
	rbNode := rbMethod pragmas first.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 4.
	self assert: rbNode peekInsideComment size = 2.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnReturn
	| rbNode |
	rbNode := rbMethod body statements ninth.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnSequence
	| rbNode |
	rbNode := rbMethod body statements fifth body.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 1.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 0.
	self assertCommentOn: rbNode.
	rbNode := rbMethod body statements fifth.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 1.
	self assert: rbNode peekInsideComment size = 1.
	self assert: rbNode peekBeforeComment size = 0.
	self assert: rbNode peekAfterComment size = 0.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 9/20/2006 20:19'!
testCommentOnTempStatement
	| rbNode |
	rbNode := rbMethod body statements fifth body temporaries first.
	self assert: rbNode comments notEmpty.
	self assert: rbNode comments size = 2.
	self assert: rbNode peekInsideComment size = 0.
	self assert: rbNode peekBeforeComment size = 1.
	self assert: rbNode peekAfterComment size = 1.
	self assertCommentOn: rbNode! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 7/13/2006 15:33'!
testEmptyStatement
	"self debug: #testEmptyStatement"

	self shouldnt: [SqueakParser parseDoIt: 'Object new..' ] raise: Error.
	self shouldnt: [SqueakParser parseDoIt: '..Object new' ] raise: Error.
	self shouldnt: [SqueakParser parseDoIt: 'Object new..Object new' ] raise: Error.
	
	self assert: ((SqueakParser parseDoIt: 'Object new..') class = RBDoItNode).
	self assert: ((SqueakParser parseDoIt: '..Object new') class = RBDoItNode).
	self assert: ((SqueakParser parseDoIt: 'Object new..Object new') class = RBDoItNode)! !

!SqueakParserTest methodsFor: 'testing' stamp: 'ms 7/15/2006 10:51'!
testMethodPattern
	"self debug: #testEmptyStatement"

	self shouldnt: [SqueakParser parseMethodPattern: (self class>>#keyword:) getSource ] raise: Error.

! !

TestCase subclass: #SqueakTokenTest
	instanceVariableNames: 'aToken'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!SqueakTokenTest methodsFor: 'running' stamp: 'ms 11/17/2006 17:10'!
setUp

	| ast |
	ast := SqueakParser parseMethod: 'zork "boo" | e | ', String cr, ' e := 3 + 4.', String cr, '^e'.
	aToken := ast firstToken! !

!SqueakTokenTest methodsFor: 'testing' stamp: 'ms 11/17/2006 18:17'!
testIsComment
	
	self assert: (aToken isComment not).
	self assert: (aToken next isComment not).
	self assert: (aToken next next isComment)! !

!SqueakTokenTest methodsFor: 'testing' stamp: 'ms 11/17/2006 18:00'!
testIsSignificant
	
	self assert: (aToken isSignificant).
	self assert: (aToken next isSignificant not).
	self assert: (aToken next next isSignificant not)! !

!SqueakTokenTest methodsFor: 'testing' stamp: 'ms 11/17/2006 18:07'!
testNext
	
	self assert: (aToken next isKindOf: SqueakToken).! !

!SqueakTokenTest methodsFor: 'testing' stamp: 'ms 11/17/2006 18:25'!
testPrevious
	
	self assert: (aToken previous == nil).
	self assert: (aToken next previous isKindOf: SqueakToken)! !

Compiler subclass: #ClosureCompiler
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Standalone'!

!ClosureCompiler class methodsFor: 'initialization' stamp: 'md 11/12/2004 11:44'!
initialize
		"self initialize"

	Preferences
		addPreference: #compileBlocksAsClosures
		category: #compiler
		default: false
		balloonHelp: 'If true, blocks ([...]) will be compiled as BlockClosures instead of BlockContexts.  BlockClosures are independent of their home context but are a little slower (for now).  Only newly compiled methods will be affected by this preference. This requires the use of the new compiler, see Preference compileUsingNewCompiler'.
! !

!ClosureCompiler methodsFor: 'public access' stamp: 'pmm 2/2/2007 18:07'!
evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock
	"Compiles the sourceStream into a parse tree, then generates code into a 
	method. This method is then installed in the receiver's class so that it 
	can be invoked. In other words, if receiver is not nil, then the text can 
	refer to instance variables of that receiver (the Inspector uses this). If 
	aContext is not nil, the text can refer to temporaries in that context (the 
	Debugger uses this). If aRequestor is not nil, then it will receive a 
	notify:at: message before the attempt to evaluate is aborted. Finally, the 
	compiled method is invoked from here as DoIt or (in the case of 
	evaluation in aContext) DoItIn:. The method is subsequently removed 
	from the class, but this will not get done if the invocation causes an 
	error which is terminated. Such garbage can be removed by executing: 
	Smalltalk allBehaviorsDo: [:cl | cl removeSelector: #DoIt; removeSelector: 
	#DoItIn:]."

	
		^ self evaluate2: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock! !

!ClosureCompiler methodsFor: 'examples' stamp: 'md 10/14/2004 17:47'!
exampleReturn1
	^1! !

!ClosureCompiler methodsFor: 'as yet unclassified' stamp: 'md 11/18/2003 16:18'!
parseClosure: textOrStream in: aClass notifying: req
        "Compile the argument, textOrStream, with respect to the class, aClass, 
        and answer the MethodNode that is the root of the resulting parse tree. 
        Notify the argument, req, if an error occurs. The failBlock is defaulted to 
        an empty block."

        self from: textOrStream class: aClass context: nil notifying: req.
        ^ Parser2 new
                        parse: sourceStream
                        class: class
                        noPattern: false
                        context: context
                        notifying: requestor
                        ifFail: []! !

!ClosureCompiler methodsFor: 'private' stamp: 'md 7/15/2003 12:24'!
parserClass
	^Parser2! !

!Compiler class methodsFor: '*newcompiler-override' stamp: 'md 3/5/2006 17:03'!
closureDecompilerClass
	^FakeDecompiler! !

!Compiler class methodsFor: '*newcompiler-override' stamp: 'md 3/5/2006 17:03'!
closureParserClass
	^Parser2! !

!Compiler class methodsFor: '*newcompiler-override' stamp: 'md 2/27/2006 16:58'!
decompilerClass
	"Answer a decompiler class appropriate for this Compiler."

	^ Preferences compileUseNewCompiler
		ifTrue: [FakeDecompiler]
		ifFalse: [Decompiler]! !

!Compiler class methodsFor: '*newcompiler' stamp: 'md 2/27/2006 16:32'!
initialize

	Preferences
		addPreference: #compileUseNewCompiler
		category: #compiler
		default: false
		balloonHelp: 'If true, the new compiler is used for compiling methods. Only newly compiled methods will be affected by this preference.'
! !

!Compiler class methodsFor: '*newcompiler-override' stamp: 'ajh 1/20/2002 18:57'!
parserClass
	"Return a parser class to use for parsing method headers."

	^ Preferences compileUseNewCompiler
		ifTrue: [Parser2]
		ifFalse: [Parser]! !

!Compiler methodsFor: '*newcompiler-override' stamp: 'md 2/28/2006 15:42'!
compile: textOrStream in: aClass classified: aCategory notifying: aRequestor ifFail: failBlock 
	"Answer a MethodNode for the argument, textOrStream. If the 
	MethodNode can not be created, notify the argument, aRequestor; if 
	aRequestor is nil, evaluate failBlock instead. The MethodNode is the root 
	of a parse tree. It can be told to generate a CompiledMethod to be 
	installed in the method dictionary of the argument, aClass."
	
	| methodNode |
	self from: textOrStream
		class: aClass
		classified: aCategory 
		context: nil
		notifying: aRequestor.
	methodNode := self translate: sourceStream noPattern: false ifFail: failBlock.
	Preferences compileUseNewCompiler ifFalse: [
		methodNode encoder requestor: requestor.
	].
	^methodNode.
! !

!Compiler methodsFor: '*newcompiler' stamp: 'md 6/22/2006 16:12'!
compileDoIt: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock log: log
	"Compiles the sourceStream into a parse tree, then generates code into a method.  This method is then wrapped in a block with the receiver or context as the sole free variable which the method refers to.  If requestor is not nil, then it will receive a notify:at: message if there is a compile error, followed by the failBlock being executed."

	| scope parser blockNode method source |
	source _ textOrStream readStream.
	scope _ aContext
		ifNotNil: [aContext doItScope]
		ifNil: [receiver class parseScope instanceScope].
	parser _ Parser2 new.
	blockNode _ parser
			parse: source
			class: scope
			noPattern: true
			notifying: aRequestor
			ifFail: [^ failBlock value].
	method _ blockNode generate.
	method selector: #DoIt.

	log ifTrue: [
		method putSource: source contents
			fromParseNode: blockNode
			inFile: 2 
			withPreamble: [:file | file cr]].

	^ BlockClosure new
		env: (aContext ifNil: [receiver]);
		method: method;
		yourself! !

!Compiler methodsFor: '*newcompiler' stamp: 'ms 1/7/2007 01:58'!
evaluate2: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag

	^ (self compileDoIt: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: [^ failBlock value] log: logFlag) value! !

!Compiler methodsFor: '*newcompiler-override' stamp: 'ms 1/7/2007 01:56'!
evaluate: textOrStream in: aContext to: receiver notifying: aRequestor ifFail: failBlock logged: logFlag
	"Compiles the sourceStream into a parse tree, then generates code into a method. In other words, if receiver is not nil, then the text can refer to instance variables of that receiver (the Inspector uses this). If aContext is not nil, the text can refer to temporaries in that context (the Debugger uses this). If aRequestor is not nil, then it will receive a notify:at: message before the attempt to evaluate is aborted. Finally, the compiled method is directly invoked without modifying the receiving-class."

	| methodNode method value |
	
  	(Preferences compileUseNewCompiler or: 
			[aContext ifNotNil: [aContext method isClosureCompiled] ifNil: [false]]) ifTrue: 
				[^ self evaluate2: textOrStream 
					    in: aContext 
					    to: receiver 
					    notifying: aRequestor 
					    ifFail: failBlock 
					    logged: logFlag].
	
	class := (aContext isNil 
		ifTrue: [ receiver ] 
		ifFalse: [ aContext receiver ])
			class.
	self from: textOrStream class: class context: aContext notifying: aRequestor.
	methodNode := self 
		translate: sourceStream
		noPattern: true 
		ifFail: [ ^ failBlock value ].
	method := methodNode generate.
	self interactive
		ifTrue: [ method := method copyWithTempNames: methodNode tempNames ].
	value := receiver 
		withArgs: (context isNil
			ifTrue: [ #() ]
			ifFalse: [ Array with: aContext ])
		executeMethod: method.
	logFlag 
		ifTrue: [ SystemChangeNotifier uniqueInstance evaluated: sourceStream contents context: aContext ].
	^ value.! !

!CompiledMethod methodsFor: '*newcompiler' stamp: 'md 2/21/2006 13:57'!
ast
	"Return the node for self"
	self isBlockMethod ifTrue: [^ self blockNode] ifFalse: [^ self methodNode].! !

!CompiledMethod methodsFor: '*newcompiler' stamp: 'md 2/21/2006 13:52'!
blockNode
	"Return the block node for self"

	| homeMethodNode |
	homeMethodNode := self methodNode.
	self isBlockMethod ifFalse: [^ homeMethodNode].

	homeMethodNode ifNil: [^ self decompilerClass new decompileBlock: self].

	homeMethodNode compiledMethod.  "generate method"
	homeMethodNode nodesDo: [:node |
		(node isBlock and:
		 [node scope notNil "not-inlined" and:
		  [node compiledMethod = self]])
			ifTrue: [^ node]
	].

	"node not found, must have been compiled differently (compiler changed)"
	^ self decompilerClass new decompileBlock: self! !

!CompiledMethod methodsFor: '*newcompiler' stamp: 'ajh 3/2/2003 13:51'!
ir

	^ BytecodeDecompiler new decompile: self! !

Object subclass: #BytecodeGenerator
	instanceVariableNames: 'seqOrder orderSeq seqBytes jumps literals lastLiteral currentSeqId currentSeqNum bytes lastSpecialReturn instrMaps instrMap maxTemp stacks stack primNum numArgs properties'
	classVariableNames: 'Bytecodes SpecialSelectors SpecialConstants BytecodeTable'
	poolDictionaries: ''
	category: 'NewCompiler-Bytecodes'!

!BytecodeGenerator commentStamp: 'ajh 5/23/2003 10:59' prior: 0!
I generate bytecodes in response to 'instructions' messages being sent to me.  I rewrite jumps at the end so their jump offsets are correct (see #bytecodes).  For example, to create a compiled method that compares first instVar to first arg and returns 'yes' or 'no' (same example as in IRBuilder), do:

	BytecodeGenerator new
		numArgs: 1;
		pushInstVar: 1;
		pushTemp: 1;
		send: #>;
		if: false goto: #else;
		pushLiteral: 'yes';
		returnTop;
		label: #else;
		pushLiteral: 'no';
		returnTop;
		compiledMethod

You can send #ir to the compiledMethod to decompile to its IRMethod, and you can send #methodNode to either to decompile to its parse tree.
!

!BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:44'!
bytecodeTableFrom: specArray
	"SpecArray is an array of either
	(index selector) or
	(index1 index2 selector)."

	| contiguous |
	Bytecodes _ IdentityDictionary new: 256.
	BytecodeTable _ Array new: 256.
	contiguous _ 0.
	specArray do: [ :spec |
		(spec at: 1) = contiguous ifFalse: [self error: 'Non-contiguous table entry'].
		spec size = 2 ifTrue: [
			Bytecodes at: (spec at: 2) put: (spec at: 1).
			BytecodeTable at: (spec at: 1) + 1 put: (spec at: 2).
			contiguous _ contiguous + 1.
		] ifFalse: [
			spec size = 3 ifFalse: [self error: 'bad spec size'].
			Bytecodes at: (spec at: 3) put: ((spec at: 1) to: (spec at: 2)).
			(spec at: 1) to: (spec at: 2) do: [ :i |
				BytecodeTable at: i + 1 put: (spec at: 3).
			].
			contiguous _ contiguous + ((spec at: 2) - (spec at: 1)) + 1.
		].
	].
	^ BytecodeTable! !

!BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:40'!
initialize

	self initializeBytecodeTable.
	self initializeSpecialSelectors.
	self initializeSpecialConstants.
! !

!BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:42'!
initializeBytecodeTable
	"BytecodeWriteStream initialize"
	"Defines all the bytecode instructions for the Compiler and the Interpreter.
	The following bytecode tuple format is:

	#(bytecode bytecodeSelector)

	bytecodeSelector is the method in the Interpreter that gets executed for the given bytecode.
	Common Send selector position within the specialSelectorsArray is hard code in the Interpreter, see senders of Interpreter specialSelector:."

	^ self bytecodeTableFrom:
	#(
		(  0  15 pushReceiverVariableBytecode)
		( 16  31 pushTemporaryVariableBytecode)
		( 32  63 pushLiteralConstantBytecode)
		( 64  95 pushLiteralVariableBytecode)
		( 96 103 storeAndPopReceiverVariableBytecode)
		(104 111 storeAndPopTemporaryVariableBytecode)
		(112 pushReceiverBytecode)
		(113 pushConstantTrueBytecode)
		(114 pushConstantFalseBytecode)
		(115 pushConstantNilBytecode)
		(116 pushConstantMinusOneBytecode)
		(117 pushConstantZeroBytecode)
		(118 pushConstantOneBytecode)
		(119 pushConstantTwoBytecode)
		(120 returnReceiver)
		(121 returnTrue)
		(122 returnFalse)
		(123 returnNil)
		(124 returnTopFromMethod)
		(125 returnTopFromBlock)
		(126 unknownBytecode)
		(127 unknownBytecode)
		(128 extendedPushBytecode)
		(129 extendedStoreBytecode)
		(130 extendedStoreAndPopBytecode)
		(131 singleExtendedSendBytecode)
		(132 doubleExtendedDoAnythingBytecode)
		(133 singleExtendedSuperBytecode)
		(134 secondExtendedSendBytecode)
		(135 popStackBytecode)
		(136 duplicateTopBytecode)
		(137 pushActiveContextBytecode)
		(138 143 experimentalBytecode)
		(144 151 shortUnconditionalJump)
		(152 159 shortConditionalJump)
		(160 167 longUnconditionalJump)
		(168 171 longJumpIfTrue)
		(172 175 longJumpIfFalse)

		"176-191 were sendArithmeticSelectorBytecode"
		(176 bytecodePrimAdd)
		(177 bytecodePrimSubtract)
		(178 bytecodePrimLessThan)
		(179 bytecodePrimGreaterThan)
		(180 bytecodePrimLessOrEqual)
		(181 bytecodePrimGreaterOrEqual)
		(182 bytecodePrimEqual)
		(183 bytecodePrimNotEqual)
		(184 bytecodePrimMultiply)
		(185 bytecodePrimDivide)
		(186 bytecodePrimMod)
		(187 bytecodePrimMakePoint)
		(188 bytecodePrimBitShift)
		(189 bytecodePrimDiv)
		(190 bytecodePrimBitAnd)
		(191 bytecodePrimBitOr)	

		"192-207 were sendCommonSelectorBytecode"
		(192 bytecodePrimAt)
		(193 bytecodePrimAtPut)
		(194 bytecodePrimSize)
		(195 bytecodePrimNext)
		(196 bytecodePrimNextPut)
		(197 bytecodePrimAtEnd)
		(198 bytecodePrimEquivalent)
		(199 bytecodePrimClass)
		(200 bytecodePrimBlockCopy)
		(201 bytecodePrimValue)
		(202 bytecodePrimValueWithArg)
		(203 bytecodePrimDo)
		(204 bytecodePrimNew)
		(205 bytecodePrimNewWithArg)
		(206 bytecodePrimPointX)
		(207 bytecodePrimPointY)

		(208 255 sendLiteralSelectorBytecode)
	)
! !

!BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:45'!
initializeSpecialConstants

	SpecialConstants _ {true. false. nil. -1. 0. 1. 2}! !

!BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:40'!
initializeSpecialSelectors
	"Create a map from specialSelector -> bytecode offset from sendAdd (the first one)"

	| array |
	SpecialSelectors _ IdentityDictionary new.
	array _ self specialSelectorsArray.  "Smalltalk specialObjectsArray at: 24"
	1 to: array size by: 2 "skip numArgs" do: [:i |
		SpecialSelectors at: (array at: i) put: i - 1 / 2].
! !

!BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/15/2003 15:43'!
specialConstants

	^ SpecialConstants! !

!BytecodeGenerator class methodsFor: 'initialize' stamp: 'ajh 3/6/2003 22:45'!
specialSelectorsArray

	^ #(#+ 1 #- 1 #< 1 #> 1 #<= 1 #>= 1 #= 1 #~= 1 #* 1 #/ 1 #\\ 1 #@ 1 #bitShift: 1 #// 1 #bitAnd: 1 #bitOr: 1 #at: 1 #at:put: 2 #size 0 #next 0 #nextPut: 1 #atEnd 0 #== 1 #class 0 #blockCopy: 1 #value 0 #value: 1 #do: 1 #new 0 #new: 1 #x 0 #y 0)! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/6/2003 22:48'!
addLastLiteral: object

	lastLiteral ifNil: [^ lastLiteral _ object].
	(lastLiteral literalEqual: object)
		ifFalse: [self error: 'there can only be one last literal'].! !

!BytecodeGenerator methodsFor: 'private' stamp: 'kwl 6/25/2006 20:06'!
addLiteral: object

	literals add: object.
	^ literals identityIndexOf: object! !

!BytecodeGenerator methodsFor: 'old style blocks' stamp: 'md 10/8/2004 16:01'!
blockReturnTop

	self saveLastJump: #return.

	self nextPut: (Bytecodes at: #returnTopFromBlock).
! !

!BytecodeGenerator methodsFor: 'results' stamp: 'ajh 5/22/2003 13:06'!
bytecodes

	| stream |
	[ orderSeq
		inject: false
		into: [:changed :seqId | (self updateJump: seqId) | changed]
	] whileTrue.

	stream _ (ByteArray new: 100) writeStream.
	orderSeq do: [:seqId |
		(instrMaps at: seqId) do: [:assoc |
			assoc key "instr" bytecodeIndex: stream position + assoc value.
		].
		stream nextPutAll: (seqBytes at: seqId).
	].
	^ stream contents! !

!BytecodeGenerator methodsFor: 'results' stamp: 'md 2/21/2006 14:14'!
compiledMethod

	^ self compiledMethodWith: #(0 0 0 0)! !

!BytecodeGenerator methodsFor: 'results' stamp: 'pmm 8/16/2006 20:51'!
compiledMethodWith: trailer
	^self compiledMethodWith: trailer using: CompiledMethod! !

!BytecodeGenerator methodsFor: 'results' stamp: 'pmm 8/16/2006 20:51'!
compiledMethodWith: trailer using: aCompiledMethodClass
	| cm |
	cm := (aCompiledMethodClass
		primitive: (self primNum > 0
			ifTrue: [self primNum]
			ifFalse: [self quickMethodPrim])
		numArgs: self numArgs
		numTemps: (self numTemps max: self numArgs)
		stackSize: self stackSize
		literals: self literals
		bytecodes: self bytecodes
		trailer: trailer).
	cm isClosureCompiled: Preferences compileBlocksAsClosures.
	cm properties: self properties.
	^cm.! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 13:00'!
from: fromSeqId goto: toSeqId

	| distance from to |
	from _ seqOrder at: fromSeqId.
	to _ seqOrder at: toSeqId ifAbsent: [^ self].
	from + 1 = to ifTrue: [^ self].  "fall through, no jump needed"

	from < to ifTrue: [ "jump forward"
		distance _ (from + 1 to: to - 1) inject: 0 into: [:size :i | 
				size + (seqBytes at: (orderSeq at: i)) size].
		self jumpForward: distance.
	] ifFalse: [ "jump backward"
		distance _ ((to to: from - 1) inject: 0 into: [:size :i |
				size + (seqBytes at: (orderSeq at: i)) size])
			+ bytes size.
		self jumpBackward: distance.
	].
! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 13:22'!
from: fromSeqId if: bool goto: toSeqId otherwise: otherwiseSeqId

	| distance from to otherwise |
	from _ seqOrder at: fromSeqId.
	to _ seqOrder at: toSeqId ifAbsent: [^ self jump: 0 if: bool].  "not done yet"
	otherwise _ seqOrder at: otherwiseSeqId ifAbsent: [^ self jump: 0 if: bool].  "not done yet"
	from < to ifFalse: [self errorConditionalJumpBackwards].
	from + 1 = otherwise ifFalse: [self errorFallThroughSequenceNotNext].
	distance _ (from + 1 to: to - 1)
		inject: 0
		into: [:size :i | size + (seqBytes at: (orderSeq at: i)) size].
	self jump: distance if: bool.
! !

!BytecodeGenerator methodsFor: 'old style blocks' stamp: 'md 10/8/2004 16:01'!
fromBlock: curId goto: seqId

	| distance from to |

	from _ seqOrder at: curId.
	to _ seqOrder at: seqId ifAbsent: [^ self].
	distance _ (from + 1 to: to - 1) inject: 0 into: [:size :i | 
				size + (seqBytes at: (orderSeq at: i)) size].
	distance > 1023 ifTrue: [self error: 'forward jump too big'].
	self nextPut: (Bytecodes at: #longUnconditionalJump) first + (distance // 256) + 4.
	self nextPut: distance \\ 256.! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 12:22'!
goto: seqId

	stacks at: seqId put: (stack linkTo: (stacks at: seqId ifAbsentPut: [nil])).

	self saveLastJump: (Message
		selector: #from:goto:
		arguments: {currentSeqId. seqId}).
	self from: currentSeqId goto: seqId.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 13:26'!
if: bool goto: seqId

	| otherwiseSeqId |
	otherwiseSeqId _ self newDummySeqId.
	self if: bool goto: seqId otherwise: otherwiseSeqId.
	self label: otherwiseSeqId.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 12:26'!
if: bool goto: seqId1 otherwise: seqId2

	stack pop.
	stacks at: seqId1 put: (stack linkTo: (stacks at: seqId1 ifAbsentPut: [nil])).
	stacks at: seqId2 put: (stack linkTo: (stacks at: seqId2 ifAbsentPut: [nil])).

	self saveLastJump: (Message
		selector: #from:if:goto:otherwise:
		arguments: {currentSeqId. bool. seqId1. seqId2}).
	self from: currentSeqId if: bool goto: seqId1 otherwise: seqId2.
! !

!BytecodeGenerator methodsFor: 'initialize' stamp: 'md 2/21/2006 14:27'!
initialize

	literals _ LiteralList new.
	"The following dicts are keyed by sequence id given by client in label: (and gotos)."
	seqOrder _ IdentityDictionary new.  "seqId -> seq order num"
	seqBytes _ IdentityDictionary new.  "seqId -> seq bytecodes"
	jumps _ IdentityDictionary new.  "seqId -> last jump instr"
	instrMaps _ IdentityDictionary new.  "seqId -> (clientInstr -> bytecode pos)"
	stacks _ IdentityDictionary new.  "seqId -> stackCount"
	maxTemp _ 0.
	primNum _ 0.
	numArgs _ 0.
	currentSeqNum _ 0.
	orderSeq _ OrderedCollection new.  "reverse map of seqOrder"

	"starting label in case one is not provided by client"
	self label: self newDummySeqId.
! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/24/2003 17:48'!
jump: distance if: condition

	| hi |
	distance = 0 ifTrue: [
		"jumps to fall through, no-op"
		^ self nextPut: (Bytecodes at: #popStackBytecode)].
	condition ifTrue: [
		hi _ distance // 256.
		hi < 8 ifFalse: [self error: 'true jump too big'].
		self nextPut: (Bytecodes at: #longJumpIfTrue) first + hi.
		self nextPut: distance \\ 256.
	] ifFalse: [
		distance <= 8 ifTrue: [
			self nextPut: (Bytecodes at: #shortConditionalJump) first + distance - 1.
		] ifFalse: [
			hi _ distance // 256.
			hi < 8 ifFalse: [self error: 'false jump too big'].
			self nextPut: (Bytecodes at: #longJumpIfFalse) first + hi.
			self nextPut: distance \\ 256.
		].
	]	
! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 7/19/2004 12:12'!
jumpBackward: distance

	| dist |
	distance = 0 ifTrue: [^ self].  "no-op"
	dist _ 1024 - distance - 2.
	dist < 0 ifTrue: [self error: 'back jump too big'].
	self nextPut: (Bytecodes at: #longUnconditionalJump) first + (dist // 256).
	self nextPut: dist \\ 256.
! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/24/2003 17:46'!
jumpForward: distance

	distance = 0 ifTrue: [^ self].  "no-op"
	distance <= 8 ifTrue: [
		self nextPut: (Bytecodes at: #shortUnconditionalJump) first + distance - 1.
	] ifFalse: [
		distance > 1023 ifTrue: [self error: 'forward jump too big'].
		self nextPut: (Bytecodes at: #longUnconditionalJump) first + (distance // 256) + 4.
		self nextPut: distance \\ 256.
	].
! !

!BytecodeGenerator methodsFor: 'old style blocks' stamp: 'md 10/8/2004 16:01'!
jumpOverBlock: seqId

	stacks at: seqId put: (stack linkTo: (stacks at: seqId ifAbsentPut: [nil])).
	
	
	self saveLastJump: (Message
		selector: #fromBlock:goto:
		arguments: {currentSeqId. seqId}).
	
	self fromBlock: currentSeqId goto: seqId.! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'md 10/6/2005 16:51'!
label: seqId

	(currentSeqId notNil and: [(jumps at: currentSeqId) isNil]) ifTrue: [
		"make previous implicit goto explicit"
		self goto: seqId.
	].

	lastSpecialReturn := nil.
	currentSeqId := seqId.
	currentSeqNum := currentSeqNum + 1.
	seqOrder at: seqId put: currentSeqNum.
	orderSeq at: currentSeqNum ifAbsentPut: [seqId].
	bytes := seqBytes at: seqId ifAbsentPut: [OrderedCollection new].
	jumps at: seqId ifAbsentPut: [nil].
	instrMap := instrMaps at: seqId ifAbsentPut: [OrderedCollection new].
	stack := stacks at: seqId ifAbsentPut: [StackCount new].
! !

!BytecodeGenerator methodsFor: 'results' stamp: 'md 2/21/2006 14:14'!
literals

	literals := literals asArray copyWith: MethodProperties new.

	^ lastLiteral 
		ifNil: [literals copyWith: nil ] 
		ifNotNil: [literals copyWith: lastLiteral]! !

!BytecodeGenerator methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:00'!
mapBytesTo: instr
	"Associate next byte with instr"

	instrMap add: instr -> (bytes size + 1)! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 13:28'!
newDummySeqId

	^ Object new! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 3/13/2003 13:00'!
nextPut: byte

	bytes add: byte! !

!BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:27'!
numArgs

	^ numArgs! !

!BytecodeGenerator methodsFor: 'initialize' stamp: 'ajh 3/13/2003 18:21'!
numArgs: n

	numArgs _ n! !

!BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:03'!
numTemps

	^ maxTemp! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:48'!
popTop

	stack pop.

	self nextPut: (Bytecodes at: #popStackBytecode).
! !

!BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:27'!
primNum

	^ primNum! !

!BytecodeGenerator methodsFor: 'initialize' stamp: 'ajh 3/13/2003 18:21'!
primitiveNode: aPrimitiveNode

	literals isEmpty ifFalse: [self error: 'init prim before adding instructions'].
	aPrimitiveNode spec ifNotNil: [literals add: aPrimitiveNode spec].
	primNum _ aPrimitiveNode num.
! !

!BytecodeGenerator methodsFor: 'accessing' stamp: 'md 7/12/2006 16:40'!
properties
	^ properties ifNil: [ properties := MethodProperties new ].! !

!BytecodeGenerator methodsFor: 'accessing' stamp: 'md 7/10/2005 22:21'!
properties: propDict
	properties := propDict.! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:48'!
pushDup

	stack push.

	self nextPut: (Bytecodes at: #duplicateTopBytecode).
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:49'!
pushInstVar: instVarIndex

	| interval |
	stack push.

	interval _ Bytecodes at: #pushReceiverVariableBytecode.
	instVarIndex <= interval size ifTrue: [
		^ self nextPut: (interval at: instVarIndex).
	].
	instVarIndex <= 64 ifTrue: [
		self nextPut: (Bytecodes at: #extendedPushBytecode).
		^ self nextPut: (0 "instVar" << 6) + instVarIndex - 1.
	].
	instVarIndex <= 256 ifFalse: [self error: 'can''t reference more than 256 inst vars'].
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 2 "pushInstVar" << 5.
	self nextPut: instVarIndex - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'kwl 6/25/2006 19:56'!
pushLiteral: object

	| index interval |
	stack push.

	(index _ SpecialConstants identityIndexOf: object ifAbsent: 0) > 0 ifTrue: [
		^ self nextPut: (Bytecodes at: #pushConstantTrueBytecode) + index - 1].

	(index _ literals literalIndexOf: object ifAbsent: 0) > 0 ifFalse: [
		index _ self addLiteral: object].

	interval _ Bytecodes at: #pushLiteralConstantBytecode.
	(index <= interval size) ifTrue: [
		^ self nextPut: (interval at: index)
	].
	index <= 64 ifTrue: [
		self nextPut: (Bytecodes at: #extendedPushBytecode).
		^ self nextPut: 2 "lit constant" << 6 + index - 1
	].
	index > 256 ifTrue: [self error: 'too many literals (>256)'].
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 3 "lit constant" << 5.
	self nextPut: index - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'kwl 6/25/2006 19:58'!
pushLiteralVariable: object

	| index interval |
	stack push.

	object isVariableBinding
		ifFalse: [self error: 'not a literal variable'].

	(index _ literals literalIndexOf: object ifAbsent: 0) > 0 ifFalse: [
		index _ self addLiteral: object].

	interval _ Bytecodes at: #pushLiteralVariableBytecode.
	(index <= interval size) ifTrue: [
		^ self nextPut: (interval at: index)
	].
	index <= 64 ifTrue: [
		self nextPut: (Bytecodes at: #extendedPushBytecode).
		^ self nextPut: 3 "literal variable" << 6 + index - 1
	].
	index > 256 ifTrue: [self error: 'too many literals (>256)'].
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 1 "lit variable" << 7.
	self nextPut: index - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:50'!
pushReceiver

	stack push.

	self nextPut: (Bytecodes at: #pushReceiverBytecode)! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:51'!
pushTemp: index

	| interval |
	stack push.
	maxTemp _ index max: maxTemp.

	interval _ Bytecodes at: #pushTemporaryVariableBytecode.
	index <= interval size ifTrue: [
		^ self nextPut: (interval at: index).
	].
	index <= 64 ifFalse: [self error: 'too many temp vars (>64)'].
	self nextPut: (Bytecodes at: #extendedPushBytecode).
	self nextPut: (1 "temp" << 6) + index - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 17:51'!
pushThisContext

	stack push.

	self nextPut: (Bytecodes at: #pushActiveContextBytecode).
! !

!BytecodeGenerator methodsFor: 'results' stamp: 'md 10/6/2005 16:50'!
quickMethodPrim

	| i |
	self numArgs = 0 ifFalse: [^ 0].
	lastSpecialReturn ifNil: [^ 0].
	(seqBytes  size <= 2) ifFalse: [^ 0].
	"seqBytes  size = 1 ifFalse: [^ 0]."
	^ lastSpecialReturn selector caseOf: {
		[#returnReceiver] -> [256].
		[#returnConstant:] -> [
			(i := SpecialConstants indexOf: lastSpecialReturn argument) > 0
				ifTrue: [256 + i] ifFalse: [0]].
		[#returnInstVar:] -> [263 + lastSpecialReturn argument]
	  }! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 7/2/2004 13:44'!
remoteReturn

	self saveLastJump: #return.

	self send: #privRemoteReturnTo:.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'md 7/19/2005 23:11'!
returnConstant: obj

	self saveLastJump: #return.
	
	bytes size = 0 ifTrue: [
		lastSpecialReturn := Message selector: #returnConstant: argument: obj].
 	
	obj caseOf: {
		[true] -> [self nextPut: (Bytecodes at: #returnTrue)].
		[false] -> [self nextPut: (Bytecodes at: #returnFalse)].
		[nil] -> [self nextPut: (Bytecodes at: #returnNil)]
	} otherwise: [
		self pushLiteral: obj.
		self returnTop.
	]
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'md 7/19/2005 23:29'!
returnInstVar: index

	self saveLastJump: #return.
	
	bytes size = 0 ifTrue: [
		lastSpecialReturn := Message selector: #returnInstVar: argument: index].

	self pushInstVar: index.
	self returnTop.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:02'!
returnReceiver

	self saveLastJump: #return.

	bytes size = 0 ifTrue: [
		lastSpecialReturn _ Message selector: #returnReceiver].

	self nextPut: (Bytecodes at: #returnReceiver).
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 5/22/2003 14:02'!
returnTop

	self saveLastJump: #return.

	self nextPut: (Bytecodes at: #returnTopFromMethod).
! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 5/22/2003 12:23'!
saveLastJump: message

	jumps at: currentSeqId put: {bytes size. message}.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/16/2003 14:43'!
send: selector

	| index nArgs |
	nArgs _ selector numArgs.
	stack pop: nArgs.

	SpecialSelectors at: selector ifPresent: [:i |
		^ self nextPut: (Bytecodes at: #bytecodePrimAdd) + i].

	index _ self addLiteral: selector.
	(index <= 16 and: [nArgs <= 2]) ifTrue: [
		"short send"
		^ self nextPut: (Bytecodes at: #sendLiteralSelectorBytecode) first + (nArgs * 16) + index - 1
	].
	(index <= 32 and: [nArgs <= 7]) ifTrue: [
		"extended (2-byte) send"
		self nextPut: (Bytecodes at: #singleExtendedSendBytecode).
		^ self nextPut: nArgs * 32 + index - 1
	].
	(index <= 64 and: [nArgs <= 3]) ifTrue: [
		"new extended (2-byte)"
		self nextPut: (Bytecodes at: #secondExtendedSendBytecode).
		^ self nextPut: nArgs * 64 + index - 1
	].
	"long (3-byte) send"
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: nArgs.
	self nextPut: index - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'md 2/27/2006 17:03'!
send: selector toSuperOf: behavior

	| index nArgs |
	nArgs := selector numArgs.
	stack pop: nArgs.

	self addLastLiteral: behavior binding.  
	index := self addLiteral: selector.
	(index <= 32 and: [nArgs <= 7]) ifTrue: [
		"extended (2-byte) send"
		self nextPut: (Bytecodes at: #singleExtendedSuperBytecode).
		^ self nextPut: nArgs * 32 + index - 1
	].
	"long (3-byte) send"
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 1 << 5 "super" + nArgs.
	self nextPut: index - 1.
! !

!BytecodeGenerator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:03'!
stackSize

	^ (stacks collect: [:s | s length]) max! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 20:36'!
storeInstVar: index

	index <= 64 ifTrue: [
		self nextPut: (Bytecodes at: #extendedStoreBytecode).
		^ self nextPut: (0 "instVar" << 6) + index - 1.
	].
	index <= 256 ifFalse: [self error: 'can''t reference more than 256 inst vars'].
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 5 "storeInstVar" << 5.
	self nextPut: index - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'md 10/4/2005 17:42'!
storeIntoLiteralVariable: object

	| index |
	
	index := self addLiteral: object.   

	index <= 64 ifTrue: [
		self nextPut: (Bytecodes at: #extendedStoreBytecode).
		^ self nextPut: (3 "instVar" << 6) + index - 1.
	].
	index <= 256 ifFalse: [self error: 'can''t reference more than 256 inst vars'].
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 7 "storeLiteralVar" << 5.
	self nextPut: index - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 18:00'!
storePopInstVar: index

	| interval |
	stack pop.

	interval _ Bytecodes at: #storeAndPopReceiverVariableBytecode.
	index <= interval size ifTrue: [
		^ self nextPut: (interval at: index)
	].
	index <= 64 ifTrue: [
		self nextPut: (Bytecodes at: #extendedStoreAndPopBytecode).
		^ self nextPut: (0 "instVar" << 6) + index - 1.
	].
	index <= 256 ifFalse: [
		self error: 'can''t reference more than 256 inst vars'].
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 6 "storePopInstVar" << 5.
	self nextPut: index - 1.
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ms 12/3/2006 20:17'!
storePopIntoLiteralVariable: assoc

	| index |
	
	index := self addLiteral: assoc.
	
	index <= 64 ifTrue: [
		stack pop.
		self nextPut: (Bytecodes at: #extendedStoreAndPopBytecode).
		^ self nextPut: (3 "temp" << 6) + index - 1.
	].
	index <= 256 ifFalse: [self error: 'can''t reference more than 256 inst vars'].
	self nextPut: (Bytecodes at: #doubleExtendedDoAnythingBytecode).
	self nextPut: 7 "storeLiteralVar" << 5.
	self nextPut: index - 1.
	self popTop
! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 18:01'!
storePopTemp: index

	| interval |
	stack pop.
	maxTemp _ index max: maxTemp.

	interval _ Bytecodes at: #storeAndPopTemporaryVariableBytecode.
	index <= interval size ifTrue: [
		^ self nextPut: (interval at: index)
	].
	index <= 64 ifTrue: [
		self nextPut: (Bytecodes at: #extendedStoreAndPopBytecode).
		^ self nextPut: (1 "temp" << 6) + index - 1.
	].
	self error: 'too many temps (>64)'! !

!BytecodeGenerator methodsFor: 'instructions' stamp: 'ajh 3/13/2003 18:01'!
storeTemp: index

	maxTemp _ index max: maxTemp.

	index <= 64 ifFalse: [self error: 'too many temps (>64)'].
	self nextPut: (Bytecodes at: #extendedStoreBytecode).
	self nextPut: (1 "temp" << 6) + index - 1.
! !

!BytecodeGenerator methodsFor: 'private' stamp: 'ajh 6/22/2003 14:41'!
updateJump: seqId
	"Recalculate final jump bytecodes.  Return true if jump bytecodes SIZE has changed, otherwise return false"

	| pair s1 |
	pair _ jumps at: seqId.
	pair last == #return ifTrue: [^ false].  "no jump, a return"
	bytes _ seqBytes at: seqId.
	s1 _ bytes size.
	bytes removeLast: (bytes size - pair first).
	pair last sendTo: self.
	^ s1 ~= bytes size! !

Object subclass: #ClosureCompiledObject
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Standalone'!

!ClosureCompiledObject class methodsFor: 'compiling' stamp: 'md 11/23/2005 11:49'!
compile: code classified: cat notifying: requestor trailer: bytes ifFail: failBlock
	"Compile code without logging the source in the changes file"

	| methodNode |
	methodNode  := self compilerClass new
				compile: code
				in: self
				classified: category 
				notifying: requestor
				ifFail: failBlock.
	^ CompiledMethodWithNode generateMethodFromNode: methodNode trailer: bytes.! !

!ClosureCompiledObject class methodsFor: 'compiling' stamp: 'md 7/16/2003 15:57'!
compilerClass
	^ClosureCompiler! !

Object subclass: #ClosureRuntimeStats
	instanceVariableNames: 'envCreationCount closureCreationCount closureCallCount milliseconds sendsPerSecond testName newObjectCount'
	classVariableNames: 'Tests StartTime OldTests'
	poolDictionaries: ''
	category: 'NewCompiler-Extras'!

!ClosureRuntimeStats commentStamp: 'ajh 5/21/2004 17:39' prior: 0!
Count the number of closure creations and calls while executing a given block.

 ClosureRuntimeStats on.
 ClosureRuntimeStats off inspect.

 (Closure measure: [...]) inspect.

 ClosureRuntimeStats testResults asArray.
 (ClosureRuntimeStats testResults allButFirst
	inject: ClosureRuntimeStats testResults first
	into: [:agg :stat | agg + stat])
	testName: 'Aggregate'
!

!ClosureRuntimeStats class methodsFor: 'tracing methods' stamp: 'ajh 7/1/2004 17:32'!
blockClosureNew

	ClosureCreationCount _ ClosureCreationCount + 1.

	^ self basicNew! !

!ClosureRuntimeStats class methodsFor: 'tracing methods' stamp: 'ajh 7/1/2004 17:32'!
envNew: size

	| array n |
	array _ EnvCreationCount.
	n _ size + 1.
	array at: n put: (array at: n) + 1.

	^ self basicNew: size! !

!ClosureRuntimeStats class methodsFor: 'initialize' stamp: 'ajh 7/1/2004 15:28'!
initCounters

	Smalltalk at: #ClosureCreationCount put: 0.
	
	"indexed by number of free vars"
	Smalltalk at: #EnvCreationCount put: (Array new: 100 withAll: 0).
	Smalltalk at: #ClosureCallCount put: (Array new: 100 withAll: 0).
	
	Smalltalk at: #NewObjectCount put: 0.

	StartTime _ Time millisecondClockValue.
! !

!ClosureRuntimeStats class methodsFor: 'initialize' stamp: 'ajh 5/21/2004 13:43'!
initialize

	Tests _ OrderedCollection new.
	self initCounters.
! !

!ClosureRuntimeStats class methodsFor: 'initialize' stamp: 'ajh 5/21/2004 16:06'!
installCountObjectMethods

	{{Behavior. #primBasicNew. #primBasicNew}.
	 {Behavior. #primBasicNew:. #primBasicNew:}.
	 {Behavior. #basicNew. #traceBasicNew}.
	 {Behavior. #basicNew:. #traceBasicNew:}
	} do: [:triple |
		triple first
			addSelectorSilently: triple second
			withMethod: (self class compiledMethodAt: triple third)].

	self installTracingMethods.
! !

!ClosureRuntimeStats class methodsFor: 'initialize' stamp: 'ajh 7/1/2004 15:20'!
installOriginalMethods

	{{BlockClosure. #valueWithArguments:. #primValueWithArguments:}.
	} do: [:triple |
		triple first
			addSelectorSilently: triple second
			withMethod: (self class compiledMethodAt: triple third)].

	{{ClosureEnvironment class. #new:}.
	 {BlockClosure class. #new}.
	 {BlockClosure. #primValueWithArguments:}.
	} do: [:pair |
		pair first removeSelectorSimply: pair second].
! !

!ClosureRuntimeStats class methodsFor: 'initialize' stamp: 'ajh 5/21/2004 16:06'!
installOriginalObjectMethods

	{{Behavior. #basicNew. #primBasicNew}.
	 {Behavior. #basicNew:. #primBasicNew:}
	} do: [:triple |
		triple first
			addSelectorSilently: triple second
			withMethod: (self class compiledMethodAt: triple third)].

	{{Behavior. #primBasicNew}.
	 {Behavior. #primBasicNew:}
	} do: [:pair |
		pair first removeSelectorSimply: pair second].

	self installOriginalMethods.
! !

!ClosureRuntimeStats class methodsFor: 'initialize' stamp: 'ajh 7/1/2004 15:06'!
installTracingMethods

	{{BlockClosure class. #new. #blockClosureNew}.
	 {BlockClosure. #primValueWithArguments:. #primValueWithArguments:}.
	 {BlockClosure. #valueWithArguments:. #valueWithArguments:}.
	 {ClosureEnvironment class. #new:. #envNew:}.
	} do: [:triple |
		triple first
			addSelectorSilently: triple second
			withMethod: (self class compiledMethodAt: triple third)].

	self initCounters.
! !

!ClosureRuntimeStats class methodsFor: 'run' stamp: 'ajh 5/21/2004 00:05'!
measure: block

	self on.
	block value.
	^ self off
! !

!ClosureRuntimeStats class methodsFor: 'run' stamp: 'ajh 5/21/2004 16:07'!
off

	| stats |
	stats _ self new copyResults.
	self installOriginalObjectMethods.
	stats sendsPerSecond: 0 tinyBenchmarks.
	^ stats! !

!ClosureRuntimeStats class methodsFor: 'run' stamp: 'ajh 5/21/2004 16:06'!
on

	self installCountObjectMethods.
! !

!ClosureRuntimeStats class methodsFor: 'original methods' stamp: 'ajh 5/21/2004 15:48'!
primBasicNew
	"Primitive. Answer an instance of the receiver (which is a class) with no 
	indexable variables. Fail if the class is indexable. Essential. See Object 
	documentation whatIsAPrimitive."

	<primitive: 70>
	self isVariable ifTrue: [ ^ self basicNew: 0 ].
	"space must be low"
	self environment signalLowSpace.
	^ self basicNew  "retry if user proceeds"
! !

!ClosureRuntimeStats class methodsFor: 'original methods' stamp: 'ajh 5/21/2004 15:49'!
primBasicNew: sizeRequested 
	"Primitive. Answer an instance of this class with the number
	of indexable variables specified by the argument, sizeRequested.
	Fail if this class is not indexable or if the argument is not a
	positive Integer, or if there is not enough memory available. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 71>
	self isVariable ifFalse:
		[self error: self printString, ' cannot have variable sized instances'].
	(sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue:
		["arg okay; space must be low."
		self environment signalLowSpace.
		^ self basicNew: sizeRequested  "retry if user proceeds"].
	self primitiveFailed! !

!ClosureRuntimeStats class methodsFor: 'original methods' stamp: 'ajh 7/1/2004 17:19'!
primValueWithArguments: anArray 
	"Primitive. Evaluate the block represented by the receiver. The argument 
	is an Array whose elements are the arguments for the block. Fail if the 
	length of the Array is not the same as the the number of arguments that 
	the block was expecting. Fail if the block is already being executed. 
	Essential. See Object documentation whatIsAPrimitive."

	"<primitive: 187>"
	^ self env withArgs: anArray executeMethod: self method! !

!ClosureRuntimeStats class methodsFor: 'tests' stamp: 'ajh 5/21/2004 13:57'!
testResults
	"Collection of previously run test results"

	^ Tests! !

!ClosureRuntimeStats class methodsFor: 'tracing methods' stamp: 'ajh 5/21/2004 15:49'!
traceBasicNew

	NewObjectCount _ NewObjectCount + 1.

	^ self primBasicNew! !

!ClosureRuntimeStats class methodsFor: 'tracing methods' stamp: 'ajh 5/21/2004 15:49'!
traceBasicNew: size

	NewObjectCount _ NewObjectCount + 1.

	^ self primBasicNew: size! !

!ClosureRuntimeStats class methodsFor: 'tracing methods' stamp: 'ajh 7/1/2004 18:00'!
valueWithArguments: args

	| n array e |
	e _ self env.
	n _ e class == ClosureEnvironment
		ifTrue: [e size]
		ifFalse: [1].
	n _ n + 1.
	(array _ ClosureCallCount) at: n put: (array at: n) + 1.

	^ self primValueWithArguments: args! !

!ClosureRuntimeStats methodsFor: 'arithmetic' stamp: 'ajh 7/1/2004 15:33'!
+ stat

	| agg |
	(stat isKindOf: self class) ifFalse: [self error: 'can''t add stats'].

	agg _ self class basicNew.
	#(envCreationCount closureCreationCount closureCallCount milliseconds) do: [:var |
		agg instVarNamed: var put:
			(self instVarNamed: var) + (stat instVarNamed: var)].
	^ agg! !

!ClosureRuntimeStats methodsFor: 'as yet unclassified' stamp: 'ajh 5/21/2004 15:00'!
closureCallsPerSecond

	^ ((closureCallCount first: 6) / (milliseconds / 1000)) truncated! !

!ClosureRuntimeStats methodsFor: 'as yet unclassified' stamp: 'ajh 7/1/2004 15:35'!
closureCreationPerSecond

	^ (closureCreationCount / (milliseconds / 1000)) truncated! !

!ClosureRuntimeStats methodsFor: 'as yet unclassified' stamp: 'ajh 7/1/2004 15:33'!
copyResults

	milliseconds _ Time millisecondClockValue - StartTime.
	envCreationCount _ EnvCreationCount.
	closureCreationCount _ ClosureCreationCount.
	closureCallCount _ ClosureCallCount.

	newObjectCount _ NewObjectCount.
! !

!ClosureRuntimeStats methodsFor: 'as yet unclassified' stamp: 'ajh 7/1/2004 15:34'!
envCreationPerSecond

	^ ((envCreationCount first: 6) / (milliseconds / 1000)) truncated! !

!ClosureRuntimeStats methodsFor: 'printing' stamp: 'ajh 7/1/2004 18:03'!
longPrintOn: stream

	stream print: testName; cr; cr.

	stream nextPutAll: 'New objects per sec: '.
	stream print: self newObjectsPerSecond; cr; cr.

	stream nextPutAll: 'New envs per sec: '.
	stream print: self envCreationPerSecond sum; cr.
	stream nextPutAll: 'by num free vars: '.
	stream print: self envCreationPerSecond; cr; cr.

	stream nextPutAll: 'New closures per sec: '.
	stream print: self closureCreationPerSecond; cr; cr.

	stream nextPutAll: 'Closure calls per sec: '.
	stream print: self closureCallsPerSecond sum; cr.
	stream nextPutAll: 'by num free vars: '.
	stream print: self closureCallsPerSecond; cr; cr.

	stream nextPutAll: self sendsPerSecond; cr.
! !

!ClosureRuntimeStats methodsFor: 'as yet unclassified' stamp: 'ajh 5/21/2004 16:09'!
newObjectsPerSecond

	^ (newObjectCount / (milliseconds / 1000)) truncated! !

!ClosureRuntimeStats methodsFor: 'printing' stamp: 'ajh 5/21/2004 13:45'!
printOn: stream

	stream print: self class; space.
	stream print: testName.
! !

!ClosureRuntimeStats methodsFor: 'as yet unclassified' stamp: 'ajh 5/21/2004 13:54'!
sendsPerSecond

	^ sendsPerSecond ifNil: [sendsPerSecond _ 0 tinyBenchmarks]! !

!ClosureRuntimeStats methodsFor: 'accessing' stamp: 'ajh 5/21/2004 14:03'!
sendsPerSecond: string

	sendsPerSecond _ string! !

!ClosureRuntimeStats methodsFor: 'printing' stamp: 'ajh 5/21/2004 13:58'!
testName
	"Just for documentation to distinguish multiple instances"

	^ testName! !

!ClosureRuntimeStats methodsFor: 'printing' stamp: 'ajh 5/21/2004 11:45'!
testName: name
	"Just to document for when you have multiple instances"

	testName _ name! !

Object subclass: #ClosureStaticStats
	instanceVariableNames: 'methodsByEmbeddedBlocks blocksByFreeVars homeFunctionsByEscapingEnvs problemMethods'
	classVariableNames: 'LastStats'
	poolDictionaries: ''
	category: 'NewCompiler-Extras'!

!ClosureStaticStats commentStamp: 'ajh 5/21/2004 14:52' prior: 0!
After recompiling the image under the new closure compiler (using Recompiler), use this to find distribution of:
number of closures per method,
number of free vars per closure.
number of indirect free vars per closure.
number of indirect temp vars per method with closure(s).
number of indirect temp vars per method.

 ClosureStaticStats new run inspect.

 ClosureStaticStats lastStats.
!

!ClosureStaticStats class methodsFor: 'as yet unclassified' stamp: 'ajh 5/20/2004 02:20'!
lastStats

	^ LastStats! !

!ClosureStaticStats methodsFor: 'as yet unclassified' stamp: 'ajh 5/20/2004 02:18'!
allMethodsDo: methodBlock

	| count |
	count _ 0.
	Smalltalk allClassesDo: [:class | count _ count +
		({class. class class} collect: [:behavior |
			behavior methodDictionary size]) sum].
	
	'Checking ', count printString, ' methods'
		displayProgressAt: Sensor cursorPoint from: 0 to: count
		during: [:bar | | m | m _ 0.
			Smalltalk allClassesDo: [:class |
				{class. class class} do: [:behavior |
					behavior methodDictionary do: [:meth |
						methodBlock value: meth.
						bar value: (m _ m + 1)]]]].
! !

!ClosureStaticStats methodsFor: 'as yet unclassified' stamp: 'ajh 7/1/2004 10:47'!
initBags

	methodsByEmbeddedBlocks _ Bag new.
	blocksByFreeVars _ Bag new.
	homeFunctionsByEscapingEnvs _ Bag new.

	problemMethods _ OrderedCollection new.
! !

!ClosureStaticStats methodsFor: 'printing' stamp: 'ajh 7/1/2004 10:47'!
longPrintOn: stream

	| list |
	list _ [:bag | (0 to: 9) collect: [:i | bag valuesAndCounts at: i ifAbsent: [0]]].

	stream nextPutAll: 'Methods: '.
	stream print: methodsByEmbeddedBlocks size; cr.
	stream nextPutAll: 'by num closures: '.
	stream print: (list value: methodsByEmbeddedBlocks); cr; cr.

	stream nextPutAll: 'Home methods/blocks: '.
	stream print: homeFunctionsByEscapingEnvs size; cr.
	stream nextPutAll: 'by having own env: '.
	stream print: (list value: homeFunctionsByEscapingEnvs); cr; cr.

	stream nextPutAll: 'Closures: '.
	stream print: blocksByFreeVars size; cr.
	stream nextPutAll: 'by num free vars: '.
	stream print: (list value: blocksByFreeVars); cr.
! !

!ClosureStaticStats methodsFor: 'running' stamp: 'ajh 7/8/2004 19:19'!
run
	"scan all methods collecting stats"

	self initBags.
	self allMethodsDo: [:meth |
		| blockMeths |
		blockMeths _ meth allEmbeddedBlockMethods.
		methodsByEmbeddedBlocks add: blockMeths size.
		blockMeths size > 0 ifTrue: [
			homeFunctionsByEscapingEnvs add: meth ast scope hasEscapingEnv asBit].
		[blockMeths do: [:bm | | ast |
			ast _ bm ast.
			bm containsBlockClosures ifTrue: [
				homeFunctionsByEscapingEnvs add: ast scope hasEscapingEnv asBit].
			blocksByFreeVars add: ast freeVars size.
		]] on: Error do: [problemMethods add: meth].
	].
	LastStats _ self.
! !

Object subclass: #Decompiler2
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Bytecodes'!

!Decompiler2 commentStamp: 'ajh 3/25/2003 00:28' prior: 0!
This mirrors the old Decompiler interface delegating the real work to BytecodeDecompiler then IRDecompiler.!

!Decompiler2 methodsFor: 'compiling' stamp: 'ajh 3/13/2003 21:09'!
decompile: aMethod
	"Answer a MethodNode that is the root of the parse tree for the argument, aMethod.  Selector will be 'unknown' and inst vars will be 'instVarN'.  selector and class can be placed in resulting MethodNode later"

	^self
		decompile: nil
		in: nil
		method: aMethod
! !

!Decompiler2 methodsFor: 'public access' stamp: 'ajh 3/13/2003 21:09'!
decompile: aSelector in: aClass 
	"See Decompiler|decompile:in:method:. The method is found by looking up 
	the message, aSelector, in the method dictionary of the class, aClass."

	^self
		decompile: aSelector
		in: aClass
		method: (aClass compiledMethodAt: aSelector)! !

!Decompiler2 methodsFor: 'public access' stamp: 'md 4/26/2005 12:23'!
decompile: selector in: aClass method: aMethod
	"Answer a MethodNode that is the root of the parse tree for the 
	argument, aMethod, which is the CompiledMethod associated with the 
	message, aSelector. Variables are determined with respect to the 
	argument, aClass."

	| ird methodNode |
	ird _ IRDecompiler new.
	ird scope: aClass parseScope newMethodScope.
	methodNode _ ird decompileIR: aMethod ir.
	selector ifNotNil: [[methodNode selector: selector] on: Error do: []].
	^ methodNode! !

!Decompiler2 methodsFor: 'public access' stamp: 'md 2/27/2006 12:33'!
decompileBlock: aBlock
	"Answer a BlockNode, not done yet... return nil."
	^nil.
	
	
	"ird _ IRDecompiler new.
	ird scope: nil parseScope newBlockScope.
	^ (ird decompileIR: aBlock ir) asBlock"! !

!Decompiler2 methodsFor: 'initialize-release' stamp: 'ajh 3/15/2003 15:57'!
withTempNames: tempNameArray
! !

Object subclass: #FakeDecompiler
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Bytecodes'!

!FakeDecompiler methodsFor: 'compiling' stamp: 'md 2/28/2006 21:36'!
decompile: aMethod
	"Answer a MethodNode that is the root of the parse tree for the argument, aMethod.  Selector will be 'unknown' and inst vars will be 'instVarN'.  selector and class can be placed in resulting MethodNode later"

	^self
		decompile: aMethod selector  
		in:  aMethod methodClass
		method: aMethod
! !

!FakeDecompiler methodsFor: 'public access' stamp: 'md 2/27/2006 16:35'!
decompile: aSelector in: aClass 
	"See Decompiler|decompile:in:method:. The method is found by looking up 
	the message, aSelector, in the method dictionary of the class, aClass."

	^self
		decompile: aSelector
		in: aClass
		method: (aClass compiledMethodAt: aSelector)! !

!FakeDecompiler methodsFor: 'public access' stamp: 'md 2/28/2006 21:35'!
decompile: selector in: aClass method: aMethod
	"Answer a MethodNode that is the root of the parse tree for the 
	argument, aMethod, which is the CompiledMethod associated with the 
	message, aSelector. Variables are determined with respect to the 
	argument, aClass."

	| source |
	^ (source := aMethod getSourceFromFile)
		ifNil: [Decompiler new decompile: selector in: aClass method: aMethod ]
		ifNotNil: [aMethod parserClass new parse: source class: aMethod methodClass]! !

!FakeDecompiler methodsFor: 'public access' stamp: 'md 2/27/2006 16:35'!
decompileBlock: aBlock
	"Answer a BlockNode, not done yet... return nil."
	^nil.
	
	
	"ird _ IRDecompiler new.
	ird scope: nil parseScope newBlockScope.
	^ (ird decompileIR: aBlock ir) asBlock"! !

!FakeDecompiler methodsFor: 'initialize-release' stamp: 'md 2/27/2006 16:37'!
withTempNames: tempNameArray
	"ignored... fake decompiler has corrent temp names by default"! !

Object subclass: #IRBuilder
	instanceVariableNames: 'ir tempMap jumpBackTargetStacks jumpAheadStacks currentSequence sourceMapNodes sourceMapByteIndex'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRBuilder commentStamp: 'kwl 5/12/2006 18:29' prior: 0!
I provide a simple interface for constructing an IRMethod.  For example, to create an ir method that compares first instVar to first arg and returns 'yes' or 'no' (same example as in BytecodeGenerator), do:

	IRBuilder new
		numRargs: 2;
		addTemps: #(self a z);		"rcvr, arg, & extra temp (not used here)"
		pushTemp: #self;
		pushInstVar: 1;
		pushTemp: #a;
		send: #>;
		jumpAheadTo: #else if: false;
		pushLiteral: 'yes';
		returnTop;
		jumpAheadTarget: #else;
		pushLiteral: 'no';
		returnTop;
		ir

Sending #compiledMethod to an ir method will generate its compiledMethod.  Sending #methodNode to it will decompile to its parse tree.
!

!IRBuilder methodsFor: 'private' stamp: 'ajh 3/13/2003 13:20'!
add: instr

	"Associate instr with current parse node or byte range"
	instr sourceNode: self sourceNode.
	instr bytecodeIndex: self sourceByteIndex.
	^ currentSequence add: instr! !

!IRBuilder methodsFor: 'decompiling' stamp: 'ajh 6/22/2003 14:44'!
addJumpBackTarget: label to: sequence

	(jumpBackTargetStacks at: label ifAbsentPut: [OrderedCollection new])
		addLast: sequence! !

!IRBuilder methodsFor: 'private' stamp: 'md 7/11/2005 22:20'!
addLiteral: aSymbol

	ir addLiteral: aSymbol! !

!IRBuilder methodsFor: 'private' stamp: 'md 7/12/2005 00:21'!
addLiterals: aSymbol

	ir addLiterals: aSymbol! !

!IRBuilder methodsFor: 'initialize' stamp: 'md 11/16/2004 15:18'!
addTemp: tempKey

	self addTemps: {tempKey}! !

!IRBuilder methodsFor: 'initialize' stamp: 'md 7/11/2005 23:53'!
addTemps: newKeys

	| keys i new |
	keys := ir tempKeys.
	i := keys size - 1. "zero-based (index 0 equals receiver)"
	new := OrderedCollection new.
	newKeys do: [:key |
		tempMap at: key ifAbsentPut: [
			new add: key.
			i := i + 1]
	].
	ir tempKeys: keys, new.! !

!IRBuilder methodsFor: 'instr - old blocks' stamp: 'md 9/26/2005 13:09'!
blockReturnTop
	| retInst newSequence |
	retInst _ IRInstruction blockReturnTop.
	self  add:retInst.
	newSequence _ IRSequence new  orderNumber:currentSequence orderNumber  +1.
	newSequence  method:ir.
	currentSequence last isJumpOrReturn 
		 ifFalse:[self  add:(IRJump new  destination:newSequence)].
	currentSequence _ newSequence.
	retInst  successor:currentSequence! !

!IRBuilder methodsFor: 'accessing' stamp: 'md 10/11/2004 15:19'!
currentSequence
	^currentSequence! !

!IRBuilder methodsFor: 'private' stamp: 'md 9/26/2005 13:09'!
initialize
	ir _ IRMethod new.
	tempMap _ Dictionary new.
	jumpAheadStacks _ IdentityDictionary new.
	jumpBackTargetStacks _ IdentityDictionary new.
	sourceMapNodes _ OrderedCollection new.	"stack"

	"Leave an empty sequence up front (guaranteed not to be in loop)"
	ir  startSequence:((IRSequence new  orderNumber:0)  method:ir).
	currentSequence _ (IRSequence new  orderNumber:1)  method:ir.
	ir startSequence  add:(IRJump new  destination:currentSequence)! !

!IRBuilder methodsFor: 'results' stamp: 'ajh 3/10/2003 15:51'!
ir

	^ ir! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 2/27/2005 17:19'!
jumpAheadTarget: labelSymbol
	"Pop latest jumpAheadTo: with this labelSymbol and have it point to this new instruction sequence"

	| jumpInstr |
	self startNewSequence.
	jumpInstr := (jumpAheadStacks at: labelSymbol ifAbsent: [
			self error: 'Missing jumpAheadTo: ', labelSymbol printString]) removeLast.
	jumpInstr destination: currentSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'!
jumpAheadTo: labelSymbol
	"Jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self.  This is and its corresponding target is only good for one use.  Other jumpAheadTo: with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."

	"jumpAheadTarget: label will pop this and replace destination with its basic block"
	(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
		addLast: (self add: IRJump new).
	self startNewSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'!
jumpAheadTo: labelSymbol if: boolean
	"Conditional jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self.  This and its corresponding target is only good for one use.  Other jumpAheadTo:... with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."

	| instr |
	"jumpAheadTarget: label will pop this and replace destination with its basic block"
	(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
		addLast: (instr _ self add: (IRJumpIf new boolean: boolean)).
	self startNewSequence.
	instr otherwise: currentSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:44'!
jumpBackTarget: labelSymbol
	"Remember this basic block for a future jumpBackTo: labelSymbol.  Stack up remembered targets with same name and remove them from stack for each jumpBackTo: called with same name."

	self startNewSequence.
	(jumpBackTargetStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
		addLast: currentSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:25'!
jumpBackTo: labelSymbol
	"Pop last remembered position with this label and write an unconditional jump to it"

	| sequence |
	sequence _ (jumpBackTargetStacks at: labelSymbol ifAbsent: [self error: 'Missing jumpBackTarget: ', labelSymbol printString]) removeLast.
	self add: (IRJump new destination: sequence).
	self startNewSequence.
! !

!IRBuilder methodsFor: 'instr - old blocks' stamp: 'md 10/8/2004 15:59'!
jumpOverBlockTo: labelSymbol
	"Conditional jump to the sequence that will be created when jumpAheadTarget: labelSymbol is sent to self.  This and its corresponding target is only good for one use.  Other jumpAheadTo:... with the same label will be put on a stack and superceed existing ones until its jumpAheadTarget: is called."

	| instr |
	"jumpAheadTarget: label will pop this and replace destination with its basic block"
	(jumpAheadStacks at: labelSymbol ifAbsentPut: [OrderedCollection new])
		addLast: (instr _ self add: (IRJumpOverBlock new)).
	self startNewSequence.
	instr blockSequence: currentSequence.
! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:17'!
mapToByteIndex: index
	"decompiling"

	sourceMapByteIndex _ index! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 14:45'!
mapToNode: object
	"new instructions will be associated with object"

	sourceMapNodes addLast: object! !

!IRBuilder methodsFor: 'initialize' stamp: 'ajh 6/25/2004 11:24'!
numRargs: n

	ir numRargs: n.
! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 14:25'!
popMap

	sourceMapNodes removeLast! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'!
popTop

	self add: IRInstruction popTop! !

!IRBuilder methodsFor: 'initialize' stamp: 'ajh 3/10/2003 14:10'!
primitiveNode: primNode

	ir primitiveNode: primNode! !

!IRBuilder methodsFor: 'accessing' stamp: 'md 7/10/2005 22:37'!
properties: aDict
	ir properties: aDict! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:38'!
pushBlock: irMethod

	self add: (IRInstruction pushBlock: irMethod)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:38'!
pushBlockMethod: irMethod

	self add: (IRInstruction pushBlockMethod: irMethod)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'!
pushDup

	self add: IRInstruction pushDup! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 6/13/2005 13:59'!
pushInstVar: instVarIndex
	"Receiver must be on top"


	self add: (IRInstruction pushInstVar: instVarIndex).

"
	self pushLiteral: instVarIndex.
	self send: #privGetField:.
"! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 7/5/2005 15:52'!
pushLiteral: object
	
	self add: (IRInstruction pushLiteral: object)! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 7/5/2005 15:52'!
pushLiteralVariable: object
	
	self add: (IRInstruction pushLiteralVariable: object)! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 4/21/2005 11:38'!
pushReceiver

	self add: (IRInstruction pushReceiver)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/17/2003 11:06'!
pushTemp: key

	| index |
	index _ tempMap at: key.
	self add: (IRInstruction pushTemp: index)! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 4/21/2005 12:06'!
pushThisContext

	self add: (IRInstruction pushThisContext)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/26/2004 13:47'!
pushThisEnv

	self add: (IRInstruction pushTemp: -1)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/15/2003 01:55'!
remoteReturn

	self add: IRInstruction remoteReturn.
	self startNewSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/15/2003 01:55'!
returnTop

	self add: IRInstruction returnTop.
	self startNewSequence.
! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'!
send: selector

	self add: (IRInstruction send: selector)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/10/2003 01:09'!
send: selector toSuperOf: behavior

	self add: (IRInstruction send: selector toSuperOf: behavior)! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:19'!
sourceByteIndex
	"decompiling"

	^ sourceMapByteIndex! !

!IRBuilder methodsFor: 'mapping' stamp: 'ajh 6/22/2003 21:03'!
sourceNode

	^ sourceMapNodes isEmpty
		ifTrue: [nil]
		ifFalse: [sourceMapNodes last]! !

!IRBuilder methodsFor: 'private' stamp: 'md 9/26/2005 13:09'!
startNewSequence
	"End current instruction sequence and start a new sequence to add instructions to.  If ending block just falls through to new block then add an explicit jump to it so they stay linked"

	| newSequence |
	currentSequence isEmpty  ifTrue:[^ self].	"block is still empty, continue using it"
	newSequence _ IRSequence new  orderNumber:currentSequence orderNumber  +1.
	newSequence  method:ir.
	currentSequence last isJumpOrReturn 
		 ifFalse:[self  add:(IRJump new  destination:newSequence)].
	currentSequence _ newSequence! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 6/13/2005 14:02'!
storeInstVar: instVarIndex
	"receiver must be on top with new field value underneath"


	self add: (IRInstruction storeInstVar: instVarIndex).

	"self pushLiteral: instVarIndex.
	self send: #privStoreIn:field:."
! !

!IRBuilder methodsFor: 'instructions' stamp: 'md 7/5/2005 15:52'!
storeIntoLiteralVariable: object
	
	self add: (IRInstruction storeIntoLiteralVariable: object)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 3/17/2003 11:06'!
storeTemp: key

	| index |
	index _ tempMap at: key.
	self add: (IRInstruction storeTemp: index)! !

!IRBuilder methodsFor: 'instructions' stamp: 'ajh 6/26/2004 13:48'!
storeThisEnv

	self add: (IRInstruction storeTemp: -1)! !

!IRBuilder methodsFor: 'decompiling' stamp: 'ajh 3/21/2003 01:48'!
testJumpAheadTarget: label

	jumpAheadStacks at: label ifPresent: [:stack |
		[stack isEmpty] whileFalse: [self jumpAheadTarget: label]
	]! !

Object subclass: #IRInterpreter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRInterpreter commentStamp: 'ajh 3/24/2003 23:55' prior: 0!
I visit each IRInstruction in an IRMethod in order.  Each instruction sends its instruction message to me upon being visited.  See my 'instructions' method category for complete list of instructions.  Subclasses should override them.!

IRInterpreter subclass: #IRDecompiler
	instanceVariableNames: 'stack sp scope currentInstr valueLabelMap'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRDecompiler commentStamp: 'ajh 3/25/2003 00:37' prior: 0!
I interpret IRMethod instructions and generate a Smalltalk abstract syntax tree rooted at a RBMethodNode.

This is implemented like a shift-reduce parser.  Each instruction either causes a node to be pushed on the stack (shift), or causes one or more nodes to be popped and combined into a single node which is push back on the stack (reduce).  Most reduction is done at the "label: labelNum" instruction where it tries to reduce jump structures into control messages like #ifTrue:, whileFalse:, etc.

Several pseudo nodes (RBPseudoNode and subclasses) are used to represent basic instructions that have not been reduced to real AST nodes yet.
!

!IRDecompiler class methodsFor: 'as yet unclassified' stamp: 'ajh 6/5/2003 12:34'!
dummySelector: numArgs
	"Answer a dummy selector with number of args"

	| sel |
	sel _ 'unknown'.
	1 to: numArgs do: [:i |
		sel _ sel, 'with:'].
	^ sel asSymbol! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 17:03'!
Assignment

	| node |
	(node _ self stackDown) isAssignment ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'md 11/12/2004 14:06'!
Block

	| node |
	(node := self stackDown) isBlock ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/23/2003 22:34'!
Dup

	| node |
	(node _ self stackDown) isDup ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 16:33'!
Goto

	| node |
	(node _ self stackDown) isGoto ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/23/2003 12:57'!
Goto: seqNum

	| goto |
	(goto _ self Goto) destination = seqNum ifTrue: [^ goto].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/23/2003 23:17'!
GotoOrReturn: seqNum

	| goto |
	goto _ self Goto.
	(goto destination = seqNum or: [goto isRet]) ifTrue: [^ goto].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 16:33'!
If

	| node |
	(node _ self stackDown) isIf ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 17:07'!
IfGoto: seqNum otherwise: seqNum2

	| if |
	((if _ self If) destination = seqNum and: [if otherwise = seqNum2])
		ifTrue: [^ if].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 16:33'!
Label

	| node |
	(node _ self stackDown) isLabel ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 16:34'!
Label: seqNum

	| label |
	(label _ self Label) destination = seqNum ifTrue: [^ label].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 17:36'!
Pop

	| node |
	(node _ self stackDown) isPop ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/23/2003 22:32'!
Send

	| node |
	(node _ self stackDown) isPseudoSend ifTrue: [^ node].
	self abort! !

!IRDecompiler methodsFor: 'stack' stamp: 'md 11/15/2004 13:56'!
Sequence

	| node seq i goto |
	seq := RBSequenceNode statements: #().
	i := sp ifNil: [sp := stack size].
	[	node := stack at: i. 
		node isSequence ifTrue: [
			seq addNodesFirst: node statements.
			node := stack at: (i := i - 1).
			self halt.
		].
		"include sequences before fall-through gotos"
		(node isLabel and: [i > 1 "not first"]) ifFalse: [
			sp := i.
			^ seq].
		goto := stack at: (i := i - 1).
		goto isGoto and: [goto destination = node destination]
	] whileTrue: [i := i - 1].
	sp := i + 1.  "points to label"
	^ seq! !

!IRDecompiler methodsFor: 'stack' stamp: 'md 11/15/2004 15:45'!
Sequence2

	| node seq i |
	seq := RBSequenceNode statements: #().
	i := sp ifNil: [sp := stack size].
	node := stack at: i. 
	[(node isLabel not and: [i > 1 "not first"])] whileTrue: [
		seq addNodeFirst: node.
		i := i - 1.
		node := stack at: i. 
	].
	sp := i.  "points to label"
	^ seq! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/24/2003 01:08'!
SequenceBackTo: labelNum
	"Return previous sequence stopping at non-sequence or label: num, whichever comes first"

	| node seq i goto |
	seq _ RBSequenceNode statements: #().
	i _ sp ifNil: [sp _ stack size].
	[	node _ stack at: i.
		node isSequence ifTrue: [
			seq addNodesFirst: node statements.
			node _ stack at: (i _ i - 1).
		].
		"includes sequences back to labelNum"
		(node isLabel and: [i > 1 "not first"]) ifFalse: [
			sp _ i.
			^ seq].
		node destination = labelNum ifTrue: [
			sp _ i.
			^ seq].
		goto _ stack at: (i _ i - 1).
		goto isGoto and: [goto destination = node destination]
	] whileTrue: [i _ i - 1].
	sp _ i + 1.  "points to label"
	^ seq! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/23/2003 21:44'!
Value

	| node |
	node _ self ValueOrNone.
	node ifNil: [self abort].
	^ node! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/23/2003 21:43'!
ValueOrNone

	| node i label |
	i _ sp ifNil: [sp _ stack size].
	[	node _ stack at: i.
		node isValue ifTrue: [
			label ifNotNil: [valueLabelMap at: node put: label].
			sp _ i - 1.
			^ node].
		"test for value before fall-through goto"
		(node isLabel and: [i > 1 "not first"]) ifFalse: [^ nil].
		label _ node.
		node _ stack at: (i _ i - 1).
		node isGoto and: [node destination = label destination]
	] whileTrue: [i _ i - 1].
	^ nil! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/24/2003 00:59'!
abort

	| spWas |
	spWas _ sp.
	sp _ nil.
	Abort signal! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 3/21/2003 00:47'!
block: method capturedVars: varNodes

	| vars |
	vars _ varNodes collect: [:v |
		v isVariable ifTrue: [v binding]
		  ifFalse: [
			(v isMessage and: [v selector = #contextTag and: [v receiver isVariable]])
				ifFalse: [self patternError].
			v receiver binding]
	].
	self stackPush: (IRDecompiler new
		scope: (scope newBlockScope capturedVars: vars);
		decompileIR: method ir)
		asBlock! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'md 11/15/2004 17:03'!
block: method env: envRefNode

	envRefNode ifNotNil: [
		envRefNode isVariable ifTrue: [envRefNode binding]
		  ifFalse: [
			(envRefNode isMessage and: [envRefNode selector = #myEnv and: [envRefNode receiver isVariable]])
				ifFalse: [self patternError].
			envRefNode receiver binding].
	].

	self stackPush: (IRDecompiler new
		scope: (scope newBlockScope "capturedVars: vars");
		decompileIR: method ir)
		asBlock! !

!IRDecompiler methodsFor: 'old blocks' stamp: 'md 11/15/2004 15:38'!
blockReturnTop

	self goto: #return.
! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 3/24/2003 01:54'!
cascade

	| messages selector args rcvr |
	messages _ OrderedCollection new.
	[	"last message"
		selector _ self Send selector.
		args _ OrderedCollection new.
		selector numArgs timesRepeat: [args addFirst: self Value].
		messages addFirst: selector -> args.

		"rest of messages"
		[(rcvr _ self ValueOrNone) isNil] whileTrue: [
			self Pop.
			selector _ self Send selector.
			args _ OrderedCollection new.
			selector numArgs timesRepeat: [args addFirst: self Value].
			self Dup.
			messages addFirst: selector -> args.
		].
	] on: Abort do: [^ false].

	messages _ messages collect: [:assoc |
		RBMessageNode
			receiver: rcvr
			selector: assoc key
			arguments: assoc value].
	self stackPush: (RBCascadeNode messages: messages).
! !

!IRDecompiler methodsFor: 'init' stamp: 'md 11/17/2004 14:01'!
decompileIR: ir

	| sequenceNode temps args goto seq value |
	0 to: ir numRargs -1 do: [:i | scope tempVarAt: i].
	self interpret: ir.
	self label: #return.  "final label to return"

	self Label: #return.
	goto := self Goto.
	value := self ValueOrNone.
	seq := self Sequence.
	sp = 1 ifFalse: [self error: 'error'].

	value ifNotNil: [seq addNode: value].
	sequenceNode := (self newBlock: seq return: goto) body.
	temps := scope tempVars asArray.
	ir tempKeys: temps.
	args := (temps first: ir numRargs) allButFirst.
	args := args collect: [:var | self newVar: var].
	temps := temps allButFirst: ir numRargs.
	sequenceNode temporaries: (temps collect: [:var | self newVar: var]).

	^ RBMethodNode new
		selectorParts: (self newSelectorParts: (self class dummySelector: args size));
		arguments: args;
		body: sequenceNode;
		privIR: ir;
		primitiveNode: ir primitiveNode;
		scope: scope! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 6/22/2003 14:46'!
endAndOr2: seqNum

	| goto seq p if2 test else o if1 seqValue elseTest |
	[
		goto _ self Goto.
		seqValue _ self ValueOrNone.
		seq _ self Sequence.
		p _ self Label destination.
		if2 _ self IfGoto: seqNum otherwise: p.
		elseTest _ self Value.
		else _ self SequenceBackTo: goto destination.
		o _ self Label destination.
		o = goto destination ifTrue: [self abort].
		if1 _ self IfGoto: seqNum otherwise: o.
		test _ self Value.
	] on: Abort do: [^ false].

	if1 boolean = if2 boolean ifFalse: [
		test _ RBMessageNode
			receiver: test selector: #not arguments: #().
	].
	self stackPush: (RBMessageNode
		receiver: test
		selector: (if2 boolean ifTrue: [#or:] ifFalse: [#and:])
		arguments: {self newBlock: (else addNode: elseTest) return: nil}).
	stack addLast: if2.
	self label: p.
	stack addLast: seq.
	seqValue ifNotNil: [stack addLast: seqValue].
	stack addLast: goto.
	^ true
! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 6/22/2003 14:46'!
endAndOr: seqNum

	| o test branches if body block sel1 sel2 if2 |
	branches _ OrderedCollection new.
	[
		(if2 _ self If) otherwise = seqNum ifFalse: [self abort].
		[	test _ self Value.
			body _ self Sequence.
			branches add: {body. test}.
			o _ self Label destination.
			(if _ self If) otherwise = o ifFalse: [self abort].
			if destination = seqNum
		] whileFalse: [
			if boolean = if2 boolean ifFalse: [self abort].
			if destination = if2 destination ifFalse: [self abort].
		].
		if boolean = if2 boolean ifTrue: [self abort].
		test _ self Value.
	] on: Abort do: [^ false].

	if boolean
		ifTrue: [sel1 _ #or:. sel2 _ #and:]
		ifFalse: [sel1 _ #and:. sel2 _ #or:].
	block _ self newBlock: (branches first first addNode: branches first second).
	branches allButFirstDo: [:pair |
		block _ self newBlock: (pair first addNode: (RBMessageNode
				receiver: pair second
				selector: sel2
				arguments: {block})).
	].
	self stackPush: (RBMessageNode
		receiver: test
		selector: sel1
		arguments: {block}).
	stack addLast: if2.
	^ true! !

!IRDecompiler methodsFor: 'old blocks' stamp: 'md 11/17/2004 14:09'!
endBlock: seqNum

		| blockSeq block |
	[
		self GotoOrReturn: seqNum.
		sp = 0 ifTrue: [self abort].
		blockSeq := self Sequence2.
		self Label.
		block := self Block.
		self Send.
	] on: Abort do: [^ false].

	self stackPush: (self newBlock: blockSeq).	
	stack last arguments: block arguments.
	scope := scope outerScope.
	self goto: block successor.
	^ true! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 3/24/2003 00:07'!
endCase: seqNum

	| otherwiseGoto goto node otherwiseValue otherwiseSeq n branchValue branchSeq f caseValue caseSeq rcvr branches message |
	branches _ OrderedCollection new.
	[	"otherwise"
		otherwiseGoto _ self GotoOrReturn: seqNum.
		node _ self stackDown.
		(node isPop or: [node isPseudoSend]) ifTrue: [
			node isPop ifTrue: [node _ self Send].
			node selector == #caseError ifFalse: [self abort].
		] ifFalse: [
			sp _ sp + 1.  "stackUp"
			otherwiseValue _ self ValueOrNone.
			otherwiseSeq _ self Sequence.
		].
		n _ self Label destination.

		"last case branch"
		goto _ self GotoOrReturn: seqNum.
		branchValue _ self ValueOrNone.
		branchSeq _ self Sequence.
		f _ self Label destination.
		"last case"
		self IfGoto: n otherwise: f.
		self Send selector == #= ifFalse: [self abort].
		caseValue _ self Value.
		caseSeq _ self Sequence.
		otherwiseSeq ifNil: [self Dup].
		branches addFirst: ({caseSeq. caseValue} -> {branchSeq. branchValue. goto}).

		[(rcvr _ self ValueOrNone) isNil] whileTrue: [
			"case branch"
			n _ self Label destination.
			goto _ self GotoOrReturn: seqNum.
			branchValue _ self ValueOrNone.
			branchSeq _ self Sequence.
			self Pop.
			f _ self Label destination.
			"case"
			self IfGoto: n otherwise: f.
			self Send selector == #= ifFalse: [self abort].
			caseValue _ self Value.
			caseSeq _ self Sequence.
			self Dup.
			branches addFirst: ({caseSeq. caseValue} -> {branchSeq. branchValue. goto}).
		].
	] on: Abort do: [^ false].

	branches _ branches collect: [:assoc |
		assoc key second
			ifNotNil: [assoc key first addNode: assoc key second].
		assoc value second
			ifNotNil: [assoc value first addNode: assoc value second].
		RBMessageNode
			receiver: (self newBlock: assoc key first return: nil)
			selector: #->
			arguments:
				{self newBlock: assoc value first return: assoc value third}
	].
	message _ otherwiseSeq
		ifNil: [
			RBMessageNode
				receiver: rcvr
				selector: #caseOf:
				arguments: {RBArrayNode statements: branches}]
		ifNotNil: [
			otherwiseValue
				ifNotNil: [otherwiseSeq addNode: otherwiseValue].
			RBMessageNode
				receiver: rcvr
				selector: #caseOf:otherwise:
				arguments: 
					{RBArrayNode statements: branches.
					self newBlock: otherwiseSeq return: otherwiseGoto}.
		].
	self stackPush: message.
	branchValue ifNil: [self popTop].
	self goto: seqNum.
	^ true! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 3/24/2003 02:39'!
endIfNil: seqNum

	| goto branch o if rcvr value |
	[
		goto _ self GotoOrReturn: seqNum.
		value _ self Value.
		branch _ self Sequence.
		self Pop.
		o _ self Label destination.
		if _ self IfGoto: seqNum otherwise: o.
		self Send selector == #== ifFalse: [self abort].
		(self Value isLiteral: [:v | v isNil]) ifFalse: [self abort].
		self Dup.
		rcvr _ self Value.
	] on: Abort do: [^ false].

	branch addNode: value.
	self stackPush: (RBMessageNode
		receiver: rcvr
		selector: (if boolean ifTrue: [#ifNotNil:] ifFalse: [#ifNil:])
		arguments: {self newBlock: branch return: goto}).
	self goto: seqNum.
	^ true! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'md 11/12/2004 14:59'!
endIfThen: seqNum

	| goto branch o if test value |
	[
		
		goto := self Goto.
		(goto destination == seqNum or: [self isExplicitReturn: goto]) ifFalse: [self abort].
		goto isRet ifTrue: [value := self Value].
		branch := self Sequence.
		o := self Label destination.
		if := self IfGoto: seqNum otherwise: o.
		test := self Value.
	] on: Abort do: [^ false].
		self halt.	

	value ifNotNil: [branch addNode: value].
	self stackPush: (self simplify: (RBMessageNode
		receiver: test
		selector: (if boolean ifTrue: [#ifFalse:] ifFalse: [#ifTrue:])
		arguments: {self newBlock: branch return: goto})).
	self popTop.
	self goto: seqNum.
	^ true! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'md 11/12/2004 18:16'!
endIfThenElse: seqNum

	| goto2 else d goto1 then o if test value2 value1 |
	[
		goto2 := self Goto.
		value2 := self ValueOrNone.
		else := self Sequence.
		d := self Label destination.
		goto1 := self Goto.
		((self isExplicitReturn: goto2) or: [goto2 destination == goto1 destination]) ifFalse: [self abort].
		value1 := self ValueOrNone.
		then := self Sequence.
		o := self Label destination.
		if := self IfGoto: d otherwise: o.
		test := self Value.
	] on: Abort do: [^ false].

	value2 ifNotNil: [else addNode: value2].
	value1 ifNotNil: [then addNode: value1].
	self stackPush: (self simplify: (else statements isEmpty
		ifTrue: [RBMessageNode
			receiver: test
			selector: (if boolean ifTrue: [#ifFalse:] ifFalse: [#ifTrue:])
			arguments: {self newBlock: then return: goto1}]
		ifFalse: [RBMessageNode
			receiver: test
			selector: (if boolean
				ifTrue: [#ifFalse:ifTrue:]
				ifFalse: [#ifTrue:ifFalse:])
			arguments: {
				self newBlock: then return: goto1.
				self newBlock: else return: goto2}])).
	value1 ifNil: [self popTop].
	self goto: goto1 destination.
	(else statements isEmpty and:
	 [stack anySatisfy: [:n | n isIf and: [n destination = d]]]
	) ifTrue: [
		self label: d.
		self goto: goto2 destination.
	].
	^ true! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 3/24/2003 02:04'!
endToDo: seqNum

	| start limit incr iter step loopBlock o if test limitExpr init |
	[
		start _ self Goto destination.
		limit _ self Value.
		incr _ self Assignment.
		iter _ incr variable.
		(incr value isMessage and:
		 [incr value selector == #+ and:
		  [incr value receiver isVariable and: 
		   [incr value receiver binding == iter binding]]]
		) ifFalse: [self abort].
		step _ incr value arguments first.
		loopBlock _ self Sequence.
		o _ self Label destination.
		if _ self IfGoto: seqNum otherwise: o.
		test _ self Value.
		(test isMessage and:
		 [(test selector == #<= or: [test selector == #>=]) and:
		  [(valueLabelMap at: test arguments first ifAbsent: [self abort]) destination = start]]
		) ifFalse: [self abort].
		limitExpr _ test arguments first.
		limitExpr isAssignment ifTrue: [
			limitExpr variable binding == limit binding ifFalse: [self abort].
			limitExpr _ limitExpr value.
		].
		init _ test receiver.
		(init isAssignment and: [init variable binding == iter binding])
			ifFalse: [self abort].
	] on: Abort do: [^ false].

	loopBlock _ self newBlock: loopBlock return: nil.
	loopBlock arguments: {iter}.
	self stackPush: ((step isLiteral: [:c | c = 1])
		ifTrue: [RBMessageNode
				receiver: init value
				selector: #to:do:
				arguments: {limitExpr. loopBlock}]
		ifFalse: [RBMessageNode
				receiver: init value
				selector: #to:by:do:
				arguments: {limitExpr. step. loopBlock}]).
	self popTop.
	self goto: seqNum.
	^ true
! !

!IRDecompiler methodsFor: 'priv instructions' stamp: 'ajh 3/24/2003 02:18'!
endWhile: seqNum

	| start loopBlock if test sequence o |
	[
		start _ self Goto destination.
		loopBlock _ self Sequence.
		o _ self Label destination.
		if _ self IfGoto: seqNum otherwise: o.
		test _ self Value.
		sequence _ self SequenceBackTo: start.
		self Label: start.
		sp _ sp + 1.  "stackUp"
	] on: Abort do: [^ false].

	self stackPush: (self simplify: (RBMessageNode
		receiver: (self newBlock: (sequence addNode: test) return: nil)
		selector: (if boolean ifTrue: [#whileFalse:] ifFalse: [#whileTrue:])
		arguments: {self newBlock: loopBlock return: nil})).
	self popTop.
	self goto: seqNum.
	^ true
! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 6/22/2003 14:41'!
fixStack

	sp ifNotNil: [stack removeLast: (stack size - sp)].
	sp _ nil.
! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 3/23/2003 12:47'!
goto: seqNum

	self stackPush: (RBPseudoGotoNode new destination: seqNum).
! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 3/20/2003 17:21'!
if: bool goto: seqNum1 otherwise: seqNum2

	self stackPush: (RBPseudoIfNode new
		boolean: bool;
		destination: seqNum1;
		otherwise: seqNum2)! !

!IRDecompiler methodsFor: 'private' stamp: 'ajh 3/23/2003 21:17'!
initialize

	stack _ OrderedCollection new.
	scope _ nil parseScope newMethodScope.  "in case never set"
	valueLabelMap _ IdentityDictionary new.
! !

!IRDecompiler methodsFor: 'interpret' stamp: 'ajh 3/13/2003 13:48'!
interpretInstruction: irInstruction

	currentInstr _ irInstruction.
	super interpretInstruction: irInstruction.
! !

!IRDecompiler methodsFor: 'interpret' stamp: 'ajh 3/20/2003 23:37'!
interpretSequence: instructionSequence

	super interpretSequence: instructionSequence.
	currentInstr _ nil.
! !

!IRDecompiler methodsFor: 'private' stamp: 'ajh 3/22/2003 11:03'!
isExplicitReturn: goto

	^ goto isRet and:
	  [goto mapInstr notNil and:
	   [goto mapInstr isRemote or: [scope isBlockScope not]]]! !

!IRDecompiler methodsFor: 'old blocks' stamp: 'md 11/17/2004 14:30'!
jumpOverBlock: seqNum1  to: seqNum2
	| numArgs args oldscope |

	oldscope := scope.
	self scope: (scope newBlockScope).

	args := OrderedCollection new.
	numArgs := stack last arguments first value.
	numArgs timesRepeat: [ | var instr |
		instr :=  currentInstr blockSequence removeFirst.
 		var := oldscope tempVarAt: instr number.
		args add: (self newVar: var).
		currentInstr blockSequence removeFirst.
		oldscope removeTemp: var.
		scope addTemp: var.
	].
	
	self stackPush: (RBPseudoBlockNode new
		block: seqNum1;
		successor: seqNum2;
		arguments: args).	
	! !

!IRDecompiler methodsFor: 'instructions' stamp: 'md 11/12/2004 15:16'!
label: seqNum

	stack isEmpty ifTrue: [  "start"
		^ stack addLast: (RBPseudoLabelNode new destination: seqNum)].

	"Reduce jump structures to one of the following if possible"
	[	(self endIfNil: seqNum) or: [
		 (self endAndOr: seqNum) or: [
		  (self endAndOr2: seqNum) or: [
		   (self endIfThen: seqNum) or: [
		    (self endIfThenElse: seqNum) or: [
		     (self endCase: seqNum) or: [
		      (self endToDo: seqNum) or: [
		       (self endWhile: seqNum) or: [
			   (self endBlock: seqNum)]]]]]]]]
	] whileTrue.

	stack addLast: (RBPseudoLabelNode new destination: seqNum).
! !

!IRDecompiler methodsFor: 'private' stamp: 'ajh 3/20/2003 23:21'!
mapNode: node

	currentInstr ifNil: [^ self].
	node isPseudo
		ifTrue: [node mapInstr: currentInstr]
		ifFalse: [currentInstr sourceNode: node]! !

!IRDecompiler methodsFor: 'private' stamp: 'ajh 3/24/2003 12:07'!
newBlock: sequence

	^ self newBlock: sequence return: nil! !

!IRDecompiler methodsFor: 'private' stamp: 'ajh 3/24/2003 01:24'!
newBlock: sequence return: goto

	| statements ret |
	statements _ sequence statements.
	(goto notNil and: [self isExplicitReturn: goto]) ifTrue: [
		ret _ RBReturnNode value: statements last.
		goto mapInstr sourceNode: ret.
		statements atLast: 1 put: ret.
	].
	sequence statements: statements.
	^ RBBlockNode body: sequence! !

!IRDecompiler methodsFor: 'private' stamp: 'ajh 3/13/2003 14:10'!
newSelectorParts: selector

	^ selector keywords collect: [:word |
		SmaCCToken value: word]! !

!IRDecompiler methodsFor: 'private' stamp: 'md 11/16/2004 15:24'!
newVar: semVar

	^ RBVariableNode new
		identifierToken: (SmaCCToken value: semVar name);
		binding: semVar! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 6/22/2003 21:05'!
popTop

	| value |
	stack last ifNil: [^ stack removeLast].  "pop no-op from #simplifyTempAssign:"
	stack last isValue ifTrue: [
		(stack atLast: 2) isSequence ifTrue: [
			value _ stack removeLast.
			^ stack last addNode: value.
		] ifFalse: [(stack atLast: 2) isPseudo ifTrue: [
			value _ stack removeLast.
			^ stack addLast: (RBSequenceNode statements: {value}).
		]].
	].
	stack addLast: RBPseudoPopNode new
! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:35'!
pushBlock: irMethod

	self block: irMethod env: nil! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:37'!
pushBlockMethod: irMethod

	"block will recognized when send: #createBlock:"
	self pushLiteral: irMethod! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:51'!
pushDup

	stack addLast: RBPseudoDupNode new! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:36'!
pushLiteral: object

	self stackPush: (RBLiteralNode
		literalToken: (SmaCCToken value: object name)
		value: object).
! !

!IRDecompiler methodsFor: 'instructions' stamp: 'md 11/16/2004 13:55'!
pushTemp: tempIndex

	| var |
	var := scope tempVarAt: tempIndex.
	self stackPush: (self newVar: var).! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 6/22/2003 14:27'!
remoteReturn

	stack removeLast.  "pop home context free var"
	self goto: #return.
! !

!IRDecompiler methodsFor: 'instructions' stamp: 'md 11/12/2004 18:00'!
returnTop

	self goto: #return.
! !

!IRDecompiler methodsFor: 'init' stamp: 'ajh 6/27/2004 15:14'!
scope: aLexicalScope

	scope _ aLexicalScope! !

!IRDecompiler methodsFor: 'instructions' stamp: 'md 11/15/2004 18:05'!
send: selector

	| args rcvr |
	args := OrderedCollection new.
	[	selector numArgs timesRepeat: [args addFirst: self Value].
		rcvr := self Value.
	] on: Abort do: [
		self stackPush: (RBPseudoSendNode new selector: selector).
		^ self cascade
	].

	Preferences compileBlocksAsClosures 
			ifTrue: [ (rcvr isLiteral and: [selector = #createBlock:]) ifTrue: [
					 ^ self block: rcvr value env: args first]]
			ifFalse: [ (selector = #blockCopy:) ifTrue: [
					 ^ self stackPush: (RBPseudoSendNode new selector: selector; arguments: args)]].

	self stackPush: (self simplify: (RBMessageNode new
		receiver: rcvr
		selectorParts: (self newSelectorParts: selector)
		arguments: args)).
! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 3/24/2003 00:45'!
send: selector toSuperOf: behavior

	| args rcvr |
	args _ OrderedCollection new.
	selector numArgs timesRepeat: [args addFirst: self Value].
	rcvr _ self Value.
	(rcvr isVariable and: [rcvr name = 'self']) ifFalse: [self patternError].

	rcvr identifierToken: (SmaCCToken value: 'super').
	self stackPush: (RBMessageNode new
		receiver: rcvr
		selectorParts: (self newSelectorParts: selector)
		arguments: args).
! !

!IRDecompiler methodsFor: 'private' stamp: 'md 6/14/2005 15:03'!
simplify: mess
	"mess is a messageNode.  If it is a message created by the compiler convert it back to its normal form"

	| rcvr sc |
	(mess selector == #value and: [mess receiver isLiteral]) ifTrue: [
		^ self newVar: (GlobalVar new assoc: mess receiver value; scope: scope)
	].

	(mess selector = #privSetInHolder: and: [mess arguments first isLiteral]) ifTrue: [
		^ RBAssignmentNode
			variable: (self newVar: (GlobalVar new assoc: mess arguments first value; scope: scope))
			value: mess receiver
	].

	(mess selector = #privGetInstVar: and:
	 [mess arguments first isLiteral and:
	  [mess receiver isVariable]]) ifTrue: [
		rcvr _ mess receiver binding.
		rcvr == scope receiverVar ifTrue: [
			^ self newVar: (scope receiverVarAt: mess arguments first value)].
		(rcvr isFieldVar and: [rcvr originalTempVar notNil]) ifTrue: [
			sc _ rcvr originalTempVar scope.
			rcvr = scope receiverVar ifTrue: [
				^ self newVar: (sc receiverVarAt: mess arguments first value)]].
	].

	(mess selector = #privStoreIn:instVar: and:
	 [mess arguments last isLiteral and:
	  [mess arguments first isVariable]]) ifTrue: [
		rcvr _ mess arguments first binding.
		rcvr == scope receiverVar ifTrue: [
			^ RBAssignmentNode
				variable: (self newVar: (scope receiverVarAt: mess arguments last value))
				value: mess receiver
		].
		(rcvr isFieldVar and: [rcvr originalTempVar notNil]) ifTrue: [
			sc _ rcvr originalTempVar scope.
			rcvr = scope receiverVar ifTrue: [
				^ RBAssignmentNode
					variable: (self newVar: (sc receiverVarAt: mess arguments last value))
					value: mess receiver]
		].
	].

	(mess selector = #tempHolderValue and: [mess receiver isVariable]) ifTrue: [
		^ mess receiver
	].

	(mess selector = #storeInTempHolder: and: [mess arguments first isVariable]) ifTrue: [
		^ RBAssignmentNode
			variable: mess arguments first
			value: mess receiver
	].

	^ mess! !

!IRDecompiler methodsFor: 'private' stamp: 'ajh 3/24/2003 16:01'!
simplifyTempAssign: assignment
	"If it is a assignment created by the compiler convert it back to its normal form"

	| mess |
	((mess _ assignment value) isMessage and: 
	 [mess selector = #wrapInTempHolder and:
	  [mess receiver isLiteral: [:v | v isNil]]]
	) ifTrue: [
		^ nil  "no-op"
	].

	^ assignment! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 3/22/2003 19:24'!
stackDown

	| node |
	sp ifNil: [sp _ stack size].
	sp = 0 ifTrue: [self abort].
	node _ stack at: sp.
	sp _ sp - 1.
	^ node! !

!IRDecompiler methodsFor: 'stack' stamp: 'ajh 6/22/2003 14:51'!
stackPush: node

	self fixStack.
	stack addLast: node.
	node ifNil: [^ self].  "no op"
	self mapNode: node.
! !

!IRDecompiler methodsFor: 'instructions' stamp: 'ajh 3/24/2003 15:55'!
storeTemp: tempIndex

	| var |
	var _ scope tempVarAt: tempIndex.
	self stackPush: (self simplifyTempAssign:
		(RBAssignmentNode variable: (self newVar: var) value: self Value)).
! !

!IRInterpreter methodsFor: 'instructions' stamp: 'md 8/12/2005 13:30'!
blockReturnTop! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 13:26'!
goto: seqNum! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 13:26'!
if: bool goto: seqNum1 otherwise: seqNum2! !

!IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/9/2003 12:33'!
interpret: ir

	self interpretAll: ir allSequences! !

!IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/10/2003 23:30'!
interpretAll: irSequences

	irSequences do: [:seq | self interpretSequence: seq]! !

!IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/6/2003 15:31'!
interpretInstruction: irInstruction

	irInstruction executeOn: self! !

!IRInterpreter methodsFor: 'interpret' stamp: 'ajh 3/9/2003 13:20'!
interpretSequence: instructionSequence

	self label: instructionSequence orderNumber.
	instructionSequence do: [:instr | self interpretInstruction: instr].
! !

!IRInterpreter methodsFor: 'instructions' stamp: 'md 7/29/2005 10:44'!
jumpOverBlock: blockSeq to: dest! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 13:25'!
label: seqNum! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 14:11'!
popTop! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:34'!
pushBlock: irMethod! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:26'!
pushBlockMethod: irMethod! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 14:12'!
pushDup! !

!IRInterpreter methodsFor: 'instructions' stamp: 'md 10/10/2005 17:38'!
pushInstVar: aSmallInteger ! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:08'!
pushLiteral: object! !

!IRInterpreter methodsFor: 'instructions' stamp: 'md 7/7/2005 14:17'!
pushLiteralVariable: object! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:09'!
pushTemp: index! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:10'!
remoteReturn! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:08'!
returnTop! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:11'!
send: selector! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:11'!
send: selector toSuperOf: behavior! !

!IRInterpreter methodsFor: 'instructions' stamp: 'md 7/7/2005 14:17'!
storeLiteralVariable: index! !

!IRInterpreter methodsFor: 'instructions' stamp: 'ajh 3/2/2003 16:11'!
storeTemp: index! !

IRInterpreter subclass: #IRPrinter
	instanceVariableNames: 'stream indent'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRPrinter commentStamp: 'ajh 3/25/2003 00:22' prior: 0!
I interpret IRMethod instructions and write them out to a print stream.!

!IRPrinter methodsFor: 'instructions' stamp: 'md 8/9/2005 17:08'!
blockReturnTop

	stream nextPutAll: 'blockReturnTop'.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:41'!
goto: seqNum

	stream nextPutAll: 'goto: '.
	seqNum printOn: stream.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:42'!
if: bool goto: seqNum1 otherwise: seqNum2

	stream nextPutAll: 'if: '.
	bool printOn: stream.
	stream nextPutAll: ' goto: '.
	seqNum1 printOn: stream.
	stream nextPutAll: ' else: '.
	seqNum2 printOn: stream.
! !

!IRPrinter methodsFor: 'initialize' stamp: 'ajh 3/9/2003 15:49'!
indent: tabs

	indent _ tabs! !

!IRPrinter methodsFor: 'interpret' stamp: 'ajh 3/9/2003 15:48'!
interpretInstruction: irInstruction

	indent timesRepeat: [stream tab].
	super interpretInstruction: irInstruction.
	stream cr.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'md 8/10/2005 11:23'!
jumpOverBlock: blockSeq to: dest

	stream nextPutAll: 'jumpOverBlock: '.
	stream nextPutAll: ' block '.
	blockSeq  printOn: stream.
	stream nextPutAll: ' cont: '.
	dest  printOn: stream.! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/11/2003 00:36'!
label: seqNum

	"add tab and cr since this does not get called within interpretInstruction:"
	stream cr.  "extra cr just to space out sequences"
	indent timesRepeat: [stream tab].
	stream nextPutAll: 'label: '.
	seqNum printOn: stream.
	stream cr.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:42'!
popTop

	stream nextPutAll: 'popTop'! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:44'!
pushBlock: irMethod

	stream nextPutAll: 'pushBlock:'.
	IRPrinter new
		indent: indent + 1;
		stream: stream;
		interpret: irMethod removeEmptyStart.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 6/27/2004 21:44'!
pushBlockMethod: irMethod

	stream nextPutAll: 'pushBlockMethod:'.
	IRPrinter new
		indent: indent + 1;
		stream: stream;
		interpret: irMethod removeEmptyStart.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:42'!
pushDup

	stream nextPutAll: 'pushDup'! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/21/2003 01:49'!
pushLiteral: object

	stream nextPutAll: 'pushLiteral: '.
	object isVariableBinding ifTrue: [^ stream nextPutAll: object key].
	object printOn: stream.

	((object isKindOf: BlockClosure) or: [object isKindOf: CompiledMethod])
		ifTrue: [
			IRPrinter new
				indent: indent + 1;
				stream: stream;
				interpret: object method ir removeEmptyStart].
! !

!IRPrinter methodsFor: 'instructions' stamp: 'md 8/10/2005 11:28'!
pushLiteralVariable: object

	stream nextPutAll: 'pushLiteralVariable: '.
	object isVariableBinding ifTrue: [^ stream nextPutAll: object key].
	object printOn: stream.! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 6/26/2004 18:37'!
pushTemp: index

	stream nextPutAll: 'pushTemp: '.
	index printOn: stream.
	index = 0 ifTrue: [stream nextPutAll: ' "receiver"'].
	index = -1 ifTrue: [stream nextPutAll: ' "thisEnv"'].
	index = -2 ifTrue: [stream nextPutAll: ' "thisContext"'].
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:43'!
remoteReturn

	stream nextPutAll: 'remoteReturn'.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:43'!
returnTop

	stream nextPutAll: 'returnTop'.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:44'!
send: selector

	stream nextPutAll: 'send: '.
	selector printOn: stream.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 3/9/2003 15:44'!
send: selector toSuperOf: behavior

	stream nextPutAll: 'send: '.
	selector printOn: stream.
	stream nextPutAll: ' toSuperOf: '.
	behavior printOn: stream.
! !

!IRPrinter methodsFor: 'instructions' stamp: 'ajh 6/26/2004 23:15'!
storeTemp: index

	stream nextPutAll: 'storeTemp: '.
	index printOn: stream.
	index = -1 ifTrue: [stream nextPutAll: ' "thisEnv"'].
! !

!IRPrinter methodsFor: 'initialize' stamp: 'ajh 3/9/2003 15:50'!
stream: stringWriteStream

	stream _ stringWriteStream! !

IRInterpreter subclass: #IRTranslator
	instanceVariableNames: 'pending gen currentInstr trailerBytes'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRTranslator commentStamp: 'ajh 3/25/2003 00:26' prior: 0!
I interpret IRMethod instructions, sending the appropriate bytecode messages to my BytecodeGenerator (gen).  I hold some messages back in pending awaiting certain sequences of them that can be consolidated into single bytecode instructions, otherwise the pending messages are executed in order as if they were executed when they first appeared.!

!IRTranslator methodsFor: 'instructions' stamp: 'md 4/23/2005 17:15'!
addLiteral: literal
	gen addLiteral: literal.! !

!IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 14:54'!
addPending: message

	pending addLast: currentInstr -> message! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 10/8/2004 16:07'!
blockReturnTop

	self doPending.
	gen blockReturnTop.
! !

!IRTranslator methodsFor: 'results' stamp: 'ajh 6/28/2004 11:23'!
compiledMethod

	^ gen compiledMethodWith: trailerBytes! !

!IRTranslator methodsFor: 'results' stamp: 'pmm 8/16/2006 20:55'!
compiledMethodUsing: aCompiledMethodClass

	^ gen compiledMethodWith: trailerBytes using: aCompiledMethodClass! !

!IRTranslator methodsFor: 'results' stamp: 'ajh 3/13/2003 18:28'!
compiledMethodWith: trailer

	^ gen compiledMethodWith: trailer! !

!IRTranslator methodsFor: 'results' stamp: 'pmm 8/16/2006 20:52'!
compiledMethodWith: trailer using: aCompiledMethodClass

	^ gen compiledMethodWith: trailer using: aCompiledMethodClass! !

!IRTranslator methodsFor: 'priv pending' stamp: 'ajh 3/13/2003 04:49'!
doPending
	"execute pending instructions"

	| assoc |
	[pending isEmpty] whileFalse: [
		assoc _ pending removeFirst.
		gen mapBytesTo: assoc key "instr".
		assoc value "message" sendTo: gen.
	].
	gen mapBytesTo: currentInstr.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:09'!
goto: seqNum

	self doPending.
	gen goto: seqNum.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:09'!
if: bool goto: seqNum1 otherwise: seqNum2

	self doPending.
	gen if: bool goto: seqNum1 otherwise: seqNum2.
! !

!IRTranslator methodsFor: 'initialize' stamp: 'ajh 6/28/2004 11:27'!
initialize

	gen _ BytecodeGenerator new.
	trailerBytes _ #(0).
! !

!IRTranslator methodsFor: 'interpret' stamp: 'md 7/11/2005 22:23'!
interpret: ir

	ir optimize.
	gen primitiveNode: ir primitiveNode.
	gen numArgs: ir numArgs.
	gen properties: ir properties.
	ir additionalLiterals do: [:lit | gen addLiteral: lit].
	super interpret: ir.
! !

!IRTranslator methodsFor: 'interpret' stamp: 'ajh 3/13/2003 18:07'!
interpretAll: irSequences

	irSequences withIndexDo: [:seq :i | seq orderNumber: i].
	super interpretAll: irSequences.
! !

!IRTranslator methodsFor: 'interpret' stamp: 'ajh 3/13/2003 04:50'!
interpretInstruction: irInstruction

	currentInstr _ irInstruction.
	super interpretInstruction: irInstruction.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 10/27/2004 17:00'!
jumpOverBlock:  blockNum to: seqNum

	self doPending.
	gen jumpOverBlock: seqNum.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:10'!
label: seqNum

	pending _ OrderedCollection new.
	gen label: seqNum.
! !

!IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/5/2003 12:41'!
pendingMatches: blocks
	"Return true if each message at end of pending list satisfies its corresponding block.  The number of elements tested equals the number of blocks.  If not enough elements return false"

	| messages i |
	messages _ pending collect: [:assoc | assoc value].
	blocks size > messages size ifTrue: [^ false].
	i _ messages size - blocks size.
	blocks do: [:b |
		(b value: (messages at: (i _ i + 1))) ifFalse: [^ false].
	].
	^ true! !

!IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 21:06'!
pendingSelector

	pending isEmpty ifTrue: [^ nil].
	^ pending last value "message" selector! !

!IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 21:06'!
pendingSelector: selector

	pending last value "message" setSelector: selector! !

!IRTranslator methodsFor: 'priv pending' stamp: 'ajh 6/22/2003 14:27'!
popPending

	^ pending removeLast value "message"! !

!IRTranslator methodsFor: 'instructions' stamp: 'ms 12/3/2006 18:18'!
popTop

	"if last was storeTemp,  storeInstVar storeIntoLiteralVariable then convert to storePopTemp, storePopInstVar storePopIntoLiteralVariable"
	#storeTemp: == self pendingSelector ifTrue: [
		^ self pendingSelector: #storePopTemp:].
	#storeInstVar: == self pendingSelector ifTrue: [
		^ self pendingSelector: #storePopInstVar:].
	#storeIntoLiteralVariable: == self pendingSelector ifTrue:[
		^self pendingSelector: #storePopIntoLiteralVariable:].
	"otherwise do normal pop"
	self doPending.
	gen popTop.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 6/28/2004 11:20'!
pushBlock: irMethod

	| meth block |
	meth _ irMethod compiledMethodWith: trailerBytes.
	meth isBlockMethod: true.
	block _ meth createBlock: nil.
	self addPending: (Message selector: #pushLiteral: argument: block)! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 6/28/2004 11:20'!
pushBlockMethod: irMethod

	| meth |
	meth _ irMethod compiledMethodWith: trailerBytes.
	meth isBlockMethod: true.
	self addPending: (Message selector: #pushLiteral: argument: meth)! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:10'!
pushDup

	self doPending.
	gen pushDup.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 7/19/2005 23:21'!
pushInstVar: index

	"self doPending.
	gen pushInstVar: index."
	self addPending: (Message selector: #pushInstVar: argument: index)
! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 7/5/2005 16:10'!
pushLiteral: object

	self addPending: (Message selector: #pushLiteral: argument: object)! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 7/5/2005 16:10'!
pushLiteralVariable: object

	self addPending: (Message selector: #pushLiteralVariable: argument: object)! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 6/14/2005 15:02'!
pushTemp: index

	index = 0 ifTrue: [^ self addPending: (Message selector: #pushReceiver)].

	(self pendingMatches: {
		[:m | m selector == #storePopTemp: and: [m argument = index]]}
		) ifTrue: [^ self pendingSelector: #storeTemp:].

	self doPending.

	index = -2 ifTrue: [^ gen pushThisContext].
	index = -1 ifTrue: [
		^ gen pushThisContext;
			pushLiteral: MethodContext myEnvFieldIndex;
			send: #privGetInstVar:].

	gen pushTemp: index.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:12'!
remoteReturn

	self doPending.
	gen remoteReturn.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 7/19/2005 23:30'!
returnTop

	#pushReceiver == self pendingSelector ifTrue: [
		self pendingSelector: #returnReceiver.
		^ self doPending
	].
	#pushLiteral: == self pendingSelector ifTrue: [
		self pendingSelector: #returnConstant:.
		^ self doPending
	].
	#pushInstVar: == self pendingSelector ifTrue: [
		self pendingSelector: #returnInstVar:.
		^ self doPending
	].
	self doPending.
	gen returnTop.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 6/14/2005 15:04'!
send: selector

	"If get/set inst var, access it directly"
	| index |
	
	((#(privGetInstVar: #privStoreIn:instVar:) identityIncludes: selector) and:
	 [self pendingMatches: {
		[:m | m selector == #pushReceiver].
		[:m | m selector == #pushLiteral: and: [m argument isInteger]]}]
	) ifTrue: [
		index _ self popPending argument.
		self popPending.  "pop pushReceiver"
		self addPending: (Message
			selector: (selector == #privGetInstVar:
				ifTrue: [#pushInstVar:] ifFalse: [#storeInstVar:])
			argument: index).
		(self pendingMatches: {
			[:m | m selector == #storePopInstVar: and: [m argument = index]].
			[:m | m selector == #pushInstVar: and: [m argument = index]]}
		) ifTrue: [
			self popPending.
			self pendingSelector: #storeInstVar:.
		].
		^ self
	].
	"otherwise do normal send"
	self doPending.
	gen send: selector.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'ajh 3/9/2003 22:14'!
send: selector toSuperOf: behavior

	self doPending.
	gen send: selector toSuperOf: behavior.
! !

!IRTranslator methodsFor: 'instructions' stamp: 'ms 12/2/2006 23:01'!
storeInstVar: index 
	"self doPending.
	gen storeInstVar: index"
	self addPending: (Message selector: #storeInstVar: argument: index)! !

!IRTranslator methodsFor: 'instructions' stamp: 'ms 12/3/2006 18:18'!
storeIntoLiteralVariable: assoc

	"self doPending.
	gen storeIntoLiteralVariable: assoc."
	
	self addPending: (Message selector: #storeIntoLiteralVariable: argument: assoc)
! !

!IRTranslator methodsFor: 'instructions' stamp: 'md 6/14/2005 15:04'!
storeTemp: index

	index = -1 "thisEnv" ifTrue: [
		self doPending.
		^ gen pushThisContext;
			pushLiteral: MethodContext myEnvFieldIndex;
			send: #privStoreIn:instVar:].

	self addPending: (Message selector: #storeTemp: argument: index)! !

!IRTranslator methodsFor: 'initialize' stamp: 'ajh 6/28/2004 11:23'!
trailer: bytes

	trailerBytes _ bytes! !

Object subclass: #IRMethod
	instanceVariableNames: 'startSequence primitiveNode tempKeys numRargs compiledMethod properties additionalLiterals maxOrderNumber sourceMap'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRMethod commentStamp: 'ajh 5/23/2003 11:08' prior: 0!
I am a method in the IR (intermediate representation) language consisting of IRInstructions grouped by IRSequence (basic block).  The IRSequences form a control graph (therefore I only have to hold onto the starting sequence).  #compiledMethod will convert me to a CompiledMethod.  #methodNode will convert me back to a parse tree.
!

!IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/10/2003 15:45'!
absorbConstantConditionalJumps

	startSequence absorbConstantConditionalJumps: IdentitySet new! !

!IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/10/2003 15:45'!
absorbJumpsToSingleInstrs

	startSequence absorbJumpToSingleInstr: IdentitySet new! !

!IRMethod methodsFor: 'inlining' stamp: 'md 9/11/2005 18:52'!
addInstructionsAfter: aCollection
	| returningSeqs  lastInstr |
	aCollection ifEmpty: [^self].
	returningSeqs := self allSequences select: [:each | each last isReturn].
	lastInstr := returningSeqs last last.
	lastInstr addInstructionsBefore: aCollection.
	! !

!IRMethod methodsFor: 'inlining' stamp: 'md 7/14/2005 12:31'!
addInstructionsBefore: aCollection

	(self startSequence nextSequence first) addInstructionsBefore: aCollection.
	! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/11/2005 22:19'!
addLiteral: aSymbol
	
	additionalLiterals add: aSymbol.! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/12/2005 00:21'!
addLiterals: anArray
	
	additionalLiterals addAll: anArray.! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/10/2005 15:41'!
addTemps: newKeys
	
	tempKeys addAll: newKeys.! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/11/2005 22:19'!
additionalLiterals
	^additionalLiterals.! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/10/2005 16:07'!
allInstructions
	" return irNodes as a flat collection "

	| irInstructions |
	irInstructions := OrderedCollection new.
	startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | irInstructions add: bc]].
	^irInstructions! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/13/2005 10:41'!
allInstructionsMatching: aBlock
	" return irNodes as a flat collection "

	| irInstructions |
	irInstructions := OrderedCollection new.
	startSequence withAllSuccessorsDo: [:seq | seq do: [:bc | (aBlock value: bc) ifTrue: [irInstructions add: bc]]].
	^irInstructions! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/13/2005 10:40'!
allSendInstructions
	^self allInstructionsMatching: [:bc | bc isSend].! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 3/9/2003 15:35'!
allSequences

	^ startSequence withAllSuccessors! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/13/2005 11:06'!
allTempAccessInstructions
	^self allInstructionsMatching: [:bc | bc isTempAccess].! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/13/2005 10:39'!
allTempReadInstructions
	^self allInstructionsMatching: [:bc | bc isTempRead].! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/13/2005 10:40'!
allTempWriteInstructions
	^self allInstructionsMatching: [:bc | bc isTempStore].! !

!IRMethod methodsFor: 'decompiling' stamp: 'ajh 6/28/2004 13:44'!
ast

	^ IRDecompiler new decompileIR: self! !

!IRMethod methodsFor: 'translating' stamp: 'pmm 8/25/2006 15:02'!
compiledMethod

	^ compiledMethod ifNil: [self compiledMethodWith: #(0 0 0 0)]! !

!IRMethod methodsFor: 'translating' stamp: 'pmm 8/16/2006 20:56'!
compiledMethodWith: trailer

	^self compiledMethodWith: trailer using: CompiledMethod! !

!IRMethod methodsFor: 'translating' stamp: 'pmm 8/16/2006 20:55'!
compiledMethodWith: trailer using: aCompiledMethodClass

	^ compiledMethod _ IRTranslator new
		trailer: trailer;
		interpret: self;
		compiledMethodUsing: aCompiledMethodClass! !

!IRMethod methodsFor: 'initialize' stamp: 'md 11/22/2005 17:59'!
initialize

	primitiveNode _ PrimitiveNode null.
	tempKeys _ OrderedCollection new.
	properties _ MethodProperties new. 
	additionalLiterals _ OrderedCollection new.
! !

!IRMethod methodsFor: 'accessing' stamp: 'md 11/15/2004 17:08'!
ir
	^self.! !

!IRMethod methodsFor: 'testing' stamp: 'md 6/21/2005 13:56'!
isSend
	^false.! !

!IRMethod methodsFor: 'printing' stamp: 'ajh 3/9/2003 15:53'!
longPrintOn: stream

	IRPrinter new
		indent: 0;
		stream: stream;
		interpret: self! !

!IRMethod methodsFor: 'optimizing' stamp: 'md 8/10/2005 11:45'!
maxOrderNumber
	maxOrderNumber ifNil: [
		maxOrderNumber := self startSequence orderNumber.
		self startSequence withAllSuccessorsDo: [:seq | maxOrderNumber := maxOrderNumber max: seq orderNumber].			
	].
	^ maxOrderNumber.! !

!IRMethod methodsFor: 'accessing' stamp: 'md 6/16/2005 15:02'!
method
	^self.! !

!IRMethod methodsFor: 'inlining' stamp: 'md 8/2/2005 15:07'!
methodForInlining
	^self removeReturnSelf removeEmptyStart.! !

!IRMethod methodsFor: 'optimizing' stamp: 'md 9/26/2005 13:09'!
newSeq
	maxOrderNumber _ self maxOrderNumber  +1.
	^ IRSequence new  orderNumber:maxOrderNumber! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 6/25/2004 10:53'!
numArgs

	^ self numRargs - 1! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 6/25/2004 10:53'!
numRargs

	^ numRargs! !

!IRMethod methodsFor: 'initialize' stamp: 'ajh 6/25/2004 10:53'!
numRargs: n

	numRargs _ n! !

!IRMethod methodsFor: 'optimizing' stamp: 'ms 12/2/2006 23:03'!
optimize
	self removeEmptyStart.
	self absorbJumpsToSingleInstrs.
	self absorbConstantConditionalJumps.
	self absorbJumpsToSingleInstrs! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 3/10/2003 18:10'!
primitiveNode

	^ primitiveNode! !

!IRMethod methodsFor: 'initialize' stamp: 'ajh 3/10/2003 23:08'!
primitiveNode: aPrimitiveNode

	primitiveNode _ aPrimitiveNode! !

!IRMethod methodsFor: 'translating' stamp: 'ajh 3/10/2003 15:54'!
privCompiledMethod: aCompiledMethod

	compiledMethod _ aCompiledMethod! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/10/2005 22:06'!
properties
	^properties! !

!IRMethod methodsFor: 'accessing' stamp: 'md 7/10/2005 22:06'!
properties: propDict
	properties := propDict.! !

!IRMethod methodsFor: 'optimizing' stamp: 'ajh 3/18/2003 19:25'!
removeEmptyStart

	startSequence size = 1 ifTrue: [
		"startSeq is just unconditional jump, forget it"
		startSequence _ startSequence last destination].
! !

!IRMethod methodsFor: 'inlining' stamp: 'md 9/12/2005 12:00'!
removeReturn
	self allSequences last removeLast.! !

!IRMethod methodsFor: 'inlining' stamp: 'md 7/1/2005 17:34'!
removeReturnSelf
	self removeReturn.
	self allSequences last removeLast.! !

!IRMethod methodsFor: 'mapping' stamp: 'ajh 3/19/2003 13:38'!
sourceMap
	"Return a mapping from bytecode pcs to source code ranges"

	| start map |
	"Besides getting start position, make sure bytecodeIndices are filled in"
	start _ self compiledMethod initialPC - 1.  
	map _ OrderedCollection new.
	self allSequences do: [:seq |
		seq do: [:instr |  | node |
			((node _ instr sourceNode) notNil and: 
			 [node debugHighlightStart notNil and:
			  [node debugHighlightStop notNil and:
			   [instr bytecodeIndex notNil]]]) ifTrue: [
				map add:
					instr bytecodeIndex + start
						-> (node debugHighlightStart to: node debugHighlightStop)]
		]
	].
	^ map! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 3/10/2003 17:53'!
startSequence

	^ startSequence! !

!IRMethod methodsFor: 'initialize' stamp: 'md 7/9/2005 22:36'!
startSequence: irSequence

	startSequence _ irSequence.
	irSequence method: self.! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 6/25/2004 10:49'!
tempKeys

	^ tempKeys! !

!IRMethod methodsFor: 'initialize' stamp: 'ajh 6/25/2004 11:19'!
tempKeys: objects

	tempKeys _ objects! !

!IRMethod methodsFor: 'accessing' stamp: 'ajh 6/25/2004 10:52'!
tempNames
	"All temp names in context order"

	| varNames |
	varNames _ OrderedCollection new.
	self tempKeys do: [:var | | name |
		name _ var asString.
		"vars are unique but inlined to:do: loop vars may have the same name, so munge the names to make them different"
		[varNames includes: name] whileTrue: [name _ name, 'X'].
		varNames add: name.
	].
	^ varNames asArray! !

Object subclass: #IRSequence
	instanceVariableNames: 'sequence orderNumber method'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRSequence methodsFor: 'copying' stamp: 'dr 9/10/2005 20:59'!
, otherCollection 
	^sequence, otherCollection! !

!IRSequence methodsFor: 'optimizing' stamp: 'md 7/14/2005 11:56'!
absorbConstantConditionalJumps: alreadySeen
	"Collapse sequences that look like:
			[if] goto s1
			...
		 s1:	pushConst: true/false
			goto s2
		 s2:	if true/false goto s3 else s4
	into:
			[if] goto s3/s4

	These sequences are produced by and:/or: messages"

	| seq bool if |
	(alreadySeen includes: self) ifTrue: [^ self].
	alreadySeen add: self.

	[(seq := self successorSequences) size > 0  "not return"
	  and: [(seq := seq first "destination") size = 2
	   and: [(seq first isConstant: [:obj | (bool := obj) isKindOf: Boolean])
	    and: [seq last isGoto
	     and: [(if := seq last destination first) isIf]]]]
	] whileTrue: [ "absorb"
		self last destination: (bool == if boolean
			ifTrue: [if destination]
			ifFalse: [if otherwise]).
	].

	self successorSequences do: [:instrs | instrs absorbConstantConditionalJumps: alreadySeen].
! !

!IRSequence methodsFor: 'optimizing' stamp: 'md 7/14/2005 11:56'!
absorbJumpToSingleInstr: alreadySeen
	"Collapse jumps to single return instructions into caller"

	| seqs seq |
	(alreadySeen includes: self) ifTrue: [^ self].
	alreadySeen add: self.

	[ (seqs := self successorSequences) size = 1  "unconditional jump..." 
	   and: [(seq := seqs first) size = 1  "...to single instruction..."
	    and: [seq successorSequences size < 2]
		and: [self last isBlockReturnTop not]] "...but don't collapse conditional jumps so their otherwiseSequences can stay right after them"
	] whileTrue: [ "replace goto with single instruction"
		self removeLast.
		seq do: [:instr | self add: instr copy].
	].

	seqs do: [:instrs | instrs absorbJumpToSingleInstr: alreadySeen].
! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:57'!
add: anInstruction

	sequence add: anInstruction.
	anInstruction sequence: self.
	^anInstruction.! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:57'!
add: instr after: another

	sequence add: instr after: another.
	instr sequence: self.
	^instr.! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:58'!
add: instr before: another
	sequence add: instr before: another.
	instr sequence: self.
	^instr.! !

!IRSequence methodsFor: 'adding' stamp: 'dr 9/11/2005 15:35'!
addAll: aCollection
	^sequence addAll: aCollection! !

!IRSequence methodsFor: 'adding' stamp: 'md 9/28/2005 17:55'!
addAllFirst: aCollection
	^sequence addAllFirst: aCollection.! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:58'!
addInstructions: aCollection
	
	^aCollection do: [:instr | self add: instr].! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 11:57'!
addInstructions: aCollection after: anInstruction
	
	^aCollection reverseDo: [:instr | self add: instr after: anInstruction].! !

!IRSequence methodsFor: 'adding' stamp: 'md 7/14/2005 12:29'!
addInstructions: aCollection before: anInstruction

	aCollection do: [:instr | self add: instr before: anInstruction].! !

!IRSequence methodsFor: 'adding' stamp: 'dr 9/10/2005 20:57'!
addLast: anInstruction
	^self add: anInstruction.! !

!IRSequence methodsFor: 'accessing' stamp: 'md 9/29/2005 11:25'!
after: o
	^sequence after: o! !

!IRSequence methodsFor: 'accessing' stamp: 'dr 9/10/2005 21:01'!
at: index
	^sequence at: index! !

!IRSequence methodsFor: 'enumerating' stamp: 'dr 9/10/2005 21:02'!
detect: aBlock
	^sequence detect: aBlock! !

!IRSequence methodsFor: 'enumerating' stamp: 'md 7/14/2005 12:24'!
do: aBlock
	^sequence do: aBlock.! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:31'!
first
	^sequence first! !

!IRSequence methodsFor: 'testing' stamp: 'md 7/14/2005 12:30'!
ifEmpty: aBlock
	^sequence ifEmpty: aBlock! !

!IRSequence methodsFor: 'testing' stamp: 'md 7/14/2005 12:30'!
ifNotEmpty: aBlock
	^sequence ifNotEmpty: aBlock! !

!IRSequence methodsFor: 'initialize-release' stamp: 'md 7/14/2005 11:56'!
initialize
	sequence := OrderedCollection new.! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:58'!
instructionsDo: aBlock

	^self withAllSuccessorsDo: [:seq | seq do: aBlock].! !

!IRSequence methodsFor: 'testing' stamp: 'md 7/14/2005 12:23'!
isEmpty
	^sequence isEmpty! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:23'!
last
	^sequence last! !

!IRSequence methodsFor: 'printing' stamp: 'md 7/14/2005 11:59'!
longPrintOn: stream

	[IRPrinter new
		indent: 0;
		stream: stream;
		interpretSequence: self
	] onDNU: #orderNumber do: [:ex | ex resume: ex receiver]! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:00'!
method

	^method! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:00'!
method: aIRMethod

	method := aIRMethod! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:58'!
nextSequence

	| sequences i |
	sequences := self withAllSuccessors.
	i := sequences findFirst: [:seq | seq orderNumber = self orderNumber].
	(i = 0 or: [i = sequences size]) ifTrue: [^ nil].
	^ sequences at: i + 1! !

!IRSequence methodsFor: 'testing' stamp: 'dr 9/10/2005 20:55'!
notEmpty
	^sequence notEmpty! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:00'!
orderNumber
	"Sequences are sorted by this number"

	^ orderNumber! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:00'!
orderNumber: num
	"Sequences are sorted by this number"

	orderNumber := num.! !

!IRSequence methodsFor: 'printing' stamp: 'md 7/14/2005 12:00'!
printOn: stream

	stream nextPutAll: 'an '.
	self class printOn: stream.
	stream space.
	stream nextPut: $(.
	self orderNumber printOn: stream.
	stream nextPut: $).
! !

!IRSequence methodsFor: 'replacing' stamp: 'md 7/14/2005 12:00'!
remove: aNode
	aNode sequence: nil.
	sequence remove: aNode ifAbsent: [self error].! !

!IRSequence methodsFor: 'removing' stamp: 'dr 9/10/2005 21:03'!
removeFirst
	^sequence removeFirst.! !

!IRSequence methodsFor: 'removing' stamp: 'md 7/14/2005 12:25'!
removeLast
	^sequence removeLast.! !

!IRSequence methodsFor: 'replacing' stamp: 'md 7/14/2005 12:01'!
replaceNode: aNode withNode: anotherNode 

	self add: anotherNode before: aNode.
	sequence remove: aNode ifAbsent: [self error].! !

!IRSequence methodsFor: 'replacing' stamp: 'md 7/14/2005 12:01'!
replaceNode: aNode withNodes: aCollection 

	self addInstructions: aCollection before: aNode.
	sequence remove: aNode ifAbsent: [self error].! !

!IRSequence methodsFor: 'enumerating' stamp: 'md 7/14/2005 12:28'!
reverseDo: aBlock
	^sequence reverseDo: aBlock.! !

!IRSequence methodsFor: 'enumerating' stamp: 'md 7/14/2005 12:28'!
select: aBlock
	^sequence select: aBlock.! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:32'!
sequence
	^sequence! !

!IRSequence methodsFor: 'manipulating' stamp: 'dr 9/10/2005 20:58'!
setSuccessor: suc
	"find the blockReturnTops, set successor "

	self withAllSuccessorsDo: [:succ | succ notEmpty ifTrue: [
		| last |
		last := succ last.
		last isBlockReturnTop ifTrue: [ 
			last successor: suc.
		]
	]].! !

!IRSequence methodsFor: 'accessing' stamp: 'md 7/14/2005 12:25'!
size
	^sequence size.! !

!IRSequence methodsFor: 'manipulating' stamp: 'md 7/14/2005 13:22'!
splitAfter: instruction

	| newSeq index next |
	next := self nextSequence.
	next := next
		ifNil: [self orderNumber + 1]
		ifNotNil: [(next orderNumber + self orderNumber) / 2].
	newSeq := self class new orderNumber: next.
	newSeq method: self method.
	"Split after instruction"
	index := sequence indexOf: instruction.
	(sequence last: sequence size - index) do: [:instr | newSeq add: instr].
	sequence := sequence first: index.
	sequence add: (IRJump new destination: newSeq).
	^ newSeq! !

!IRSequence methodsFor: 'manipulating' stamp: 'md 7/14/2005 13:22'!
splitAfterNoJump: instruction

	| newSeq next index |
	next := self nextSequence.
	next := next
		ifNil: [self orderNumber + 1]
		ifNotNil: [(next orderNumber + self orderNumber) / 2].
	newSeq := self class new orderNumber: next.
	newSeq method: self method.
	
	"Split after instruction"
	index := sequence indexOf: instruction.
	(sequence last: sequence size - index) do: [:instr | newSeq add: instr].
	sequence := sequence first: index.

	^ newSeq! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
successorSequences

	sequence isEmpty ifTrue: [^ #()].
	^ sequence last successorSequences! !

!IRSequence methodsFor: 'manipulating' stamp: 'md 9/23/2005 14:42'!
tranformToBlockSequence
	| last |
	" fix: if last jump --> follow jumps, remove returns and add blockReturnTop on leafs."

	self withAllSuccessorsDo: [:succ | 
		succ notEmpty ifTrue: [
			last := succ last.
			last isJump ifFalse: [ 
				last isReturn ifTrue: [succ removeLast].
				succ addLast: IRInstruction blockReturnTop.
			]
		].
		succ ifEmpty: [succ addLast: IRInstruction blockReturnTop].
	].! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
withAllSuccessors
	"Return me and all my successors sorted by sequence orderNumber"

	| list |
	list := OrderedCollection new: 20.
	self withAllSuccessorsDo: [:seq | list add: seq].
	^ list asSortedCollection: [:x :y | x orderNumber <= y orderNumber]! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
withAllSuccessorsDo: block
	"Iterate over me and all my successors only once"

	self withAllSuccessorsDo: block alreadySeen: IdentitySet new! !

!IRSequence methodsFor: 'successor sequences' stamp: 'md 7/14/2005 11:59'!
withAllSuccessorsDo: block alreadySeen: set
	"Iterate over me and all my successors only once"

	(set includes: self) ifTrue: [^ self].
	set add: self.
	block value: self.
	self successorSequences do: [:seq |
		seq ifNotNil: [seq withAllSuccessorsDo: block alreadySeen: set]].
! !

Object subclass: #LexicalScope
	instanceVariableNames: 'outerScope'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!LexicalScope commentStamp: 'ajh 3/24/2003 21:53' prior: 0!
I am a symbol table where variable names are associated with SemVars.  Each context (method/closure) get a fresh scope that inherits from its outer scope.!

LexicalScope subclass: #ClassScope
	instanceVariableNames: 'class'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ClassScope commentStamp: 'ajh 3/24/2003 21:44' prior: 0!
I include all variable enries for class, pool and global vars.!

!ClassScope methodsFor: 'initializing' stamp: 'ajh 2/25/2003 20:10'!
class: aBehavior

	class _ aBehavior! !

!ClassScope methodsFor: 'lookup' stamp: 'ajh 2/25/2003 20:10'!
classEncoding

	^ class! !

!ClassScope methodsFor: 'levels' stamp: 'ajh 6/24/2004 04:03'!
instanceScope

	^ InstanceScope new
		vars: class allInstVarNames;
		outerScope: self! !

!ClassScope methodsFor: 'lookup' stamp: 'md 2/21/2006 14:10'!
lookupVar: name
	"Return a SemVar for my pool var with this name.  Return nil if none found"

	(class bindingOf: name asSymbol) ifNotNilDo: [:assoc | 
		^ GlobalVar new assoc: assoc; scope: self].
	^ nil
! !

!ClassScope methodsFor: 'levels' stamp: 'ajh 6/26/2004 17:56'!
newFunctionScope

	^ self instanceScope newFunctionScope! !

!ClassScope methodsFor: 'lookup' stamp: 'ajh 3/18/2003 15:42'!
possibleVarsFor: name continued: listOrNil
	"Return my pool var names that are close to name"

	name first isUppercase ifFalse: [^ listOrNil].
	^ class possibleVariablesFor: name continuedFrom: listOrNil! !

!ClassScope methodsFor: 'printing' stamp: 'ajh 2/25/2003 20:10'!
printOn: stream

	class printOn: stream.
	stream nextPutAll: ' parseScope'.
! !

!ClassScope methodsFor: 'lookup' stamp: 'md 2/21/2006 14:10'!
rawVar: name
	"Return a SemVar for my pool var with this name.  Return nil if none found"

	(class bindingOf: name asSymbol) ifNotNilDo: [:assoc | 
		^ GlobalVar new assoc: assoc; scope: self].
	^ nil
! !

LexicalScope subclass: #FunctionScope
	instanceVariableNames: 'thisContextVar thisEnvVar tempVars capturedVars isHome hasInnerFreeVars hideTemps'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!FunctionScope commentStamp: 'ajh 7/8/2004 18:33' prior: 0!
I am the symbol table (for declared temp vars) for methods and blocks (non-inlined closures). Scopes nest mirroring the block nesting (skipping inlined blocks like ifTrue: blocks). Variable references are looked up in the closest scope first then if not found searches the outer scope and so on. Temp variables found in an outer scope become captured in that outer scope. The emitPrologue: checks if any temp were captured and if so generates code that creates a ClosureEnvironment for those captured vars and copies any captured rargs (receiver and arguments) into it. This way MethodContexts are LIFO. Even a non-local (remote) return does not hold onto its home context, but rather holds onto its home context's environment. Upon return the caller stack is searched for the context that points to that home environment and returns to it. This allows stacks to be copied and blocks to still return to the correct context within the current thread.
!

FunctionScope subclass: #ContextDoItScope
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ContextDoItScope methodsFor: 'lookup' stamp: 'ajh 7/8/2004 17:06'!
captureVar: name
	"Don't convert temps to captured"

	^ self lookupVar: name! !

!ContextDoItScope methodsFor: 'parent env' stamp: 'ajh 7/8/2004 17:56'!
closestEnvScope
	"my temps are like inst vars, hence my own environment"

	^ self! !

!ContextDoItScope methodsFor: 'emitting' stamp: 'md 6/13/2005 13:58'!
emitEnvParentEnv: methodBuilder

	methodBuilder pushInstVar: (MethodContext allInstVarNames indexOf: #receiver).

	"return which scope my receiver points to"
	^ self outerEnvScope! !

!ContextDoItScope methodsFor: 'emitting' stamp: 'md 3/10/2006 15:55'!
emitLocalParentEnv: methodBuilder
	"local parent is held in receiver"

	"return which scope my receiver points to"
	^ self outerEnvScope! !

!ContextDoItScope methodsFor: 'emitting' stamp: 'md 6/13/2005 13:58'!
emitMyEnv: methodBuilder

	self flag: #myEnv.
	methodBuilder pushInstVar: MethodContext myEnvFieldIndex.! !

!ContextDoItScope methodsFor: 'emitting' stamp: 'md 3/10/2006 15:55'!
emitPrologue: methodBuilder
	self hasEscapingEnv ifFalse: [^ self].
	self emitCreateEnv: methodBuilder.
	self emitMoveCapturedRargs: methodBuilder.

! !

!ContextDoItScope methodsFor: 'initializing' stamp: 'ajh 7/8/2004 19:53'!
hideOuterTemps
	"Hide outer temps so they don't get captured (becuase they weren't captured and their values are not in the do-it env chain)"

	self outerScope tempsAreNoLongerAvailable! !

!ContextDoItScope methodsFor: 'scope' stamp: 'ajh 7/8/2004 17:15'!
isDoItScope

	^ true! !

!FunctionScope methodsFor: 'captured vars' stamp: 'ajh 7/8/2004 14:36'!
addCaptured: name

	self forceThisEnv.
	^ capturedVars add: (CapturedVar new
			name: name;
			index: capturedVars size + 1;
			scope: self)! !

!FunctionScope methodsFor: 'parent env' stamp: 'ajh 7/8/2004 16:01'!
addSlotForCapturedParentEnv

	| receiver |
	self hasInnerFreeVars ifFalse: [^ false].
	receiver _ self receiverVar.
	capturedVars do: [:var | var sourceTemp = receiver ifTrue: [^ false]].
	^ true! !

!FunctionScope methodsFor: 'temp vars' stamp: 'ajh 6/26/2004 17:46'!
addTemp: name

	^ tempVars add: (TempVar new
			name: name;
			index: tempVars size; "zero-based; receiver is at 0"
			scope: self)! !

!FunctionScope methodsFor: 'initializing' stamp: 'ajh 7/8/2004 20:23'!
asDoItScope

	^ (self primitiveChangeClassTo: ContextDoItScope basicNew) hideOuterTemps! !

!FunctionScope methodsFor: 'lookup' stamp: 'md 10/16/2004 20:56'!
captureVar: name
	"Return the ScopeVar with this name. If a temp move to captured."

	| var |

	capturedVars at: name ifPresent: [:v | ^ v].
	self hideTemps ifFalse: [
		tempVars at: name ifPresent: [:v | ^ self moveToCaptured: v]].
	(name = 'top env' and: [self isHome]) ifTrue: [^ self forceThisEnv].
	var _ self outerScope captureVar: name.
	(var notNil and: [var isGlobal not]) ifTrue: [self hasInnerFreeVars: true].
	^ var! !

!FunctionScope methodsFor: 'parent env' stamp: 'ajh 7/8/2004 16:00'!
capturedParentEnv

	| receiver |
	self hasInnerFreeVars ifFalse: [^ nil].
	receiver _ self receiverVar.
	capturedVars do: [:var | var sourceTemp = receiver ifTrue: [^ var]].
	"not added to captured list, but slot is created for it in emitCreateEnv.
	 It's not added since it was not captured directly by a variable reference in the code (only indirectly)"
	^ CapturedVar new
		name: 'env parent';
		index: capturedVars size + 1;
		scope: self! !

!FunctionScope methodsFor: 'captured vars' stamp: 'ajh 6/25/2004 22:24'!
capturedVars

	^ capturedVars asSortedCollection: [:x :y | x index <= y index]! !

!FunctionScope methodsFor: 'parent env' stamp: 'ajh 7/8/2004 14:26'!
closestEnvScope
	"If self has its own env return self, otherwise return first outer scope with its own env"

	self hasEscapingEnv ifTrue: [^ self].
	^ self outerScope closestEnvScope! !

!FunctionScope methodsFor: 'emitting' stamp: 'ajh 7/8/2004 16:02'!
emitCreateEnv: methodBuilder
	"Create a heap environment for my captured vars"

	methodBuilder
		pushLiteral: ClosureEnvironment;
		pushLiteral: capturedVars size + self addSlotForCapturedParentEnv asBit;
		send: #new:.
	self thisEnvVar emitLocalStore: methodBuilder.
	methodBuilder popTop.
! !

!FunctionScope methodsFor: 'emitting' stamp: 'md 3/9/2006 12:04'!
emitEnvParentEnv: methodBuilder

	Preferences compileBlocksAsClosures ifTrue:  [
		methodBuilder pushInstVar: self capturedParentEnv index.
	].

	"return which scope my parent env points to"
	^ self outerEnvScope! !

!FunctionScope methodsFor: 'emitting' stamp: 'md 3/9/2006 12:03'!
emitLocalParentEnv: methodBuilder
	"local parent is held in receiver"

	Preferences compileBlocksAsClosures ifTrue:  [
		self receiverVar emitLocalValue: methodBuilder.
	].

	"return which scope my receiver points to"
	^ self outerEnvScope! !

!FunctionScope methodsFor: 'emitting' stamp: 'md 6/13/2005 14:01'!
emitMoveCapturedRargs: methodBuilder

	self capturedVars do: [:var |
		| sourceTemp |
		sourceTemp _ var sourceTemp.
		sourceTemp ifNotNil: [
			sourceTemp emitLocalValue: methodBuilder.
			self thisEnvVar emitLocalValue: methodBuilder.
			methodBuilder storeInstVar: var index; popTop]].

	self addSlotForCapturedParentEnv ifTrue: [
		self receiverVar emitLocalValue: methodBuilder.
		self thisEnvVar emitLocalValue: methodBuilder.
		methodBuilder storeInstVar: capturedVars size + 1; popTop].
! !

!FunctionScope methodsFor: 'emitting' stamp: 'ajh 7/8/2004 17:12'!
emitMyEnv: methodBuilder

	thisEnvVar emitLocalValue: methodBuilder! !

!FunctionScope methodsFor: 'emitting' stamp: 'md 10/17/2004 14:14'!
emitPrologue: methodBuilder
	Preferences compileBlocksAsClosures ifTrue: [	
		self hasEscapingEnv ifFalse: [^ self].
		self emitCreateEnv: methodBuilder.
		self emitMoveCapturedRargs: methodBuilder.
	]
! !

!FunctionScope methodsFor: 'env' stamp: 'ajh 7/8/2004 14:37'!
forceThisEnv
	"create local env (if not already)"

	thisEnvVar ifNotNil: [^ thisEnvVar].
	^ thisEnvVar _ ThisEnvVar new
			name: 'thisEnv';
			index: -1;
			scope: self! !

!FunctionScope methodsFor: 'env' stamp: 'ajh 7/8/2004 14:30'!
hasEscapingEnv
	"has own env?"

	^ thisEnvVar notNil! !

!FunctionScope methodsFor: 'parent env' stamp: 'ajh 7/8/2004 15:38'!
hasInnerFreeVars
	"True if has inner scope that references to outer scope (non-global) variables. Indicates whether or not to add parent ref to local env"

	^ hasInnerFreeVars = true! !

!FunctionScope methodsFor: 'parent env' stamp: 'ajh 7/8/2004 15:37'!
hasInnerFreeVars: bool
	"True if has inner scope that references to outer scope (non-global) variables. Indicates whether or not to add parent ref to local env"

	hasInnerFreeVars _ bool! !

!FunctionScope methodsFor: 'temp vars' stamp: 'ajh 7/8/2004 19:50'!
hideTemps
	"If true do not allow inner scopes to capture my temps. Used by do-it scopes, which are fetching from an existing context env which no longer has its temps"

	^ hideTemps = true! !

!FunctionScope methodsFor: 'initializing' stamp: 'ajh 7/8/2004 14:24'!
initialize

	tempVars _ KeyedSet keyBlock: [:var | var name].
	capturedVars _ KeyedSet keyBlock: [:var | var name].
	thisContextVar _ ThisContextVar new
		name: 'thisContext';
		index: -2;
		scope: self.
! !

!FunctionScope methodsFor: 'scope' stamp: 'ajh 6/26/2004 13:57'!
isBlockScope

	^ self isMethodScope not! !

!FunctionScope methodsFor: 'scope' stamp: 'ajh 6/25/2004 15:18'!
isFunctionScope

	^ true! !

!FunctionScope methodsFor: 'scope' stamp: 'ajh 6/29/2004 16:38'!
isHome
	"the home scope is the one that returns (^) return from"

	^ isHome = true! !

!FunctionScope methodsFor: 'scope' stamp: 'ajh 6/29/2004 16:38'!
isHome: bool
	"the home scope is the one that returns (^) return from"

	isHome _ bool! !

!FunctionScope methodsFor: 'scope' stamp: 'ajh 6/29/2004 16:38'!
isMethodScope

	^ self isHome! !

!FunctionScope methodsFor: 'lookup' stamp: 'md 3/10/2006 15:53'!
lookupVar: name
	"Return the ScopeVar with this name. If found in outer scope then move it to captured."

	capturedVars at: name ifPresent: [:v | ^ v].
	tempVars at: name ifPresent: [:v | ^ v].
	name = 'thisEnv' ifTrue: [^ self forceThisEnv].
	name = 'thisContext' ifTrue: [^ thisContextVar].
	(name = 'top env' and: [self isHome]) ifTrue: [^ nil]. "'top env' used by return node"
	
	Preferences compileBlocksAsClosures ifFalse: [	
			^ self outerScope rawVar: name.
	].
	
	^ self outerScope captureVar: name! !

!FunctionScope methodsFor: 'captured vars' stamp: 'ajh 10/28/2004 23:41'!
moveToCaptured: tempVar
	"tempVar has been captured by an inner scope, move it from temps to captured. If tempVar is an arg, keep a temp version of it and link them via sourceTemp. tempVar 'becomes' a captured var so parse tree var nodes will keep pointer to its var."

	| newTempVar |
	self forceThisEnv.
	tempVar isArg ifTrue: [
		newTempVar _ tempVar copy.
		tempVars remove: tempVar.
		tempVars add: newTempVar.
		tempVar becomeCaptured.
		capturedVars add: tempVar.
		tempVar index: capturedVars size.
		tempVar sourceTemp: newTempVar.
	] ifFalse: [
		self removeTemp: tempVar.
		tempVar becomeCaptured.
		capturedVars add: tempVar.
		tempVar index: capturedVars size.
	].
	^ tempVar! !

!FunctionScope methodsFor: 'parent env' stamp: 'ajh 7/8/2004 14:26'!
outerEnvScope

	^ outerScope closestEnvScope! !

!FunctionScope methodsFor: 'scope' stamp: 'ajh 7/8/2004 14:19'!
popScope
	"Propogate free var usages to their outer vars, then return outer scope"

	^ self outerScope! !

!FunctionScope methodsFor: 'lookup' stamp: 'ajh 7/8/2004 16:10'!
possibleVarsFor: name continued: listOrNil
	"Return my var names that are close in spelling to name"

	| list |
	list _ listOrNil.
	name first isLowercase ifTrue: [
		{tempVars. capturedVars} do: [:vars |
			list _ name correctAgainstDictionary: vars continuedFrom: list]
	].
	^ self outerScope possibleVarsFor: name continued: list! !

!FunctionScope methodsFor: 'printing' stamp: 'ajh 3/20/2003 11:29'!
printOn: stream

	super printOn: stream.
	stream space.
	self scopeLevel printOn: stream.
! !

!FunctionScope methodsFor: 'lookup' stamp: 'ajh 10/28/2004 23:26'!
rawVar: name
	"Return the var with this name without capturing temps"

	capturedVars at: name ifPresent: [:v | ^ v].
	tempVars at: name ifPresent: [:v | ^ v].
	name = 'thisEnv' ifTrue: [^ self forceThisEnv].
	name = 'thisContext' ifTrue: [^ thisContextVar].
	^ self outerScope rawVar: name! !

!FunctionScope methodsFor: 'temp vars' stamp: 'ajh 6/25/2004 17:12'!
receiverVar

	^ self tempVars first! !

!FunctionScope methodsFor: 'decompiling' stamp: 'md 10/10/2004 15:02'!
receiverVarAt: instVarIndex

	^ self tempVars detect: [:var | var index = instVarIndex] ifNone: [
		| name |
		name _ 'f', instVarIndex asString.
		self tempVars at: name put: 
			(ScopeVar new
				name: name;
				receiverVar: self receiverVar;
				index: instVarIndex)
	  ]! !

!FunctionScope methodsFor: 'temp vars' stamp: 'ajh 6/25/2004 22:05'!
removeTemp: tempVar

	tempVars remove: tempVar.
	tempVars do: [:var |
		var index > tempVar index ifTrue: [
			var index: var index - 1]].
! !

!FunctionScope methodsFor: 'decompiling' stamp: 'ajh 6/27/2004 15:33'!
tempVarAt: tempIndex

	tempIndex = -2 ifTrue: [^ self thisContextVar].
	tempIndex = -1 ifTrue: [^ self thisEnvVar].
	^ tempVars detect: [:var | var index = tempIndex] ifNone: [
		| name |
		name _ String streamContents: [:str |
			self scopeLevel timesRepeat: [str nextPut: $t].
			tempIndex printOn: str].
		tempVars add: 
			(TempVar new
				name: name;
				index: tempIndex;
				scope: self)
	  ]! !

!FunctionScope methodsFor: 'temp vars' stamp: 'ajh 6/25/2004 22:23'!
tempVars

	^ tempVars asSortedCollection: [:x :y | x index <= y index]! !

!FunctionScope methodsFor: 'temp vars' stamp: 'ajh 7/8/2004 19:52'!
tempsAreNoLongerAvailable
	"Hide my temps and outer temps so they don't get captured (becuase they weren't captured and their values are not in the do-it env chain)"

	hideTemps _ true.
	self outerScope tempsAreNoLongerAvailable.
! !

!FunctionScope methodsFor: 'env' stamp: 'ajh 6/25/2004 17:11'!
thisContextVar

	^ thisContextVar! !

!FunctionScope methodsFor: 'env' stamp: 'ajh 6/25/2004 17:56'!
thisEnvVar

	^ thisEnvVar! !

LexicalScope subclass: #GlobalScope
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!GlobalScope commentStamp: 'ajh 3/24/2003 21:52' prior: 0!
When the class is not known, use me to at least find global vars.!

!GlobalScope methodsFor: 'lookup' stamp: 'ajh 2/26/2003 13:42'!
classEncoding
	"subclass responsibility, default is nil"

	^ nil! !

!GlobalScope methodsFor: 'lookup' stamp: 'md 2/21/2006 14:11'!
lookupVar: name
	"subclass responsibility, default is to look up global vars"

	(ProtoObject bindingOf: name asSymbol) ifNotNilDo: [:assoc | 
		^ GlobalVar new assoc: assoc; scope: self].
	^ nil
! !

!GlobalScope methodsFor: 'lookup' stamp: 'ajh 3/12/2003 12:10'!
possibleVarsFor: name continued: listOrNil
	"subclass responsibility, default is to look up global vars"

	name first isLowercase ifTrue: [^ listOrNil].
	^ ProtoObject possibleVariablesFor: name continuedFrom: listOrNil! !

!GlobalScope methodsFor: 'lookup' stamp: 'md 2/21/2006 14:11'!
rawVar: name
	"subclass responsibility, default is to look up global vars"

	(ProtoObject bindingOf: name asSymbol) ifNotNilDo: [:assoc | 
		^ GlobalVar new assoc: assoc; scope: self].
	^ nil
! !

LexicalScope subclass: #InstanceScope
	instanceVariableNames: 'vars'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!InstanceScope methodsFor: 'lookup' stamp: 'ajh 7/8/2004 14:55'!
closestEnvScope
	"If self has its own env return self, otherwise return first outer scope with its own env"

	^ self! !

!InstanceScope methodsFor: 'accessing' stamp: 'md 3/10/2006 12:17'!
emitEnvParentEnv: anIRBuilder 
	^self.! !

!InstanceScope methodsFor: 'lookup' stamp: 'ajh 6/28/2004 16:36'!
hasEscapingEnv

	^ true! !

!InstanceScope methodsFor: 'initializing' stamp: 'ajh 7/8/2004 20:26'!
isInstanceScope

	^ true! !

!InstanceScope methodsFor: 'lookup' stamp: 'ajh 6/24/2004 03:02'!
lookupVar: name
	"Return a SemVar for my pool var with this name.  Return nil if none found"

	^ vars at: name ifAbsent: [self outerScope lookupVar: name]! !

!InstanceScope methodsFor: 'lookup' stamp: 'ajh 6/24/2004 03:03'!
possibleVarsFor: name continued: listOrNil
	"Return my var names that are close in spelling to name"

	| list |
	list _ name first isLowercase
		ifTrue: [name correctAgainstDictionary: vars continuedFrom: listOrNil]
		ifFalse: [listOrNil].
	^ self outerScope possibleVarsFor: name continued: list! !

!InstanceScope methodsFor: 'lookup' stamp: 'ajh 6/24/2004 03:04'!
rawVar: name
	"Return a ScopeVar for my inst var with this name.  Return nil if none found"

	^ vars at: name ifAbsent: [self outerScope rawVar: name]! !

!InstanceScope methodsFor: 'initializing' stamp: 'ajh 7/8/2004 18:16'!
tempsAreNoLongerAvailable
	"done"
! !

!InstanceScope methodsFor: 'initializing' stamp: 'ajh 6/24/2004 04:10'!
vars: names

	self vars: names offset: 0! !

!InstanceScope methodsFor: 'initializing' stamp: 'ajh 7/8/2004 16:22'!
vars: names offset: k

	vars _ Dictionary new.
	names withIndexDo: [:name :index |
		vars at: name put:
			(CapturedVar new
				name: name;
				index: k + index;
				scope: self)
				markGiven].
! !

!LexicalScope methodsFor: 'adding' stamp: 'ajh 2/25/2003 22:44'!
addSelector: string

	^ string asSymbol! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 6/25/2004 22:00'!
captureVar: name

	^ self lookupVar: name! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 2/27/2003 00:40'!
classEncoding

	^ self outerScope classEncoding! !

!LexicalScope methodsFor: 'levels' stamp: 'ajh 7/8/2004 20:02'!
hasOuter: scope

	outerScope ifNil: [^ false].
	^ outerScope = scope or: [outerScope hasOuter: scope]! !

!LexicalScope methodsFor: 'scope' stamp: 'ajh 7/8/2004 18:39'!
isDoItScope

	^ false! !

!LexicalScope methodsFor: 'scope' stamp: 'ajh 6/25/2004 15:20'!
isFunctionScope

	^ false! !

!LexicalScope methodsFor: 'scope' stamp: 'ajh 7/8/2004 20:26'!
isInstanceScope

	^ false! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 2/25/2003 22:41'!
lookupSelector: name

	Symbol hasInterned: name ifTrue: [ :sym | ^ sym].
	^ nil! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 3/11/2003 20:19'!
lookupVar: name
	"subclass responsibility"

	^ self outerScope lookupVar: name! !

!LexicalScope methodsFor: 'levels' stamp: 'ajh 6/25/2004 17:27'!
newBlockScope

	^ self newFunctionScope! !

!LexicalScope methodsFor: 'levels' stamp: 'ajh 6/25/2004 17:26'!
newFunctionScope

	^ FunctionScope new outerScope: self! !

!LexicalScope methodsFor: 'levels' stamp: 'ajh 6/29/2004 16:37'!
newMethodScope

	^ self newFunctionScope isHome: true! !

!LexicalScope methodsFor: 'levels' stamp: 'ajh 2/26/2003 13:44'!
outerScope

	^ outerScope! !

!LexicalScope methodsFor: 'initializing' stamp: 'ajh 2/26/2003 13:43'!
outerScope: aSemScope

	outerScope _ aSemScope! !

!LexicalScope methodsFor: 'initializing' stamp: 'ajh 2/26/2003 20:01'!
parseScope

	^ self! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 2/25/2003 22:40'!
possibleSelectorsFor: string

	^ Symbol possibleSelectorsFor: string! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 2/25/2003 22:39'!
possibleVarsFor: string

	| list |
	list _ self possibleVarsFor: string continued: nil.
	^ string correctAgainst: nil continuedFrom: list
! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 3/11/2003 20:17'!
possibleVarsFor: name continued: listOrNil
	"subclass responsibility"

	^ self outerScope possibleVarsFor: name continued: listOrNil! !

!LexicalScope methodsFor: 'lookup' stamp: 'ajh 3/25/2003 23:38'!
rawVar: name
	"subclass responsibility"

	^ self outerScope rawVar: name! !

!LexicalScope methodsFor: 'old protocol' stamp: 'ajh 2/25/2003 20:09'!
requestor: editor
	"Old protocol, do nothing"
! !

!LexicalScope methodsFor: 'levels' stamp: 'ajh 3/20/2003 11:27'!
scopeLevel

	outerScope ifNil: [^ 0].
	^ outerScope scopeLevel + 1! !

Object subclass: #NewCompilerDocumentation
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!NewCompilerDocumentation commentStamp: 'md 7/23/2005 09:21' prior: 0!
This class is used for collection documentation... e.g. for classes outside of NewCompiler
(e.g. Compiler). This will go away at some point.!

!NewCompilerDocumentation methodsFor: 'as yet unclassified' stamp: 'md 6/8/2006 15:57'!
compiler
'
Comment for class Compiler:

Closure Compiler
by Anthony Hannan 3/13/2003

The Compiler class (like before) serves as the interface to the compiler.  If Preferences compileUseNewCompiler is true it will run the new closure compiler.  The closure compiler classes reside in their own system category called "Compiler", which is broken down into four minor categories: "Compiler-Syntax", "Compiler-Semantics", "Compiler-IR", and "Compiler-Bytecodes".  The closure compiler also uses classes in "SmaCC-Runtime".

Like most compilers, the closure compiler translates source text into bytecodes in a sequence of phases or transformations.

Phase 1 - Scan and parse text into abstract syntax tree (AST)

SqueakScanner and SqueakParser in "Compiler-Syntax" transform a method or do-it text into a Refactory abstract syntax tree.  SqueakScanner and SqueakParser classes were automatically generated using the SmaCC parser generator from a token and grammar specification derived from the StScanner and StParser specifications that comes with SmaCC.

Phase 2 - Verify and annotate AST (semantic analysis)

SemanticChecker in "Compiler-Semantics" binds RBVariableNodes in the AST to temp, instance, or pool (class, pool, or global) SemVars, raising a notifier if no match is found.  The lookup is performed on a chain of SemScopes, one for the class, method and each nested closure.  Var usage (read/write/capture-in-closure) is tracked using a FiniteAutomaton.  The final usage state is used to determine unused temps and escaping temps (temps whose storage need to reside independent of the context since a block may assign to it after the context is gone).

Phase 3 - Translate AST to intermediate representation (IR)

SemanticTranslator in "Compiler-Semantics" visits each node in the AST and invokes the appropriate instruction message on IRBuilder in "Compiler-IR" resulting in an IRMethod.  An IRMethod consists of IRInstructions grouped by IRSequence (basic block).  Each IRInstruction represents a simple stack instruction like pushTemp: or send:.

Phase 4 - Optimize IR

Two simple optimization are applied to the IRMethod: absorbJumpsToSingleInstrs and absorbConstantConditionalJumps. The first eliminates jumps to returns and returns directly.  The second converts chained constant jumps created by and:/or: to single jumps directly to the target code.

Phase 5 - Translate IR to bytecodes (CompiledMethod)

IRTranslator in "Compiler-IR" visits each IR instruction and invokes the appropriate bytecode message on BytecodeGenerator in "Compiler-Bytecodes".  Certain combinations of IR instructions (like storeTemp: and popTop) are mapped to a single bytecode instructions.
'! !

!Object methodsFor: '*newcompiler' stamp: 'ajh 6/29/2004 14:40'!
doItScope

	^ self class parseScope instanceScope! !

Object subclass: #Parser2
	instanceVariableNames: 'source requestor scope doitFlag failBlock endOfMethodPattern'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!Parser2 commentStamp: 'ajh 3/24/2003 21:36' prior: 0!
This mirrors the old Parser protocol but delegates to the real parser which is SqueakParser.!

!Parser2 class methodsFor: 'initialization' stamp: 'ajh 7/7/2004 13:49'!
initialize

	Smalltalk at: #ParseError put: SmaCCParserError.
! !

!Parser2 methodsFor: 'accessing' stamp: 'ajh 3/11/2003 12:16'!
classEncoding

	^ scope classEncoding! !

!Parser2 methodsFor: 'error correction' stamp: 'md 4/14/2007 00:37'!
correctSelector: messageNode
	"Correct the proposed selector in messageNode, correcting the original text if such action is indicated.  Fail if the proposedKeyword couldn't be converted into a valid selector.  Spots is an ordered collection of intervals within the test stream of the for each of the keyword parts."

	| alternatives aStream choice userSelection lines firstLine sel spots newSel |

	sel _ messageNode selector.
	"If we can't ask the user, assume that the keyword will be defined later"
	self interactive ifFalse: [^ sel].

	spots _ messageNode selectorParts collect: [:token | token sourceInterval].
	userSelection _ requestor selectionInterval.
	requestor selectFrom: spots first first to: spots last last.
	requestor select.
	alternatives _ messageNode owningScope possibleSelectorsFor: sel asString.

	aStream _ WriteStream on: (String new: 200).
	aStream nextPutAll: (sel asString contractTo: 35); cr.
	firstLine _ 1.
 	alternatives do: [:s | aStream nextPutAll: s; cr].
	aStream nextPutAll: 'cancel'.
	lines _ Array with: firstLine with: (alternatives size + firstLine).
	
	choice _ (PopUpMenu labels: aStream contents lines: lines)
		startUpWithCaption: 
'Unknown selector, please 
confirm, correct, or cancel'.

	(choice = 0) | (choice > (lines at: 2)) ifTrue: [^ self fail].

	requestor deselect.
	requestor selectInvisiblyFrom: userSelection first to: userSelection last.

	choice = 1 ifTrue: [^ sel].
	newSel _ alternatives at: choice - 1.
	self substituteSelector: newSel in: messageNode.
	((sel last ~~ $:) and: [newSel last == $:]) ifTrue: [^ self fail].
	^ (messageNode owningScope lookupSelector: newSel)
		ifNil: [self halt: 'chosen selector expected to exist']
! !

!Parser2 methodsFor: 'error correction' stamp: 'ms 9/16/2006 18:32'!
correctVariable: variableNode
	"Correct the variableNode to a known variable, or declare it as a new
	variable if such action is requested.  We support declaring lowercase
	variables as temps, and uppercase variables as Globals or ClassVars,
	depending on whether the context is nil (class=UndefinedObject)."

	| varName spot alternatives aStream choice userSelection temp binding declareSize prevToken nextToken tokenChange |

	varName _ variableNode name.
	"If we can't ask the user for correction, make it undeclared"
	self interactive ifFalse: [
		Transcript show: ' (' , varName , ' is Undeclared) '.
		varName _ varName asSymbol.
		Undeclared at: varName put: nil.
		^ GlobalVar new assoc: (Undeclared associationAt: varName); scope: scope
	].

	spot _ variableNode sourceInterval.
	temp _ varName first isLowercase.
	"First check to see if the requestor knows anything about the variable"
	(temp and: [(binding _ requestor bindingOf: varName) notNil])
		ifTrue: [^ GlobalVar new assoc: binding; scope: scope].
	userSelection _ requestor selectionInterval.
	requestor selectFrom: spot first to: spot last.
	requestor select.

	alternatives _ variableNode owningScope possibleVarsFor: varName.

	aStream _ WriteStream on: (String new: 200).
	temp ifTrue: [
		declareSize _ 1.
		aStream nextPutAll: 'declare temp'; cr.
	] ifFalse: [
		declareSize _ 1.
		self classEncoding ifNotNil: [
			declareSize _ declareSize + 1.  
			aStream nextPutAll: 'declare class variable'; cr].
		aStream nextPutAll: 'declare global'; cr.
	].
	alternatives do: [:name | aStream nextPutAll: name; cr].
	aStream nextPutAll: 'cancel'.

	choice _ (PopUpMenu labels: aStream contents
				lines: {declareSize. declareSize + alternatives size})
		startUpWithCaption:
(('Unknown variable: ', varName, '
please correct, or cancel:') asText makeBoldFrom: 19 to: 19 + varName size).

	(choice = 0 or: [choice > (declareSize + alternatives size)]) ifTrue: [^ self fail].

	requestor deselect.
	requestor selectInvisiblyFrom: userSelection first to: userSelection last.
	temp ifTrue: [
		choice = 1 ifTrue: [^ self declareTempAndPaste: variableNode]
	] ifFalse: [
		declareSize = 1 ifTrue: [
			choice = 1 ifTrue: [^ self declareGlobal: variableNode].
		] ifFalse: [ "declareSize = 2"
			choice = 1 ifTrue: [^ self declareClassVar: variableNode].
			choice = 2 ifTrue: [^ self declareGlobal: variableNode].
		].
	].

	"Spelling correction"
	varName _ alternatives at: choice - declareSize.
	prevToken := variableNode token previous.
	nextToken := variableNode token next.
	tokenChange := SqueakToken value: varName start: spot first prevToken: prevToken.
	nextToken previous: tokenChange.
	variableNode changeToken: tokenChange.
	self substituteWord: varName wordInterval: spot offset: 0.
	^ (variableNode owningScope lookupVar: varName)
		ifNil: [self halt: 'var should have been found']! !

!Parser2 methodsFor: 'error correction' stamp: 'ajh 3/20/2003 01:30'!
declareClassVar: variableNode

	self classEncoding theNonMetaClass
		addClassVarName: variableNode name asSymbol.
	^ (variableNode owningScope lookupVar: variableNode name)
		ifNil: [self halt: 'should be found']! !

!Parser2 methodsFor: 'error correction' stamp: 'ajh 3/20/2003 01:30'!
declareGlobal: variableNode

	Smalltalk at: variableNode name asSymbol put: nil.
	^ (variableNode owningScope lookupVar: variableNode name)
		ifNil: [self halt: 'should be found']! !

!Parser2 methodsFor: 'error correction' stamp: 'ms 9/17/2006 14:51'!
declareTempAndPaste: variableNode

	| name insertion theTextString methodBody pos start c var tempNode prev prevToken nextToken tokenChange |
	
	name := variableNode name.
	theTextString := requestor text string.
	methodBody := variableNode root body.
	methodBody temporaries notEmpty ifTrue: [
  		"Paste it after last temp"
		prev := pos := methodBody temporaries last stop + 1.
		prevToken := methodBody temporaries last token previous.
		nextToken := methodBody temporaries last token next.
		(theTextString at: pos) isSeparator ifTrue: [
			insertion := name, ' '.
			pos := pos + 1.  start _ pos.
		] ifFalse: [
			insertion := ' ', name.
			start := pos + 1.
		].
		self substituteWord: insertion
			wordInterval: (pos to: pos - 1) offset: 0.
	] ifFalse: [
		"No bars - insert some with CR & tab"
		insertion := '| ', name, ' |', String cr.
		prev := pos := methodBody statements first start - 1.
		start := 0.
		[pos = 0 or: [(c := theTextString at: pos) = Character cr]] whileFalse: [
			c isSeparator ifTrue: [
				insertion := c asString, insertion.
				start := start + 1.
			].
			pos := pos - 1.
		].
		pos := pos + 1.
		self substituteWord: insertion
			wordInterval: (pos to: pos - 1) offset: 0.
		start := pos + 2 + start.
		
		prevToken := SqueakToken value: '|' start: start.
		methodBody parent lastTokenOfPatternMethod insertAfterMe: prevToken.
		nextToken := SqueakToken value: '|' start: start + 1.
		prevToken insertAfterMe: nextToken.
	].
	var := methodBody owningScope addTemp: name.
	"change token to be linked with the other"
	tokenChange := SqueakToken value: name  start: start prevToken: prevToken.
	nextToken previous: tokenChange.
	tempNode := RBVariableNode new
		identifierToken: tokenChange;
		binding: var.
	methodBody root adjustPositionsAfter: prev by: insertion size.
	methodBody temporaries: (methodBody temporaries copyWith: tempNode).
	^ (variableNode owningScope lookupVar: name)
		ifNil: [self halt: 'should have been found']! !

!Parser2 methodsFor: 'accessing' stamp: 'ajh 3/25/2003 23:45'!
encoder

	^ self! !

!Parser2 methodsFor: 'old protocol' stamp: 'ajh 3/11/2003 20:01'!
endOfLastToken

	^ endOfMethodPattern! !

!Parser2 methodsFor: 'error handling' stamp: 'ajh 3/6/2003 01:03'!
fail

	^ failBlock value! !

!Parser2 methodsFor: 'error handling' stamp: 'ajh 5/19/2004 17:31'!
interactive

	requestor == nil ifTrue: [^ false].
	(requestor isKindOf: SyntaxError) ifTrue: [^ false].
	(requestor respondsTo: #interactive) ifTrue: [^ requestor interactive].
	^ true! !

!Parser2 methodsFor: 'error handling' stamp: 'ms 1/7/2007 02:01'!
notify: string at: location

	requestor isNil
		ifTrue: [
			SyntaxErrorNotification
					inClass: (self classEncoding ifNil: [FakeClassPool])
					category: (self classEncoding ifNil: [FakeClassPool]) category
					withCode: 
						(source contents
							copyReplaceFrom: location
							to: location - 1
							with: string , ' ->')
					doitFlag: doitFlag]
		ifFalse: [requestor
					notify: string , ' ->'
					at: location
					in: source].
	^self fail! !

!Parser2 methodsFor: 'public access' stamp: 'ajh 3/11/2003 14:35'!
parse: sourceStreamOrString class: behavior

	^ self parse: sourceStreamOrString readStream class: behavior
		noPattern: false notifying: nil ifFail: [nil]! !

!Parser2 methodsFor: 'public access' stamp: 'md 11/22/2005 18:08'!
parse: sourceStream class: class category: aCategory noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
        "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)."
 
        	^ self parse: sourceStream class: class  noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
! !

!Parser2 methodsFor: 'public access' stamp: 'ajh 9/14/2002 09:28'!
parse: sourceStream class: behavior noPattern: noPattern context: context notifying: req ifFail: aBlock
	"Backwards compatibilty"

	context ifNotNil: [self error: 'Use Compiler-evaluate... instead'].
	^ self parse: sourceStream class: behavior noPattern: noPattern notifying: req ifFail: aBlock! !

!Parser2 methodsFor: 'public access' stamp: 'ms 1/7/2007 01:49'!
parse: sourceStream class: parseScope noPattern: doitBool notifying: req ifFail: aBlock
	"Parse sourceStream into a embedded BlockNode if doitFlag is true (no method header) or a MethodNode if doitFlag is false.  Parsing is done with respect to parseScope to find non-local variables.  Errors in parsing are reported to req if not nil followed by executing the fail block."

	| parser |

	source := sourceStream.
	requestor := req.
	doitFlag := doitBool.
	scope := parseScope parseScope.
	failBlock := [^ aBlock value].

	parser := self realParserClass.

	^ [	| tree |
		tree := doitFlag 
			ifTrue: [parser parseDoIt: source]
			ifFalse: [parser parseMethod: source].
		[tree verifyIn: scope] on: SemanticWarning do: [:ex | ex correctIn: self]
	 ] on: UnhandledError do: [:uEx | | ex |
		ex := uEx exception.
		(SmaCCParserError handles: ex)
			ifTrue: [self notify: ex description at: ex tag position]
			ifFalse: [uEx pass]
	 ]! !

!Parser2 methodsFor: 'public access' stamp: 'ajh 3/6/2003 00:42'!
parseArgsAndTemps: aString notifying: req 
	"No initialization required.  Parse the argument, aString, notifying req if an error occurs. Otherwise, answer a two-element Array containing Arrays of strings (the argument names and temporary variable names)."

	aString == nil ifTrue: [^ #()].

	^ (self parse: aString readStream class: nil noPattern: false notifying: req ifFail: [^ nil]) tempNames! !

!Parser2 methodsFor: 'public access' stamp: 'ms 7/15/2006 15:35'!
parseMethodComment: aString setPattern: aBlock
	"Answer the method comment for the argument, aString. Evaluate aBlock with the methodNode containing the selector and arguments"

	| methodNode comments |
	methodNode := self realParserClass parseMethod: aString.
	endOfMethodPattern := methodNode methodPatternStop.
	aBlock value: methodNode.
	comments := methodNode comments.
	comments isEmpty ifTrue: [^ nil].
	^ comments first! !

!Parser2 methodsFor: 'public access' stamp: 'pmm 5/28/2006 16:05'!
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."

	| methodNode |
	methodNode := self realParserClass parseMethodPattern: aString.
	endOfMethodPattern := methodNode methodPatternStop.
	^ methodNode selector! !

!Parser2 methodsFor: 'error correction' stamp: 'ajh 3/12/2003 14:34'!
queryUninitializedTemp: variableNode

	| varStart varName |
	self interactive ifFalse: [^ self].
	varName _ variableNode name.
	varStart _ variableNode start.
	requestor selectFrom: varStart to: varStart + varName size - 1; select.
	((PopUpMenu labels:
'yes
no') startUpWithCaption:
		((varName , ' appears to be
undefined at this point.
Proceed anyway?') asText makeBoldFrom: 1 to: varName size))
		= 1 ifFalse: [^ self fail]! !

!Parser2 methodsFor: 'accessing' stamp: 'pmm 5/28/2006 16:03'!
realParserClass

	^ SqueakParser! !

!Parser2 methodsFor: 'error correction' stamp: 'ajh 3/15/2003 13:27'!
removeUnusedTemp: variableNode
	"Removing unused temp, variableNode, if verified by the user"

	| varName interval |
	self interactive ifFalse: [^ self].  "don't remove and continue"
	varName _ variableNode name.
	((PopUpMenu labels: 'yes\no' withCRs) startUpWithCaption:
		((varName , ' appears to be
unused in this method.
OK to remove it?') asText makeBoldFrom: 1 to: varName size))
			= 1 ifFalse: [^ self].  "don't remove and continue"

	"Remove temp then continue"
	interval _ variableNode sourceInterval.
	(requestor text at: interval last + 1) isSeparator ifTrue: [
		interval _ interval first to: interval last + 1].
	self substituteWord: '' wordInterval: interval offset: 0.
	variableNode root adjustPositionsAfter: interval first by: 0 - interval size.
	variableNode parent removeTemporaryNamed: varName.
	^ self! !

!Parser2 methodsFor: 'accessing' stamp: 'ajh 3/10/2003 22:17'!
requestor
	"Return the source code editor"

	^ requestor! !

!Parser2 methodsFor: 'accessing' stamp: 'ajh 6/9/2002 19:47'!
requestor: editor
	"set the source code editor"

	requestor _ editor! !

!Parser2 methodsFor: 'error correction' stamp: 'ms 9/17/2006 15:05'!
substituteSelector: newSel in: messageNode
	"Substitute the correctSelector into the (presuamed interactive) receiver."

	| offset newParts |
	newParts _ OrderedCollection new.
	offset _ 0.
	newSel keywords
	  with: (messageNode selectorParts)
	  do: [:word :tok |
		newParts add: ((SqueakToken value: word start: tok sourceInterval first + offset) substitueTo: tok).
		offset _ self substituteWord: word wordInterval: tok sourceInterval offset: offset.
	  ].
	messageNode changeSelectorParts: newParts asArray.
! !

!Parser2 methodsFor: 'error correction' stamp: 'ajh 3/11/2003 23:22'!
substituteWord: correctWord wordInterval: spot offset: o
	"Substitute the correctSelector into the (presuamed interactive) receiver."

	requestor
		correctFrom: (spot first + o)
		to: (spot last + o)
		with: correctWord.
	^ o + correctWord size - spot size! !

!Parser2 methodsFor: 'error correction' stamp: 'ajh 3/19/2003 16:43'!
variable: varNode shadows: semVar

	self interactive ifFalse: [
		^ Transcript show: '(', varNode name, ' is shadowed)'].
	self notify: 'Name already defined' at: varNode start.
! !

Object subclass: #Recompiler
	instanceVariableNames: 'problemMethods'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Extras'!

!Recompiler commentStamp: 'ajh 7/8/2004 21:18' prior: 0!
[Recompiler new inspect; recompileImage] forkAt: 30
!

!Recompiler methodsFor: 'problem methods' stamp: 'ajh 5/19/2004 18:16'!
initialize

	problemMethods _ OrderedCollection new.
! !

!Recompiler methodsFor: 'requestor interface' stamp: 'ajh 5/19/2004 17:32'!
interactive
	"Batch compiling, not interactive"

	^ false! !

!Recompiler methodsFor: 'requestor interface' stamp: 'ajh 5/19/2004 17:32'!
notify: aString at: anInteger in: aStream
	"Called from Parser2 on syntax error. Do nothing and let fail block handle it"
! !

!Recompiler methodsFor: 'problem methods' stamp: 'ajh 5/19/2004 18:16'!
problem: reason sel: selector in: class

	problemMethods add: {class. selector. reason}! !

!Recompiler methodsFor: 'recompile' stamp: 'ajh 7/8/2004 20:42'!
recompile: selector in: class
	"Recompile method in class. If method can't be recompiled (because of compile error) add it to problemMethods with general reason"

	| source oldMethod trailer methodNode newMethod |
	oldMethod _ class compiledMethodAt: selector.
	"oldMethod isClosureCompiled ifTrue: [^ self]."
	source _ class sourceCodeAt: selector.
	source ifNil: [^ self problem: 'no source' sel: selector in: class].
	trailer _ oldMethod trailer.
	methodNode _ Compiler new
		compile: source in: class notifying: self
		ifFail: [^ self problem: 'syntax error' sel: selector in: class].
	selector == methodNode selector ifFalse: [
		^ self problem: 'selector changed' sel: selector in: class].
	newMethod _ methodNode generate: trailer.
	class addSelectorSilently: selector withMethod: newMethod.
! !

!Recompiler methodsFor: 'recompile' stamp: 'ajh 5/19/2004 23:29'!
recompileClass: class

	{class. class class} do: [:behavior |
		behavior selectorsDo: [:selector |
			[self recompile: selector in: behavior]
				on: Error
				do: [:ex | self problem: ex description sel: selector in: behavior]]]
! !

!Recompiler methodsFor: 'recompile' stamp: 'md 7/19/2006 15:25'!
recompileImage
	"Recomiles all class/instance methods in image. Methods that can't be recompiled (because of compile error) are added to problemMethods and are not recompiled"

	"ProtoObject allSubclasses includes metaclasses"
	| m |
	m _ 0.
	Smalltalk allClassesAndTraitsDo: [:class | m _ m + 1].
	'Recompiling ', m printString, ' classes and traits'
		displayProgressAt: Sensor cursorPoint from: 0 to: m
		during: [:bar | | n |
			n _ 0.
			Smalltalk allClassesDo: [:class |
				self recompileClass: class.
				bar value: (n _ n + 1)].
			self recompileClass: ProtoObject.
		].
! !

Object subclass: #ScopeVar
	instanceVariableNames: 'scope usage'
	classVariableNames: 'UsageAutomaton'
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ScopeVar commentStamp: 'ajh 3/24/2003 22:38' prior: 0!
I am an entry in a SemScope that gets associated with variable nodes of the same name.  There a three different subclasses of vars: temp vars, field vars, and pool/global vars.!

ScopeVar subclass: #GlobalVar
	instanceVariableNames: 'assoc'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!GlobalVar commentStamp: 'ajh 3/24/2003 21:53' prior: 0!
I am a global, pool, or class variable.!

!GlobalVar methodsFor: 'initializing' stamp: 'ajh 2/26/2003 17:31'!
assoc: anAssociation

	assoc _ anAssociation! !

!GlobalVar methodsFor: 'emitting' stamp: 'md 10/4/2005 17:23'!
emitStore: methodBuilder from: refScope
	self flag: #fixme.

	methodBuilder storeIntoLiteralVariable: assoc.

	"methodBuilder pushLiteral: assoc.
	methodBuilder send: #privSetInHolder:."
! !

!GlobalVar methodsFor: 'emitting' stamp: 'md 7/9/2005 22:15'!
emitValue: methodBuilder from: refScope

	methodBuilder pushLiteralVariable: assoc.! !

!GlobalVar methodsFor: 'accessing' stamp: 'ajh 7/8/2004 16:25'!
isGlobal

	^ true! !

!GlobalVar methodsFor: 'accessing' stamp: 'ajh 7/2/2004 14:15'!
name

	^ assoc name! !

!GlobalVar methodsFor: 'accessing' stamp: 'ms 8/5/2006 14:35'!
value
	^assoc value! !

ScopeVar subclass: #LocalVar
	instanceVariableNames: 'name index'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!LocalVar commentStamp: 'ajh 3/24/2003 21:54' prior: 0!
I am an argument or temporary variable of a method or block.!

LocalVar subclass: #CapturedVar
	instanceVariableNames: 'sourceTemp'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!CapturedVar commentStamp: 'ajh 3/24/2003 21:52' prior: 0!
I'm a field var of some receiverVar.  if receiverVar is 'self' than I am an instance variable.  If receiverVar is a closure than I am a free variable (outer temp reference) and my outerVar is the outer reference var.!

!CapturedVar methodsFor: 'emitting' stamp: 'md 6/13/2005 14:01'!
emitEnvStore: methodBuilder

	self scope isDoItScope ifTrue: [self scope emitMyEnv: methodBuilder].
	methodBuilder storeInstVar: self index! !

!CapturedVar methodsFor: 'emitting' stamp: 'md 6/13/2005 13:58'!
emitEnvValue: methodBuilder

	self scope isDoItScope ifTrue: [self scope emitMyEnv: methodBuilder].
	methodBuilder pushInstVar: self index.
! !

!CapturedVar methodsFor: 'emitting' stamp: 'md 3/10/2006 16:31'!
emitLocalStore: methodBuilder
	Preferences compileBlocksAsClosures ifTrue: [	
		self scope emitMyEnv: methodBuilder.	
	].
	methodBuilder storeInstVar: self index.
	
	
	! !

!CapturedVar methodsFor: 'emitting' stamp: 'md 3/10/2006 16:31'!
emitLocalValue: methodBuilder
	Preferences compileBlocksAsClosures ifTrue: [	
		self scope emitMyEnv: methodBuilder.
	].
	methodBuilder pushInstVar: self index.! !

!CapturedVar methodsFor: 'accessing' stamp: 'ajh 6/24/2004 15:15'!
isCaptured

	^ true! !

!CapturedVar methodsFor: 'accessing' stamp: 'ajh 6/25/2004 22:18'!
sourceTemp

	^ sourceTemp! !

!CapturedVar methodsFor: 'initializing' stamp: 'ajh 6/25/2004 22:18'!
sourceTemp: tempVarOrNil

	sourceTemp _ tempVarOrNil! !

!LocalVar methodsFor: 'emitting' stamp: 'md 8/24/2006 12:11'!
emitEnvStore: methodBuilder from: refScope

	| nextParent |

	refScope = self scope ifTrue: [^ self emitEnvStore: methodBuilder].
	refScope isInstanceScope ifTrue: [^ self emitEnvStore: methodBuilder].

	"self is being referenced from an inner scope (refScope), emit its parent env and recurse"
	nextParent _ refScope emitEnvParentEnv: methodBuilder.
	self emitEnvStore: methodBuilder from: nextParent.
! !

!LocalVar methodsFor: 'emitting' stamp: 'md 8/24/2006 12:11'!
emitEnvValue: methodBuilder from: refScope

	| nextParent |

	refScope = self scope ifTrue: [^ self emitEnvValue: methodBuilder].
	refScope isInstanceScope ifTrue: [^ self emitEnvValue: methodBuilder].

	"self is being referenced from an inner scope (refScope), emit its parent env and recurse"
	nextParent _ refScope emitEnvParentEnv: methodBuilder.
	self emitEnvValue: methodBuilder from: nextParent.
! !

!LocalVar methodsFor: 'emitting' stamp: 'md 3/10/2006 16:23'!
emitStore: methodBuilder from: refScope

	| nextParent |
	
	refScope = self scope ifTrue: [^ self emitLocalStore: methodBuilder].
	
	"self is being referenced from an inner scope (refScope), emit its parent env and recurse"
	nextParent _ refScope emitLocalParentEnv: methodBuilder.
	self emitEnvStore: methodBuilder from: nextParent.
! !

!LocalVar methodsFor: 'emitting' stamp: 'md 3/10/2006 16:17'!
emitValue: methodBuilder from: refScope

	| nextParent |

	refScope = self scope ifTrue: [^ self emitLocalValue: methodBuilder].

	"self is being referenced from an inner scope (refScope), emit its parent env and recurse"
	nextParent _ refScope emitLocalParentEnv: methodBuilder.
	self emitEnvValue: methodBuilder from: nextParent. 

	! !

!LocalVar methodsFor: 'accessing' stamp: 'ajh 3/18/2003 11:30'!
index

	^ index! !

!LocalVar methodsFor: 'initializing' stamp: 'ajh 6/23/2004 22:43'!
index: n

	index _ n! !

!LocalVar methodsFor: 'read/write usage' stamp: 'ajh 7/8/2004 16:21'!
isUndefined

	^ usage isNil! !

!LocalVar methodsFor: 'read/write usage' stamp: 'ajh 6/28/2004 10:10'!
markArg
	"mark given"

	usage _ #arg! !

!LocalVar methodsFor: 'accessing' stamp: 'ajh 6/23/2004 22:51'!
name

	^ name! !

!LocalVar methodsFor: 'initializing' stamp: 'ajh 6/23/2004 22:47'!
name: string

	name _ string! !

LocalVar subclass: #TempVar
	instanceVariableNames: 'isArg'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!TempVar methodsFor: 'initializing' stamp: 'ajh 6/29/2004 17:05'!
becomeCaptured
	"TempVar has to become a captured var so parse tree var nodes will point to the captured var. Use change-class instead of become for speed. In order to do this both TempVar and CapturedVar has to have the same number of inst vars"

	isArg "sourceTemp" _ nil.
	self primitiveChangeClassTo: CapturedVar basicNew.
! !

!TempVar methodsFor: 'emitting' stamp: 'md 3/10/2006 16:27'!
emitEnvStore: methodBuilder
	(Preferences compileBlocksAsClosures or: [self scope isDoItScope])
		ifTrue: [ self scope isDoItScope ifFalse: [self error: 'should have been captured'].
				  methodBuilder storeInstVar: (MethodContext instSize + self index).]
		ifFalse: [ self emitLocalStore: methodBuilder].! !

!TempVar methodsFor: 'emitting' stamp: 'md 3/10/2006 16:19'!
emitEnvValue: methodBuilder
	(Preferences compileBlocksAsClosures or: [self scope isDoItScope]) ifTrue: [
	self scope isDoItScope ifFalse: [self error: 'should have been captured'].
	methodBuilder pushInstVar: (MethodContext instSize + self index).
	] ifFalse: [self emitLocalValue: methodBuilder].! !

!TempVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 14:10'!
emitLocalStore: methodBuilder

	methodBuilder storeTemp: self.
! !

!TempVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 14:10'!
emitLocalValue: methodBuilder

	methodBuilder pushTemp: self.
! !

!TempVar methodsFor: 'read/write usage' stamp: 'ajh 6/25/2004 22:11'!
isArg

	^ isArg = true! !

!TempVar methodsFor: 'accessing' stamp: 'ajh 6/23/2004 23:18'!
isTemp

	^ true! !

!TempVar methodsFor: 'read/write usage' stamp: 'ajh 6/25/2004 22:11'!
markArg

	isArg _ true.
	usage _ #arg! !

LocalVar subclass: #ThisContextVar
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ThisContextVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 14:12'!
emitLocalValue: methodBuilder

	methodBuilder pushThisContext.
! !

!ThisContextVar methodsFor: 'accessing' stamp: 'ajh 6/25/2004 16:52'!
isUndefined

	^ false! !

LocalVar subclass: #ThisEnvVar
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ThisEnvVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 14:13'!
emitEnvValue: methodBuilder

	"do nothing, env is on top"
! !

!ThisEnvVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 14:14'!
emitLocalStore: methodBuilder

	methodBuilder storeThisEnv.
! !

!ThisEnvVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 14:14'!
emitLocalValue: methodBuilder

	methodBuilder pushThisEnv.
! !

!ThisEnvVar methodsFor: 'accessing' stamp: 'ajh 6/25/2004 17:54'!
isUndefined

	^ false! !

!ScopeVar class methodsFor: 'instance creation' stamp: 'md 7/5/2005 15:29'!
new
	^super basicNew! !

!ScopeVar methodsFor: 'accessing' stamp: 'ajh 3/16/2003 20:08'!
asString

	^ self name! !

!ScopeVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 10:47'!
emitStore: methodBuilder from: refScope

	self subclassResponsibility! !

!ScopeVar methodsFor: 'emitting' stamp: 'ajh 7/8/2004 10:47'!
emitValue: methodBuilder from: refScope

	self subclassResponsibility! !

!ScopeVar methodsFor: 'accessing' stamp: 'ajh 6/23/2004 22:44'!
isCaptured

	^ false! !

!ScopeVar methodsFor: 'accessing' stamp: 'ajh 7/8/2004 16:25'!
isGlobal

	^ false! !

!ScopeVar methodsFor: 'accessing' stamp: 'md 11/22/2005 16:29'!
isInstance
	^self scope isInstanceScope
! !

!ScopeVar methodsFor: 'accessing' stamp: 'md 11/22/2005 16:29'!
isRead
	^usage = #read
! !

!ScopeVar methodsFor: 'accessing' stamp: 'ajh 3/18/2003 11:13'!
isTemp

	^ false! !

!ScopeVar methodsFor: 'read/write usage' stamp: 'ajh 6/25/2004 11:58'!
isUndefined

	^ false! !

!ScopeVar methodsFor: 'read/write usage' stamp: 'ajh 7/8/2004 16:18'!
isUnused

	^ usage isNil! !

!ScopeVar methodsFor: 'accessing' stamp: 'md 11/22/2005 16:29'!
isWrite
	^usage = #write
! !

!ScopeVar methodsFor: 'read/write usage' stamp: 'ajh 7/8/2004 16:18'!
markGiven

	usage ifNil: [usage _ #arg].! !

!ScopeVar methodsFor: 'read/write usage' stamp: 'ajh 7/8/2004 16:19'!
markRead

	(usage isNil or: [usage = #arg]) ifTrue: [usage _ #read]! !

!ScopeVar methodsFor: 'read/write usage' stamp: 'ajh 7/8/2004 16:19'!
markWrite

	usage _ #write! !

!ScopeVar methodsFor: 'accessing' stamp: 'ajh 6/23/2004 22:47'!
name

	^ self subclassResponsibility! !

!ScopeVar methodsFor: 'accessing' stamp: 'ajh 2/27/2003 00:38'!
printOn: stream

	stream nextPutAll: self name! !

!ScopeVar methodsFor: 'read/write usage' stamp: 'ajh 6/28/2004 10:13'!
privUsage

	^ usage! !

!ScopeVar methodsFor: 'read/write usage' stamp: 'ajh 6/28/2004 10:13'!
privUsage: usageSymbol

	usage _ usageSymbol! !

!ScopeVar methodsFor: 'accessing' stamp: 'ajh 6/23/2004 22:52'!
scope

	^ scope! !

!ScopeVar methodsFor: 'initializing' stamp: 'ajh 7/8/2004 16:17'!
scope: aLexicalScope

	scope _ aLexicalScope! !

Object subclass: #StackCount
	instanceVariableNames: 'start position length'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Bytecodes'!

!StackCount commentStamp: 'ajh 3/25/2003 00:34' prior: 0!
This keeps track of the stack count for the BytecodeGenerator.!

!StackCount class methodsFor: 'instance creation' stamp: 'ajh 3/13/2003 01:49'!
new

	^ super new startAt: 0! !

!StackCount class methodsFor: 'as yet unclassified' stamp: 'ajh 3/13/2003 01:49'!
startAt: pos

	^ super new startAt: pos! !

!StackCount methodsFor: 'comparing' stamp: 'ajh 3/13/2003 01:39'!
= other

	^ self class == other class 
	  and: [start = other start
	  and: [position = other position
	  and: [length = other size]]]! !

!StackCount methodsFor: 'error handling' stamp: 'md 7/18/2005 09:59'!
errorStackOutOfSync: aStackCount 
	self error: 'stack not in sync!!'.! !

!StackCount methodsFor: 'comparing' stamp: 'ajh 3/13/2003 01:51'!
hash

	^ position hash bitXor: (length hash bitXor: start hash)! !

!StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'!
length

	^length! !

!StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 18:37'!
linkTo: stackOrNil

	stackOrNil ifNil: [^ self class startAt: self position].
	^ self position = stackOrNil start
		ifTrue: [stackOrNil]
		ifFalse: [self errorStackOutOfSync: stackOrNil]! !

!StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'!
pop

	^ self pop: 1! !

!StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'!
pop: n

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

!StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'!
position

	^position! !

!StackCount methodsFor: 'printing' stamp: 'ajh 3/13/2003 01:38'!
printOn: aStream
	
	super printOn: aStream.
	aStream
		nextPutAll: ' start '; print: start;
		nextPutAll: ' stop '; print: position;
		nextPutAll: ' max '; print: length.
! !

!StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'!
push

	^ self push: 1! !

!StackCount methodsFor: 'affecting' stamp: 'ajh 3/13/2003 01:32'!
push: n

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

!StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:32'!
size

	^length! !

!StackCount methodsFor: 'results' stamp: 'ajh 3/13/2003 01:36'!
start

	^ start! !

!StackCount methodsFor: 'initialize' stamp: 'ajh 3/13/2003 01:48'!
startAt: pos

	start _ position _ length _ pos! !

!UndefinedObject methodsFor: '*newcompiler' stamp: 'ajh 6/23/2004 20:40'!
parseScope

	^ GlobalScope new! !

Link subclass: #IRInstruction
	instanceVariableNames: 'sourceNode bytecodeIndex sequence'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRInstruction commentStamp: 'ajh 6/27/2004 23:02' prior: 0!
I am an instruction in the IR (intermediate representation) language.  The IR serves as the intermediary between the Smalltalk language and the bytecode language.  It is easier to optimize and translate to/from this language than it is to optimize/translate directly from Smalltalk to bytecodes.  The IR is generic and simple consisting of just twelve instructions.  They are:

	goto: labelNum
	if: boolean goto: labelNum1 otherwise: labelNum2
	label: labelNum
	popTop
	pushDup
	pushLiteral: object
	pushBlock: irMethod
	pushBlockMethod: irMethod
	pushTemp: tempIndex
	remoteReturn
	returnTop
	send: selector
	send: selector toSuperOf: behavior
	storeTemp: tempIndex

Each instruction is reified as an instance of one of my eight subclasses and grouped by basic block (IRSequence) into an IRMethod.  IRInterpreter visits each instruction in a IRMethod responding to the above instruction messages sent to it.
!

IRInstruction subclass: #IRAccess
	instanceVariableNames: 'number name'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRAccess methodsFor: 'testing' stamp: 'md 6/13/2005 12:01'!
isRead
	^self isStore not! !

!IRAccess methodsFor: 'accessing' stamp: 'md 6/12/2005 17:56'!
number

	^ number! !

!IRAccess methodsFor: 'accessing' stamp: 'md 6/12/2005 17:57'!
number: num

	number _ num! !

IRAccess subclass: #IRInstVarAccess
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRInstVarAccess commentStamp: 'md 11/10/2004 16:07' prior: 0!
when closures disabled, Field describes an instVar. With closures, it describes a 
fieldaccess with receiver to be accessed pushed first.!

!IRInstVarAccess methodsFor: 'testing' stamp: 'md 6/13/2005 11:10'!
isInstVarAccess
	^true.! !

!IRInstVarAccess methodsFor: 'testing' stamp: 'md 3/6/2006 09:14'!
varname
	name ifNil: [name := self method compiledMethod methodClass allInstVarNames at: self offset].
	^name.! !

IRInstVarAccess subclass: #IRInstVarRead
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRInstVarRead methodsFor: 'interpret' stamp: 'md 6/14/2005 15:02'!
executeOn: interpreter

	Preferences compileBlocksAsClosures 
		ifFalse: [ interpreter pushInstVar: number] 
		ifTrue: [  interpreter pushLiteral: number.
				  interpreter send: #privGetInstVar:. ]! !

!IRInstVarRead methodsFor: 'testing' stamp: 'md 6/13/2005 11:24'!
isRead
	^true.! !

!IRInstVarRead methodsFor: 'testing' stamp: 'md 6/13/2005 11:24'!
isStore
	^false.! !

IRInstVarAccess subclass: #IRInstVarStore
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRInstVarStore methodsFor: 'interpret' stamp: 'md 6/14/2005 15:04'!
executeOn: interpreter

	Preferences compileBlocksAsClosures 
		ifFalse: [interpreter storeInstVar: number] 
		ifTrue: [interpreter pushLiteral: number.
				interpreter send: #privStoreIn:instVar:].
		! !

!IRInstVarStore methodsFor: 'testing' stamp: 'md 6/13/2005 11:25'!
isRead
	^false! !

!IRInstVarStore methodsFor: 'testing' stamp: 'md 6/13/2005 11:25'!
isStore
	^true! !

IRAccess subclass: #IRLiteralVariableAccess
	instanceVariableNames: 'association'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'md 7/9/2005 21:14'!
association: anAssociation
	association := anAssociation! !

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'md 10/4/2005 16:45'!
isLiteralVariable
	^true! !

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'md 10/4/2005 16:45'!
isLiteralVariableAccess
	^true! !

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'md 10/4/2005 16:53'!
isLiteralVariableRead
	^self isLiteralVariableAccess and: [self isRead].! !

!IRLiteralVariableAccess methodsFor: 'accessing' stamp: 'md 10/4/2005 16:53'!
isLiteralVariableStore
	^self isLiteralVariableAccess and: [self isStore].! !

IRLiteralVariableAccess subclass: #IRLiteralVariableRead
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRLiteralVariableRead methodsFor: 'interpret' stamp: 'md 7/9/2005 21:18'!
executeOn: interpreter
	interpreter pushLiteralVariable: association
! !

!IRLiteralVariableRead methodsFor: 'testing' stamp: 'md 7/9/2005 21:17'!
isRead
	^true! !

!IRLiteralVariableRead methodsFor: 'testing' stamp: 'md 7/9/2005 21:17'!
isStore
	^false! !

IRLiteralVariableAccess subclass: #IRLiteralVariableStore
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRLiteralVariableStore methodsFor: 'interpret' stamp: 'md 7/9/2005 21:18'!
executeOn: interpreter
	interpreter storeIntoLiteralVariable: association! !

!IRLiteralVariableStore methodsFor: 'testing' stamp: 'md 7/9/2005 21:18'!
isRead
	^false! !

!IRLiteralVariableStore methodsFor: 'testing' stamp: 'md 7/9/2005 21:18'!
isStore
	^true! !

IRAccess subclass: #IRTempAccess
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRTempAccess methodsFor: 'testing' stamp: 'md 2/26/2005 16:22'!
isSelf
	^self number = 0.! !

!IRTempAccess methodsFor: 'testing' stamp: 'md 2/22/2005 11:28'!
isTemp
	^true.! !

!IRTempAccess methodsFor: 'testing' stamp: 'md 6/12/2005 18:42'!
isTempAccess
	^true.! !

!IRTempAccess methodsFor: 'testing' stamp: 'md 6/13/2005 11:08'!
isTempRead
	^self isTempAccess and: [self isRead].! !

!IRTempAccess methodsFor: 'testing' stamp: 'md 6/13/2005 12:01'!
isTempStore
	^self isTempAccess and: [self isStore].! !

IRTempAccess subclass: #IRTempRead
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRTempRead methodsFor: 'interpret' stamp: 'md 6/12/2005 18:19'!
executeOn: interpreter
	interpreter pushTemp: number.! !

!IRTempRead methodsFor: 'testing' stamp: 'md 6/12/2005 18:21'!
isRead
	^true! !

!IRTempRead methodsFor: 'testing' stamp: 'md 6/13/2005 12:03'!
isStore
	^false! !

IRTempAccess subclass: #IRTempStore
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRTempStore methodsFor: 'interpret' stamp: 'md 6/12/2005 18:20'!
executeOn: interpreter
	interpreter storeTemp: number.
		! !

!IRTempStore methodsFor: 'testing' stamp: 'md 6/12/2005 18:22'!
isRead
	^false! !

!IRTempStore methodsFor: 'testing' stamp: 'md 6/13/2005 12:03'!
isStore
	^true! !

IRInstruction subclass: #IRConstant
	instanceVariableNames: 'constant type'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRConstant commentStamp: 'ajh 3/24/2003 23:56' prior: 0!
Instruction "pushLiteral: object"!

!IRConstant methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:43'!
constant

	^ constant! !

!IRConstant methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:43'!
constant: object

	constant _ object! !

!IRConstant methodsFor: 'interpret' stamp: 'ajh 6/27/2004 21:41'!
executeOn: interpreter

	^ type caseOf: {
		[nil] -> [interpreter pushLiteral: constant].
		[#block] -> [interpreter pushBlock: constant].
		[#blockMethod] -> [interpreter pushBlockMethod: constant]
	 }! !

!IRConstant methodsFor: 'testing' stamp: 'md 11/26/2004 15:35'!
isConstant

	^ true! !

!IRConstant methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:12'!
isConstant: valueTest

	^ valueTest value: constant! !

!IRConstant methodsFor: 'accessing' stamp: 'ajh 6/27/2004 21:39'!
type
	"type is nil, #block, or #blockMethod"

	^ type! !

!IRConstant methodsFor: 'accessing' stamp: 'ajh 6/27/2004 21:39'!
type: symbol
	"symbol is nil, #block, or #blockMethod"

	type _ symbol! !

IRInstruction subclass: #IRDup
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRDup commentStamp: 'ajh 3/24/2003 23:56' prior: 0!
Instruction "pushDup"!

!IRDup methodsFor: 'interpret' stamp: 'ajh 3/10/2003 00:46'!
executeOn: interpreter

	^ interpreter pushDup! !

!IRInstruction class methodsFor: 'instance creation - old style blocks' stamp: 'md 10/8/2004 16:05'!
blockReturnTop

	^ IRBlockReturnTop new
		! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:07'!
goto: seq

	^ IRJump new
		destination: seq! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:07'!
if: bool goto: seq1 otherwise: seq2

	^ IRJumpIf new
		boolean: bool;
		destination: seq1;
		otherwise: seq2! !

!IRInstruction class methodsFor: 'instance creation - old style blocks' stamp: 'md 8/10/2005 11:03'!
jumpOverBlock: block to: cont
	^ (IRJumpOverBlock new)
				blockSequence: block;
				destination: cont.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 6/29/2005 16:47'!
new
	^super basicNew.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:07'!
popTop

	^ IRPop new! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 6/27/2004 22:58'!
pushBlock: irMethod

	^ IRConstant new
		constant: irMethod;
		type: #block! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 6/27/2004 21:40'!
pushBlockMethod: irMethod

	^ IRConstant new
		constant: irMethod;
		type: #blockMethod! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'!
pushDup

	^ IRDup new! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 6/13/2005 13:58'!
pushInstVar: index

	^ IRInstVarRead new number: index.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'!
pushLiteral: object

	^ IRConstant new
		constant: object! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 7/9/2005 21:20'!
pushLiteralVariable: object

	^ IRLiteralVariableRead new
		association: object.
	 ! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 4/21/2005 11:38'!
pushReceiver
	^IRInstruction pushTemp: 0! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 6/12/2005 18:22'!
pushTemp: index

	^ IRTempRead new
		number: index.! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 4/21/2005 12:06'!
pushThisContext
	^IRInstruction pushTemp: -2! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'!
remoteReturn

	^ IRReturn new
		isRemote: true! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'!
returnTop

	^ IRReturn new
		isRemote: false! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 3/10/2003 01:08'!
send: selector

	^ IRSend new
		selector: selector! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'ajh 7/3/2004 19:10'!
send: selector toSuperOf: behavior

	behavior ifNil: [self error: 'super of nil does not exist'].
	^ IRSend new
		selector: selector;
		superOf: behavior! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 6/13/2005 13:57'!
storeInstVar: index

	^ IRInstVarStore new number: index.
	! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 7/9/2005 21:20'!
storeIntoLiteralVariable: object

	^ IRLiteralVariableStore new
		association: object! !

!IRInstruction class methodsFor: 'instance creation' stamp: 'md 6/13/2005 11:50'!
storeTemp: index

	^ IRTempStore new
		number: index.! !

!IRInstruction methodsFor: 'adding' stamp: 'md 7/9/2005 22:41'!
addInstructionsAfter: aCollection
	sequence addInstructions: aCollection after: self.! !

!IRInstruction methodsFor: 'adding' stamp: 'md 7/9/2005 22:41'!
addInstructionsBefore: aCollection
	sequence addInstructions: aCollection before: self.! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:07'!
bytecodeIndex

	^ bytecodeIndex! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/13/2003 13:14'!
bytecodeIndex: index

	bytecodeIndex _ index! !

!IRInstruction methodsFor: 'mapping' stamp: 'md 9/1/2005 21:18'!
bytecodeOffset
	| startpc |
	startpc := self method compiledMethod initialPC.
	self bytecodeIndex ifNil: [^startpc].
	^self bytecodeIndex + startpc - 1.! !

!IRInstruction methodsFor: 'replacing' stamp: 'md 7/9/2005 22:41'!
delete
	sequence isNil ifTrue: [self error: 'This node doesn''t have a sequence'].
	sequence remove: self.! !

!IRInstruction methodsFor: 'interpret' stamp: 'ajh 3/6/2003 14:32'!
executeOn: interpreter
	"Send approriate message to interpreter"

	self subclassResponsibility! !

!IRInstruction methodsFor: 'testing' stamp: 'md 10/9/2004 20:14'!
isBlockReturnTop
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 11/26/2004 15:35'!
isConstant

	^ false! !

!IRInstruction methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:12'!
isConstant: valueTest

	^ false! !

!IRInstruction methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:19'!
isGoto
	"is unconditional jump"

	^ false! !

!IRInstruction methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:21'!
isIf

	^ false! !

!IRInstruction methodsFor: 'testing' stamp: 'abc 1/2/2006 15:41'!
isInBlock
	| irs |
	irs := self method allInstructionsMatching: [:each | each isJumpOverBlock ].
	irs detect: [:each | each blockSequence == self sequence ] ifNone: [^false].
	^true! !

!IRInstruction methodsFor: 'testing' stamp: 'md 6/13/2005 11:10'!
isInstVarAccess
	^false.! !

!IRInstruction methodsFor: 'testing' stamp: 'md 6/13/2005 13:54'!
isInstVarRead
	^self isInstVarAccess and: [self isRead].! !

!IRInstruction methodsFor: 'testing' stamp: 'md 6/13/2005 13:54'!
isInstVarStore
	^self isInstVarAccess and: [self isStore].! !

!IRInstruction methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:22'!
isJump
	"goto or if"

	^ false! !

!IRInstruction methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:13'!
isJumpOrReturn

	^ self isJump or: [self isReturn]! !

!IRInstruction methodsFor: 'testing' stamp: 'abc 1/2/2006 15:14'!
isJumpOverBlock
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 10/4/2005 16:52'!
isLiteralVariable
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 10/4/2005 16:53'!
isLiteralVariableAccess
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 10/4/2005 16:53'!
isLiteralVariableRead
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 10/4/2005 16:53'!
isLiteralVariableStore
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:09'!
isReturn

	^ false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 2/26/2005 16:22'!
isSelf
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 11/12/2004 15:57'!
isSend
	^false.! !

!IRInstruction methodsFor: 'testing' stamp: 'md 2/22/2005 11:28'!
isTemp
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 6/13/2005 11:05'!
isTempAccess
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 4/28/2005 14:26'!
isTempRead
	^false! !

!IRInstruction methodsFor: 'testing' stamp: 'md 4/28/2005 14:26'!
isTempStore
	^false! !

!IRInstruction methodsFor: 'accessing' stamp: 'md 7/9/2005 22:42'!
method
	^sequence method.! !

!IRInstruction methodsFor: 'replacing' stamp: 'md 10/11/2004 15:56'!
replaceNode: aNode withNode: anotherNode 
	self error: 'I don''t store other nodes'! !

!IRInstruction methodsFor: 'replacing' stamp: 'md 7/9/2005 22:41'!
replaceWith: aNode
	sequence isNil ifTrue: [self error: 'This node doesn''t have a sequence'].
	sequence replaceNode: self withNode: aNode! !

!IRInstruction methodsFor: 'replacing' stamp: 'md 7/9/2005 22:41'!
replaceWithInstructions: aCollection 

	sequence isNil ifTrue: [self error: 'This node doesn''t have a sequence'].
	sequence replaceNode: self withNodes: aCollection! !

!IRInstruction methodsFor: 'accessing' stamp: 'md 7/9/2005 22:38'!
sequence
	^sequence! !

!IRInstruction methodsFor: 'accessing' stamp: 'md 7/9/2005 22:39'!
sequence: aSeq
	sequence := aSeq! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/6/2003 14:32'!
sourceNode

	^ sourceNode
	! !

!IRInstruction methodsFor: 'mapping' stamp: 'ajh 3/6/2003 14:32'!
sourceNode: parseNode

	sourceNode _ parseNode
	! !

!IRInstruction methodsFor: 'accessing' stamp: 'ajh 3/6/2003 14:32'!
successorSequences
	"sent to last instruction in sequence which is expected to be a jump and return instruction"

	^ #()! !

IRInstruction subclass: #IRJump
	instanceVariableNames: 'destination'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRJump commentStamp: 'ajh 3/24/2003 23:56' prior: 0!
Instruction "goto: labelNum"!

!IRJump methodsFor: 'accessing' stamp: 'ajh 3/10/2003 23:08'!
destination

	^ destination! !

!IRJump methodsFor: 'accessing' stamp: 'pmm 2/2/2007 18:06'!
destination: aSequence

	destination := aSequence! !

!IRJump methodsFor: 'interpret' stamp: 'ajh 3/10/2003 00:47'!
executeOn: interpreter

	^ interpreter goto: destination orderNumber! !

!IRJump methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:19'!
isGoto
	"is unconditional jump"

	^ true! !

!IRJump methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:22'!
isJump
	"goto or if"

	^ true! !

!IRJump methodsFor: 'accessing' stamp: 'ajh 3/11/2003 00:02'!
successorSequences

	^ {destination}! !

IRJump subclass: #IRJumpIf
	instanceVariableNames: 'boolean otherwise'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRJumpIf commentStamp: 'ajh 3/24/2003 23:56' prior: 0!
Instruction "if: boolean goto: labelNum1 otherwise: labelNum2"!

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/10/2003 00:43'!
boolean

	^ boolean! !

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/10/2003 00:43'!
boolean: bool

	boolean _ bool! !

!IRJumpIf methodsFor: 'interpret' stamp: 'ajh 3/10/2003 00:47'!
executeOn: interpreter

	^ interpreter if: boolean goto: destination orderNumber otherwise: otherwise orderNumber! !

!IRJumpIf methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:19'!
isGoto
	"is unconditional jump"

	^ false! !

!IRJumpIf methodsFor: 'testing' stamp: 'ajh 3/11/2003 00:21'!
isIf

	^ true! !

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/10/2003 00:43'!
otherwise

	^ otherwise! !

!IRJumpIf methodsFor: 'acessing' stamp: 'pmm 2/2/2007 18:05'!
otherwise: aSequence

	otherwise := aSequence! !

!IRJumpIf methodsFor: 'acessing' stamp: 'ajh 3/11/2003 00:02'!
successorSequences

	^ {destination. otherwise}! !

IRJump subclass: #IRJumpOverBlock
	instanceVariableNames: 'blockSequence'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRJumpOverBlock methodsFor: 'accessing' stamp: 'md 10/8/2004 15:18'!
blockSequence
	^blockSequence! !

!IRJumpOverBlock methodsFor: 'accessing' stamp: 'md 10/8/2004 15:18'!
blockSequence: instr
	blockSequence := instr.! !

!IRJumpOverBlock methodsFor: 'interpret' stamp: 'md 10/20/2004 20:44'!
executeOn: interpreter
	^ interpreter jumpOverBlock:  blockSequence orderNumber to: destination orderNumber! !

!IRJumpOverBlock methodsFor: 'testing' stamp: 'md 10/8/2004 15:19'!
isJumpOverBlock
	^true.! !

!IRJumpOverBlock methodsFor: 'accessing' stamp: 'md 10/8/2004 15:18'!
successorSequences

	^ {destination. blockSequence} ! !

IRInstruction subclass: #IRPop
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRPop commentStamp: 'ajh 3/24/2003 23:57' prior: 0!
Instruction "popTop"!

!IRPop methodsFor: 'interpret' stamp: 'ajh 3/10/2003 00:47'!
executeOn: interpreter

	^ interpreter popTop! !

IRInstruction subclass: #IRReturn
	instanceVariableNames: 'isRemote'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRReturn commentStamp: 'ajh 3/24/2003 23:57' prior: 0!
Instruction "returnTop" or "remoteReturn"!

IRReturn subclass: #IRBlockReturnTop
	instanceVariableNames: 'successor'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRBlockReturnTop methodsFor: 'interpret' stamp: 'md 10/8/2004 16:04'!
executeOn: interpreter
	interpreter blockReturnTop.! !

!IRBlockReturnTop methodsFor: 'testing' stamp: 'md 10/8/2004 16:04'!
isBlockReturnTop

	^true.! !

!IRBlockReturnTop methodsFor: 'testing' stamp: 'md 10/21/2004 18:38'!
isRemote
	^false.! !

!IRBlockReturnTop methodsFor: 'accessing' stamp: 'md 10/8/2004 16:04'!
successor: anObject

	successor := anObject. ! !

!IRBlockReturnTop methodsFor: 'accessing' stamp: 'md 10/8/2004 16:04'!
successorSequences
	"sent to last instruction in sequence which is expected to be a jump and return instruction"

	^  { successor }! !

!IRReturn methodsFor: 'interpret' stamp: 'ajh 3/10/2003 00:48'!
executeOn: interpreter

	^ isRemote
		ifTrue: [interpreter remoteReturn]
		ifFalse: [interpreter returnTop]! !

!IRReturn methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:44'!
isRemote

	^ isRemote! !

!IRReturn methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:44'!
isRemote: boolean

	isRemote _ boolean! !

!IRReturn methodsFor: 'testing' stamp: 'ajh 3/10/2003 16:10'!
isReturn

	^ true! !

IRInstruction subclass: #IRSend
	instanceVariableNames: 'selector superOf'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-IR'!

!IRSend commentStamp: 'ajh 3/24/2003 23:57' prior: 0!
Instruction "send: selector" or "send: selector toSuperOf: behavior"!

!IRSend methodsFor: 'interpret' stamp: 'ajh 3/10/2003 00:48'!
executeOn: interpreter

	^ superOf
		ifNil: [interpreter send: selector]
		ifNotNil: [interpreter send: selector toSuperOf: superOf]! !

!IRSend methodsFor: 'testing' stamp: 'md 11/12/2004 15:56'!
isMessageSend
	^true.! !

!IRSend methodsFor: 'testing' stamp: 'md 11/12/2004 15:57'!
isSend
	^true.! !

!IRSend methodsFor: 'testing' stamp: 'md 10/10/2005 17:37'!
isSuperSend
    ^superOf notNil! !

!IRSend methodsFor: 'accessing' stamp: 'md 6/23/2005 13:45'!
selector
	^selector! !

!IRSend methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:44'!
selector: symbol

	selector _ symbol! !

!IRSend methodsFor: 'accessing' stamp: 'md 6/23/2005 13:49'!
senderselector
	^self method selector! !

!IRSend methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:45'!
superOf

	^ superOf! !

!IRSend methodsFor: 'accessing' stamp: 'ajh 3/10/2003 00:45'!
superOf: behavior

	superOf _ behavior! !

!RBSequenceNode methodsFor: '*newcompiler-decorating' stamp: 'md 4/4/2007 17:37'!
peekAfterComment

	"| tokenStream token countNewLine |"
	self afterComment ifNil:[
		"countNewLine := 0."
		self afterComment: OrderedCollection new.
		"tokenStream := (SqueakTokenStream forwardOn: self lastToken) selectCommentNewLine.
		[token := tokenStream next.
		 token isNewLine ifTrue: [countNewLine := countNewLine + 1.]. 
		 tokenStream atEnd] 
				whileFalse: [countNewLine = 1 ifTrue: [token isComment ifTrue:[afterComment add: token eatToken]]].
		afterComment do: [:each | self comments add: (each start to: each stop)]"
	].
	^self afterComment! !

Inspector subclass: #ClosureEnvInspector
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tools'!

!ClosureEnvInspector methodsFor: 'selecting' stamp: 'ajh 7/7/2004 16:50'!
accept: aString

	| result |
	selectionIndex <= 2 ifTrue: [^ false].
	context ifNil: [^ super accept: aString].

	self eval: self selectedSlotName , ' _ ' , aString ifFail: [^ false].
	self update.
	^ true
! !

!ClosureEnvInspector methodsFor: 'accessing' stamp: 'ajh 7/7/2004 16:13'!
doItContext
	"Use my context. May be nil, in which case doItReceiver will be the context"

	^ context! !

!ClosureEnvInspector methodsFor: 'selecting' stamp: 'ajh 7/7/2004 16:57'!
eval: string ifFail: block

	^ self doItReceiver class evaluatorClass new
		evaluate2: (ReadStream on: string)
		in: self doItContext
		to: self doItReceiver
		notifying: nil	"fix this"
		ifFail:  block
		logged: false! !

!ClosureEnvInspector methodsFor: 'accessing' stamp: 'ajh 7/7/2004 16:05'!
fieldList 
	"Refer to the comment in Inspector|fieldList."

	object == nil ifTrue: [^ #('thisEnv')].
	^ #('thisEnv' 'all free vars'), self freeNames! !

!ClosureEnvInspector methodsFor: 'accessing' stamp: 'ajh 7/7/2004 16:35'!
freeNames

	context ifNil: [^ (1 to: object size) collect: [:i | i printString]].

	^ context freeNames! !

!ClosureEnvInspector methodsFor: 'accessing' stamp: 'ajh 7/7/2004 16:34'!
freeNamesAndValues

	context ifNil: [
		| stream |
		stream _ '' writeStream.
		1 to: object size do: [:i |
			stream print: i; nextPut: $:; space; tab.
			(object at: i) printOn: stream.
			stream cr].
		^ stream contents
	].

	^ context freeNamesAndValues! !

!ClosureEnvInspector methodsFor: 'accessing' stamp: 'ajh 7/8/2004 20:12'!
object: anObject 
	"Same as super, except always update fields even if the object is the same, because the same closureEnvironment (object) can have different free vars depending on the context."

	| oldIndex |
	oldIndex _ selectionIndex <= 2 ifTrue: [selectionIndex] ifFalse: [0].
	self inspect: anObject.
	oldIndex _ oldIndex min: self fieldList size.
	self changed: #inspectObject.
	oldIndex > 0
		ifTrue: [self toggleIndex: oldIndex].
	self changed: #fieldList.
	self changed: #contents.
! !

!ClosureEnvInspector methodsFor: 'selecting' stamp: 'ajh 7/7/2004 16:46'!
replaceSelectionValue: anObject 
	"Refer to the comment in Inspector|replaceSelectionValue:."

	object at: selectionIndex - 2 put: anObject! !

!ClosureEnvInspector methodsFor: 'selecting' stamp: 'ajh 7/7/2004 17:41'!
selection 
	"Refer to the comment in Inspector|selection."

	selectionIndex = 0 ifTrue:[^ ''].
	selectionIndex = 1 ifTrue: [^ object].
	selectionIndex = 2 ifTrue: [^ self freeNamesAndValues].
	context ifNil: [^ object at: selectionIndex - 2].
	^ self eval: (self freeNames at: selectionIndex - 2)
		ifFail: [self error: 'bug']! !

Notification subclass: #SemanticWarning
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!SemanticWarning commentStamp: 'ajh 7/7/2004 17:36' prior: 0!
If a variable is not found or some other problem occurs during checking (ASTChecker) than a particular subclass instance of me is signal, usually causing a notification to the user. If not handled, the default handling is done, and compiling continues.!

!SemanticWarning methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 14:28'!
correctIn: compiler

	self subclassResponsibility! !

!SemanticWarning methodsFor: 'testing' stamp: 'ajh 3/11/2003 14:54'!
isResumable

	^ true! !

SemanticWarning subclass: #ShadowVariableWarning
	instanceVariableNames: 'variableNode shadowedVar'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ShadowVariableWarning commentStamp: 'ajh 3/24/2003 22:21' prior: 0!
I get signalled when a variable in a block or method scope shadows a variable of the same name in an outer scope.  The default action is to allow it.!

!ShadowVariableWarning methodsFor: 'as yet unclassified' stamp: 'ajh 3/19/2003 16:42'!
correctIn: compiler

	self resume: (compiler variable: self variableNode shadows: self shadowedVar)! !

!ShadowVariableWarning methodsFor: 'defaults' stamp: 'ajh 3/19/2003 13:34'!
defaultAction
	"allow variable to shadow previous/inst var of the same name"

	^ nil! !

!ShadowVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/19/2003 13:32'!
shadowedVar

	^ shadowedVar! !

!ShadowVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/19/2003 13:32'!
shadowedVar: semVar

	shadowedVar _ semVar! !

!ShadowVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/19/2003 13:19'!
variableNode

	^ variableNode! !

!ShadowVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/19/2003 13:24'!
variableNode: aVariableNode

	variableNode _ aVariableNode.
	messageText _ 'Temp shadows: ', aVariableNode name.
! !

SemanticWarning subclass: #UndeclaredSelectorWarning
	instanceVariableNames: 'messageNode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!UndeclaredSelectorWarning commentStamp: 'ajh 3/24/2003 22:23' prior: 0!
I get signalled when no selector is defined for a message send, indicating a possible mispelling.  My default action is to create a new selector.!

!UndeclaredSelectorWarning methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 14:28'!
correctIn: compiler

	self resume: (compiler correctSelector: self messageNode)! !

!UndeclaredSelectorWarning methodsFor: 'defaults' stamp: 'md 4/14/2007 00:37'!
defaultAction
	"create new selector"

	^ messageNode selector! !

!UndeclaredSelectorWarning methodsFor: 'accessing' stamp: 'ajh 3/11/2003 22:43'!
messageNode

	^ messageNode! !

!UndeclaredSelectorWarning methodsFor: 'accessing' stamp: 'md 4/14/2007 00:37'!
messageNode: aMessageNode

	messageNode _ aMessageNode.
	messageText _ 'Unknown selector: ', aMessageNode selector.
! !

SemanticWarning subclass: #UndeclaredVariableWarning
	instanceVariableNames: 'variableNode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!UndeclaredVariableWarning commentStamp: 'ajh 3/24/2003 22:33' prior: 0!
I get signalled when an unknown variable it references.  My default action is to raise an warning.!

!UndeclaredVariableWarning methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 14:28'!
correctIn: compiler

	self resume: (compiler correctVariable: self variableNode)! !

!UndeclaredVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/11/2003 12:05'!
variableNode

	^ variableNode! !

!UndeclaredVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/11/2003 23:37'!
variableNode: aVariableNode

	variableNode _ aVariableNode.
	messageText _ 'Undeclared variable: ', aVariableNode name.
! !

SemanticWarning subclass: #UninitializedVariableWarning
	instanceVariableNames: 'variableNode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!UninitializedVariableWarning commentStamp: 'ajh 3/24/2003 22:34' prior: 0!
I get signalled when a temporary variable is used before it is assigned to.  My default action is to allow it since all temps get initialized to nil.!

!UninitializedVariableWarning methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 14:28'!
correctIn: compiler

	self resume: (compiler queryUninitializedTemp: self variableNode)! !

!UninitializedVariableWarning methodsFor: 'defaults' stamp: 'ajh 3/12/2003 13:37'!
defaultAction
	"unitialized temp will be initialized to nil, so ignore this warning if not handled"

	^ nil! !

!UninitializedVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/12/2003 13:25'!
variableNode

	^ variableNode! !

!UninitializedVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/12/2003 14:08'!
variableNode: aVariableNode

	variableNode _ aVariableNode.
	messageText _ 'Uninitialized temp: ', aVariableNode name.
! !

SemanticWarning subclass: #UnusedVariableWarning
	instanceVariableNames: 'variableNode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!UnusedVariableWarning commentStamp: 'ajh 3/24/2003 22:35' prior: 0!
I get signalled when a temporary variable is declared but never used.  My default action is to allow it since it is benign.!

!UnusedVariableWarning methodsFor: 'as yet unclassified' stamp: 'ajh 3/12/2003 14:28'!
correctIn: compiler

	self resume: (compiler removeUnusedTemp: self variableNode)! !

!UnusedVariableWarning methodsFor: 'defaults' stamp: 'ajh 3/12/2003 14:07'!
defaultAction
	"unused temp will be ignored, so ignore this warning if not handled"

	^ nil! !

!UnusedVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/12/2003 14:06'!
variableNode

	^ variableNode! !

!UnusedVariableWarning methodsFor: 'accessing' stamp: 'ajh 3/12/2003 14:07'!
variableNode: aVariableNode

	variableNode _ aVariableNode.
	messageText _ 'Unused temp: ', aVariableNode name.
! !

!RBVariableNode methodsFor: '*newcompiler' stamp: 'md 4/4/2007 17:41'!
peekBeforeComment
	| tokenStream tok |
	self parent isMethod 
		ifFalse: [^ super peekBeforeComment]
		ifTrue: 
			[self beforeComment ifNil: 
					[self beforeComment: OrderedCollection new.
					tokenStream := SqueakTokenStream backwardOn: self firstToken previous.
					
					[tok := tokenStream next.
					tok isSignificant or: [tokenStream atEnd]] 
							whileFalse: [tok isComment ifTrue: [self beforeComment add: tok eatToken]].
					self beforeComment do: [:each | self comments add: (each start to: each stop)]].
			^ self beforeComment]! !

SmaCCToken subclass: #SqueakToken
	instanceVariableNames: 'next previous eat'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

SqueakToken subclass: #SqueakCommentToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SqueakCommentToken methodsFor: 'testing' stamp: 'ms 9/17/2006 19:33'!
isComment
	
	^true! !

!SqueakToken class methodsFor: 'instance creation' stamp: 'ms 9/17/2006 14:43'!
value: aString start: anInteger

	^(self new)
		value: aString;
			start: anInteger;	
		yourself! !

!SqueakToken class methodsFor: 'instance creation' stamp: 'ms 9/17/2006 15:25'!
value: aString start: anInteger id: anObject
	^(self new)
		value: aString
			start: anInteger
			id: anObject;
		yourself! !

!SqueakToken class methodsFor: 'instance creation' stamp: 'ms 9/16/2006 17:26'!
value: aString start: anInteger id: anObject prevToken: aToken

	^(self new)
		value: aString
			start: anInteger
			id: anObject;
		previous: aToken;	
		yourself! !

!SqueakToken class methodsFor: 'instance creation' stamp: 'ms 9/17/2006 14:33'!
value: aString start: anInteger prevToken: aToken

	^(self new)
		value: aString;
			start: anInteger;
		previous: aToken;	
		yourself! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 9/19/2006 13:19'!
eatToken
	
	eat := true.
	^self! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 19:57'!
eatValue
	
	eat := true.
	^self value! !

!SqueakToken methodsFor: 'initialize' stamp: 'ms 9/17/2006 19:56'!
initialize
	
	eat := false! !

!SqueakToken methodsFor: 'add' stamp: 'ms 9/17/2006 14:47'!
insertAfterMe: aToken
	
	self next previous: aToken.
	aToken previous: self! !

!SqueakToken methodsFor: 'add' stamp: 'ms 9/17/2006 14:41'!
insertBeforMe: aToken
	
	aToken previous: self previous.
	self previous: aToken! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 9/17/2006 19:31'!
isComment

	^false! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 9/17/2006 19:59'!
isEaten
	
	^eat! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 9/19/2006 15:32'!
isInsignificant
	
	^false! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 9/17/2006 19:32'!
isNewLine
	
	^false! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 3/31/2007 21:16'!
isRBToken
	^false! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 4/1/2007 18:39'!
isSignificant
	^(self isComment or:[self isWhitespace] or: [self value = '|'] or: [self value = '.'] or: [self isWhitespace]) not! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 9/17/2006 19:32'!
isWhitespace

	^false! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 4/1/2007 13:43'!
length

	^(self stop - self start) + 1! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 9/16/2006 17:18'!
next
	
	^next! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 9/16/2006 23:24'!
next: aToken
	
	next := aToken! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 9/17/2006 18:41'!
nextSignificant

	| nextSign |
	nextSign := self next.
	[nextSign isInsignificant] 
		whileTrue: [nextSign := nextSign next.
					nextSign ifNil:[^nil]].
	^nextSign! !

!SqueakToken methodsFor: 'testing' stamp: 'ms 9/17/2006 19:59'!
notEaten
	
	^eat not! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 9/16/2006 17:19'!
previous

	^previous! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 9/16/2006 17:29'!
previous: aToken

	aToken ifNotNil:[aToken next: self].
	previous := aToken! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 3/31/2007 22:01'!
start

	^self startPosition! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 3/31/2007 21:18'!
start: aSmallInteger 
	start := aSmallInteger! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 3/31/2007 22:02'!
stop

	^self stopPosition! !

!SqueakToken methodsFor: 'replace' stamp: 'ms 11/11/2006 19:13'!
substitueTo: aToken
	
	self previous: aToken previous.
	aToken next ifNotNilDo:[:nextToken | nextToken previous: self]! !

!SqueakToken methodsFor: 'accessing' stamp: 'ms 3/31/2007 21:17'!
value: aValue 
	value := aValue! !

SqueakToken subclass: #SqueakWhitespaceToken
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SqueakWhitespaceToken methodsFor: 'testing' stamp: 'ms 9/17/2006 19:43'!
isNewLine

	^(self value indexOf: Character cr) > 0 or: [(self value indexOf: Character lf) > 0]! !

!SqueakWhitespaceToken methodsFor: 'testing' stamp: 'ms 9/19/2006 23:52'!
isWhitespace

	^true! !

!ClosureEnvironment methodsFor: '*newcompiler' stamp: 'ajh 7/7/2004 16:53'!
inspectorClass

	^ ClosureEnvInspector! !

Set subclass: #LiteralSet
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Bytecodes'!

!LiteralSet commentStamp: 'ajh 3/25/2003 00:33' prior: 0!
Holds a unique set of literals.  Literal objects are equal if they are #= plus they are the same class.  This set uses this rule for finding elements.

Example:
	Set new add: 'anthony'; add: #anthony; size  "= 1"
	LiteralSet new add: 'anthony'; add: #anthony; size  "= 2"
!

!LiteralSet methodsFor: 'adding' stamp: 'ajh 12/9/2001 16:03'!
add: newObject
	"Include newObject as one of the receiver's elements.  If equivalent is already present don't add and return equivalent object"

	| index |
	newObject ifNil: [self error: 'Sets cannot meaningfully contain nil as an element'].
	index _ self findElementOrNil: newObject.
	^ (array at: index) 
		ifNil: [self atNewIndex: index put: newObject. newObject]
		ifNotNil: [array at: index]! !

!LiteralSet methodsFor: 'private' stamp: 'ajh 2/2/2002 19:16'!
scanFor: anObject
	"Scan the key array for the first slot containing either a nil (indicating an empty slot) or an element that matches anObject. Answer the index of that slot or zero if no slot is found. This method will be overridden in various subclasses that have different interpretations for matching elements."
	| element start finish |
	start _ (anObject hash \\ array size) + 1.
	finish _ array size.

	"Search from (hash mod size) to the end."
	start to: finish do:
		[:index | ((element _ array at: index) == nil
					or: [element literalEqual: anObject])
					ifTrue: [^ index ]].

	"Search from 1 to where we started."
	1 to: start-1 do:
		[:index | ((element _ array at: index) == nil
					or: [element literalEqual: anObject])
					ifTrue: [^ index ]].

	^ 0  "No match AND no empty slot"! !

!Collection methodsFor: '*newcompiler' stamp: 'ms 10/16/2006 23:33'!
do: elementBlock separatedByNext: separatorBlock
	"Evaluate the elementBlock for all elements in the receiver,
	and evaluate the separatorBlock between with the next element."

	| beforeFirst | 
	beforeFirst := true.
	self do:
		[:each |
		beforeFirst
			ifTrue: [beforeFirst := false]
			ifFalse: [separatorBlock value: each].
		elementBlock value: each]! !

!Collection methodsFor: '*newcompiler' stamp: 'ms 10/16/2006 23:33'!
do: elementBlock separatedByPrevious: separatorBlock
	"Evaluate the elementBlock for all elements in the receiver,
	and evaluate the separatorBlock between with the previous element."

	| beforeFirst prev | 
	beforeFirst := true.
	prev := nil.
	self do:
		[:each |
		beforeFirst
			ifTrue: [beforeFirst := false]
			ifFalse: [separatorBlock value: prev].
		elementBlock value: each.
		prev := each]! !

SmaCCParser subclass: #SqueakParser
	instanceVariableNames: 'messageError'
	classVariableNames: 'DicTokens'
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SqueakParser commentStamp: 'ajh 3/24/2003 18:24' prior: 0!
I parse Smalltalk text into a Refactory abstract syntax tree, whose root is RBMethodNode or RBDoItNode.  Methods under 'generated-*' categories were automatically generated using SmaCC.!

SqueakParser subclass: #SqueakMethodPatternParser
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SqueakMethodPatternParser class methodsFor: 'generated-comments' stamp: 'ms 11/19/2006 17:05'!
parserDefinitionComment

	"%id <name> <number> <negativeNumber> <binarySymbol> <period> <colon> <rightParentheses> <rightCurlyBrackets> <rightBoxBrackets> <string> <keyword> <multikeyword> <assignment> <character>;
%start MethodPattern;

Method:
	MethodPattern Body 						{#method:};

MethodPattern:
	<name>										{#unaryMessage:}
|	<binarySymbol> Variable						{#messagePart:}
|	<binarySymbol> error						{#argumentNameMissing:}
|	KeywordMethodPattern						{#first:};

KeywordMethodPattern:
	<keyword> Variable							{#messagePart:}
|	<keyword> error								{#argumentNameMissing:}
|	KeywordMethodPattern <keyword> Variable	{#addMessagePart:}
|	KeywordMethodPattern <keyword> error		{#argumentNameMissing:};
		
Variable: 
	<name>										{#variable:};
												
Body:
|	Body <decimalNumber>
|	Body <radixNumber>
|	Body <scaledNumber>
|	Body <exponentNumber>
|	Body <number>
|	Body <negativeNumber>
|	Body <string>
|	Body <name>
|	Body <keyword>
|	Body <multikeyword>
|	Body <binarySymbol>
|	Body <assignment>
|	Body <alternateKeyword>
|	Body <whitespace>
|	Body <comment>
|	Body <character>
|	Body <period>
|	Body <variableAssignment>
|	Body <rightBoxBrackets>
|	Body <rightCurlyBrackets>
|	Body <rightParentheses>
|	Body <colon>
|	Body <semicolon>
|	Body <anyChar>
|	Body ""[""
|	Body ""{""
|	Body ""(""
|	Body ""|"";"! !

!SqueakMethodPatternParser class methodsFor: 'generated-accessing' stamp: 'ms 11/19/2006 17:05'!
scannerClass
	^SqueakMethodPatternScanner! !

!SqueakMethodPatternParser class methodsFor: 'generated-starting states' stamp: 'ms 11/19/2006 17:05'!
startingStateForMethod
	^1! !

!SqueakMethodPatternParser class methodsFor: 'generated-starting states' stamp: 'ms 11/19/2006 17:05'!
startingStateForMethodPattern
	^2! !

!SqueakMethodPatternParser methodsFor: 'reduction actions' stamp: 'ms 11/19/2006 17:14'!
method: nodes

	^RBMethodNode new
		selectorParts: nodes first first arguments: nodes first second; body: (RBSequenceNode statements: #())
	
	! !

!SqueakMethodPatternParser methodsFor: 'generated-tables' stamp: 'ms 11/21/2006 08:27'!
reduceTable
	^#(
#(29 0 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(29 2 #reduceFor:)
#(30 1 #variable:)
#(31 1 #reduceFor:)
#(32 2 #method:)
#(33 2 #messagePart:)
#(33 2 #argumentNameMissing:)
#(33 3 #addMessagePart:)
#(33 3 #argumentNameMissing:)
#(34 1 #unaryMessage:)
#(34 2 #messagePart:)
#(34 2 #argumentNameMissing:)
#(34 1 #first:)
)! !

!SqueakMethodPatternParser methodsFor: 'generated-tables' stamp: 'ms 11/19/2006 17:05'!
transitionTable
	^#(
#(3 13 12 17 13 21 15 25 32 29 33 33 34)
#(3 13 12 17 13 21 15 29 33 37 34)
#(2 150 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(3 41 12 45 30 49 36)
#(3 41 12 53 30 57 36)
#(2 0 35)
#(3 162 1 162 2 162 3 162 4 162 5 162 6 162 7 162 8 162 9 162 10 162 11 162 12 61 13 162 14 162 15 162 16 162 17 162 18 162 19 162 20 162 21 162 22 162 23 162 24 162 25 162 26 162 27 162 28 162 35)
#(3 6 1 6 2 6 3 6 4 6 5 6 6 6 7 6 8 6 9 6 10 6 11 6 12 6 13 6 14 6 15 6 16 6 17 6 18 6 19 6 20 6 21 6 22 6 23 6 24 6 25 6 26 6 27 6 28 65 29 6 35)
#(2 0 35)
#(2 122 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 134 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 138 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 154 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 158 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(3 41 12 69 30 73 36)
#(3 77 1 81 2 85 3 89 4 93 5 97 6 101 7 105 8 109 9 113 10 117 11 121 12 125 13 129 14 133 15 137 16 141 17 145 18 149 19 153 20 157 21 161 22 165 23 169 24 173 25 177 26 181 27 185 28 130 35)
#(2 142 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 146 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 106 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 110 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 118 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 114 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 10 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 14 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 18 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 22 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 26 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 30 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 34 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 38 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 42 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 46 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 50 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 54 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 58 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 62 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 66 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 70 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 74 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 78 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 82 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 86 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 90 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 94 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 98 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
#(2 102 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 35)
)! !

!SqueakParser class methodsFor: 'initialize' stamp: 'ms 10/10/2006 23:28'!
initialize
	"self initialize"
	
	| scanner |
	super initialize.
	scanner := SqueakScanner new.
	DicTokens := Dictionary new.
	DicTokens at: scanner colonId put: 'colon'.
	DicTokens at: scanner binarySymbolId put: 'binary symbol'.
	DicTokens at: scanner nameId put: 'variable'.
	DicTokens at: scanner negativeNumberId put: 'negative number'.
	DicTokens at: scanner periodId put: 'period'.
	DicTokens at: scanner rightBoxBracketsId put: 'right box bracket'.
	DicTokens at: scanner rightCurlyBracketsId put: 'right curly brackets'.
	DicTokens at: scanner rightParenthesesId put: 'right parentheses'.
	DicTokens at: scanner stringId put: 'string'.
	DicTokens at: scanner multikeywordId put: 'multi keyword'.
	DicTokens at: scanner keywordId put: 'keyword'.
	DicTokens at: scanner characterId put: 'character'.
	DicTokens at: scanner assignmentId put: 'assignment'! !

!SqueakParser class methodsFor: 'parsing' stamp: 'ajh 2/27/2003 16:40'!
parseDoIt: stringOrStream

	| sequence |
	sequence _ self
		parseStream: stringOrStream readStream
		startingAt: self startingStateForSequence.
	^ (RBDoItNode body: sequence)
		source: stringOrStream contents! !

!SqueakParser class methodsFor: 'parsing' stamp: 'ms 12/2/2006 22:27'!
parseMethod: stringOrStream 
	
	^ (self parseStream: stringOrStream readStream startingAt: self startingStateForMethod)
		source: stringOrStream contents! !

!SqueakParser class methodsFor: 'parsing' stamp: 'ms 11/19/2006 17:16'!
parseMethodPattern: stringOrStream 
	^ SqueakMethodPatternParser parseMethod: stringOrStream! !

!SqueakParser class methodsFor: 'generated-comments' stamp: 'ms 4/7/2007 03:32'!
parserDefinitionComment

	"%id <name> <number> <negativeNumber> <binarySymbol> <period> <colon> <rightParentheses> <rightCurlyBrackets> <rightBoxBrackets> <string> <keyword> <multikeyword> <assignment> <character>;
%start Sequence MethodPattern;

Method:
	MethodPattern Sequence						{#method:}
|	MethodPattern Pragmas Sequence			{#methodPragma:}
|	MethodPattern Pragmas Temporaries Pragmas Statements {#methodPragmaTempsPragma:}
|	MethodPattern Temporaries Pragmas Statements {#methodTempsPragma:};

MethodPattern:
	<name>										{#unaryMessage:}
|	<binarySymbol> Variable						{#messagePart:}
|	<binarySymbol> error						{#argumentNameMissing:}
|	KeywordMethodPattern						{#first:};

KeywordMethodPattern:
	<keyword> Variable							{#messagePart:}
|	<keyword> error								{#argumentNameMissing:}
|	KeywordMethodPattern <keyword> Variable	{#addMessagePart:}
|	KeywordMethodPattern <keyword> error		{#argumentNameMissing:};

Pragmas:
	""<"" PragmaMessage "">""							{#pragma:}
|	""<"" PragmaMessage error							{#pragmaEndMissing:}
|	""<"" error											{#pragmaMissing:}
|	Pragmas ""<"" PragmaMessage "">""					{#pragmas:}
|	Pragmas ""<"" PragmaMessage error				{#pragmaEndMissing:}
|	Pragmas ""<"" error								{#pragmaMissing:};

Sequence:
	Statements									{#sequence:}
|	Temporaries Statements						{#sequenceWithTemps:};

Temporaries:
	""||""											{#arrayAddToken:}
|	""|"" TemporaryVariables ""|""					{#secondAddToken:}
| 	""|"" TemporaryVariables error					{#verticalBarMissing:};

TemporaryVariables:
												{#array}
|	TemporaryVariables Variable				{#add:};

Statements:
												{#array}
|	StatementList <period>?						{#first:}
|	StatementList <period> ""^"" Expression <period>?	{#returnAdd:}
|	""^"" Expression <period>?						{#return:};

StatementList:
	Expression									{#firstIn:}
|	StatementList <period> Expression				{#add3:};

Block:
	""["" BlockArgs ""|"" Sequence <rightBoxBrackets>	{#blockWithArgs:}
|	""["" Sequence <rightBoxBrackets>				{#blockNoArgs:}
|	""["" BlockArgs <rightBoxBrackets>				{#blockArgs:}
|	""["" BlockArgs ""||"" TemporaryVariables ""|"" Statements <rightBoxBrackets> {#blockWithTemps:};

BlockArgs:
	<colon> Variable									{#secondIn:}
|	<colon>	error									{#argumentNameMissing:}
|	BlockArgs <colon> Variable						{#add3:}
|	BlockArgs <colon> error							{#argumentNameMissing:};

Expression:
	Assignment									{#first:}
|	Cascade										{#first:}
|	Primary									{#first:};

Primary:
	""("" Expression <rightParentheses>				{#secondWithParenthesis:}
|	Array										{#first:}
|	Block										{#first:}
|	Literal										{#first:}
|	Variable									{#first:};

Assignment:
	Variable <assignment> Expression				{#assignment:}
|	Variable <assignment> error					{#expressionMissing:};

Cascade:
	MessageSend								{#first:}
|	Cascade <semicolon> Message					{#cascade:}
|	Cascade <semicolon> error 					{#cascadeMMissing:};

MessageSend:
	KeywordMessageSend						{#first:}
|	BinaryMessageSend							{#first:}
|	UnaryMessageSend							{#first:};

Message:
	UnaryMessage								{#first:}
|	BinaryMessage								{#first:}
|	KeywordMessage							{#first:};

KeywordMessageSend:
	BinaryMessageSend KeywordMessage			{#messageSend:}
|	UnaryMessageSend KeywordMessage			{#messageSend:}
|	Primary KeywordMessage					{#messageSend:};

KeywordMessage:
	<keyword> KeywordArgument				{#messagePart:}
|	<keyword> error 							{#argumentMissing:}
|	KeywordMessage <keyword> KeywordArgument {#addMessagePart:}
|	KeywordMessage <keyword> error 			{#argumentMissing:};

KeywordArgument:
	BinaryMessageSend							{#first:}
|	UnaryMessageSend							{#first:}
|	Primary									{#first:};

BinaryMessageSend:
	BinaryMessageSend BinaryMessage			{#messageSend:}
|	UnaryMessageSend BinaryMessage			{#messageSend:}
|	Primary BinaryMessage						{#messageSend:};

BinaryMessage :
	<binarySymbol> BinaryArgument				{#messagePart:}
|	<binarySymbol> error 						{#argumentMissing:};
 
BinaryArgument:
	UnaryMessageSend							{#first:}
|	Primary									{#first:};

UnaryMessageSend :
	UnaryMessageSend UnaryMessage			{#messageSend:}
|	Primary UnaryMessage						{#messageSend:};

UnaryMessage :
	<name>										{#unaryMessage:};

Array:
	""{"" Statements <rightCurlyBrackets>			{#array:};

Variable:
	<name>										{#variable:};

Literal:
	""true""										{#litTrue:}
|	""false""										{#litFalse:}
|	""nil""										{#litNil:}
|	<number>									{#litNumber:}
|	<negativeNumber>							{#litNumber:} 
|	<character>									{#litChar:}
|	<string>										{#litString:}
|	""#"" <string>									{#litStringSymbol:}
|	""#"" <name>									{#litSymbol:}
|	""#"" <binarySymbol>							{#litSymbol:}
|	""#"" <keyword>								{#litSymbol:}
|	""#"" <multikeyword>							{#litSymbol:}
|	""#"" <alternateKeyword>						{#litSymbol:}
|	""#"" ""["" ByteArray <rightBoxBrackets>			{#litArray:}
|	""#"" ""("" LiteralArray <rightParentheses>		{#litArray:}
|	""#:""											{#litString:};

ByteArray:
												{#byteStream}
|	ByteArray <number>							{#byteStreamPut:};

LiteralArray:
												{#stream}
|	LiteralArray ArrayLiteral					{#streamPut:};

ArrayLiteral:
	Literal										{#value:}
|	<name>										{#valueSymbol:}
|	<binarySymbol>								{#valueSymbol:}
|	<keyword>									{#valueSymbol:}
|	<multikeyword>								{#valueSymbol:}
|	<alternateKeyword>							{#valueSymbol:}
|	""("" LiteralArray <rightParentheses>			{#contents2:}
|	""["" ByteArray <rightBoxBrackets>				{#contents2:}
|	<anyChar>									{#valueSymbol:};

PragmaMessage:
	Apicall										{#messagePragma:}
| 	Primitive 									{#messagePragma:} 
|	MessagePragma 								{#messagePragma:};

MessagePragma:
	KeyWordMessagePragma						{#pragmaMessage:}
|	BinaryMessagePragma						{#pragmaMessage:}
|	UnaryMessage 								{#pragmaUnaryMessage:};
									
BinaryMessagePragma:
	<binarySymbol> PrimaryPragma				{#messagePart:}
|	<binarySymbol> error 						{#argumentMissing:};
										
KeyWordMessagePragma:
	<keyword> PrimaryPragma					{#messagePart:}
|	<keyword> error 							{#literalMissing:}
|	KeywordMessage <keyword> PrimaryPragma	{#addMessagePart:}
|	KeywordMessage <keyword> error 			{#literalMissing:};

PrimaryPragma:
	Array										{#first:}
|	Block										{#first:}
|	Literal										{#first:}
|	Variable									{#first:};

Apicall:
	TypeCall ExternalType IndexName ""("" ParameterApicall <rightParentheses>	{#externalCall:}
|	TypeCall ExternalType IndexName ""("" ParameterApicall <rightParentheses> ""module:"" <string>	{#externalModuleCall:};

IndexName:
	<string>										{#externalFunction:}
|	<number>									{#externalIndex:};

TypeCall:
	""apicall:""									{#callConvention:}
|	""cdecl:""										{#callConvention:};

ParameterApicall:
	ExternalType 								{#parameterExtCall:}
|	ParameterApicall ExternalType 				{#parametersExtCall:};

ExternalType:
	<name>										{#externalType:}	
|	<name> ""*""									{#externalTypePointer:};

Primitive:
	""primitive:"" <string>							{#primitiveString:}
|	""primitive:"" <number>						{#primitiveNumber:}
|	""primitive:"" error 							{#primitiveArgMissing:}
|	""primitive:"" <string> ""module:"" <string>		{#primitiveModule:}
|	""primitive:"" <string> ""module:"" error 			{#moduleArgMissing:};"! !

!SqueakParser class methodsFor: 'generated-accessing' stamp: 'ms 4/7/2007 03:32'!
scannerClass
	^SqueakScanner! !

!SqueakParser class methodsFor: 'generated-starting states' stamp: 'ms 4/7/2007 03:32'!
startingStateForMethod
	^1! !

!SqueakParser class methodsFor: 'generated-starting states' stamp: 'ms 4/7/2007 03:32'!
startingStateForMethodPattern
	^3! !

!SqueakParser class methodsFor: 'generated-starting states' stamp: 'ms 4/7/2007 03:32'!
startingStateForSequence
	^2! !

!SqueakParser class methodsFor: 'tokens' stamp: 'ms 10/10/2006 22:04'!
tokenDescription: id
	
	^DicTokens at: id! !

!SqueakParser class methodsFor: 'tokens' stamp: 'ms 10/10/2006 22:24'!
tokensId
	
	^DicTokens keys! !

!SqueakParser methodsFor: 'private' stamp: 'ms 7/13/2006 10:02'!
actionForCurrentToken

	| ids action |
	ids := currentToken id.
	1 to: ids size do: [:i | 
		action := self actionFor: (ids at: i).
		(action bitAnd: self actionMask) = self errorAction ifFalse: [^ action].

		"Convert negative number to binarySymbol"
		(self isNegativeNumberId:(ids at: i)) ifTrue: [
			^self negativeNumberToBinaryString].

		"Ignore repeating periods"
		(self isEmptyStatementId: (ids at: i)) ifTrue: [
			^ self ignoreEmptyStatement].

	].
	^ self errorAction! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:01'!
add3: nodes

	^ nodes first copyWith: nodes third! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:59'!
add: nodes

	^ nodes first copyWith: nodes second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:54'!
addMessagePart: nodes

	^ {nodes first first copyWith: nodes second.
	   nodes first second copyWith: nodes third}! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/10/2006 22:39'!
argumentMissing: nodes
	
	messageError := 'Argument expected'.
	^nodes! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/1/2006 01:25'!
argumentNameMissing: nodes
	
	messageError := 'Argument name expected'.
	^nodes! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:58'!
array

	^ #()! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 18:00'!
array: nodes

	^ (RBArrayNode
		leftBrace: nodes first start
		rightBrace: nodes third stop
		statements: nodes second)
			firstToken: nodes first;
			lastToken: nodes last;
			yourself.! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 22:47'!
arrayAddToken: nodes
	
	^OrderedCollection with: #() with: nodes first with: nodes first! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:07'!
assignment: nodes

	^ RBAssignmentNode
		variable: nodes first
		value: nodes third! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 18:43'!
blockArgs: nodes

	^ (RBBlockNode
		arguments: nodes second
		body: (RBSequenceNode statements: #()))
		left: nodes first start;
		right: nodes third stop;
		firstToken: nodes first;
		lastToken: nodes last;
		yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 18:43'!
blockNoArgs: nodes

	^ (RBBlockNode
		body: nodes second)
		left: nodes first start;
		right: nodes third stop;
		firstToken: nodes first;
		lastToken: nodes last;
		yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 18:39'!
blockWithArgs: nodes

	^ (RBBlockNode
		arguments: nodes second
		body: nodes fourth)
		left: nodes first start;
		right: nodes fifth stop;
		firstToken: nodes first;
		lastToken: nodes last;
		yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 23:07'!
blockWithTemps: nodes

	^ (RBBlockNode
		arguments: nodes second
		body: ((RBSequenceNode
			temporaries: nodes fourth
			statements: nodes sixth) firstToken: nodes third))
		left: nodes first start;
		right: nodes seventh stop;
		firstToken: nodes first;
		lastToken: nodes last;
		yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:23'!
byteStream

	^ ByteArray new writeStream! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:25'!
byteStreamPut: nodes

	^ nodes first
		nextPut: nodes second value asNumber;
		yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:01'!
callConvention: nodes
	| descriptorClass |
	descriptorClass := Smalltalk at: #ExternalFunction ifAbsent:[^nil].
	^OrderedCollection with:(descriptorClass callingConventionFor: nodes first value) with: nodes first.! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:12'!
cascade: nodes

	^ (nodes first isKindOf: RBMessageNode)
		ifTrue: [RBCascadeNode messages:
			{nodes first.
			 RBMessageNode new
				receiver: nodes first receiver
				selectorParts: nodes third first
				arguments: nodes third last}]
		ifFalse: [RBCascadeNode messages:
			(nodes first messages copyWith:
				(RBMessageNode new
					receiver: nodes first messages first receiver
					selectorParts: nodes third first
					arguments: nodes third last))]! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/10/2006 22:36'!
cascadeMMissing: nodes
	
	messageError := 'Cascade expected'.
	^nodes! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 10/6/2006 15:14'!
checkForErrors
	"If we have an error correction installed, we might have handled the errors. If we did, we don't 
	want to return the result, so we raise a final exception that can't be proceeded."

	errorToken isNil ifTrue: [^self].
	currentToken := errorToken.
	self reportErrorMessage: (messageError ifNil:['Token not expected'])
	
	! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 10/10/2006 22:23'!
collectAcceptableToken
	
	^self class tokensId select:[:each | (self actionFor: each) ~~ self errorAction]! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:27'!
contents2: nodes

	^ nodes second contents! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 10/20/2006 17:52'!
expressionMissing: nodes
	
	messageError := 'Expression expected'.
	^nodes! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:40'!
externalCall: nodes

	| fn |

	Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn|
		fn := xfn name: nodes third
				module: nil 
				callType: nodes first first
				returnType: nodes second first
				argumentTypes: nodes fifth first contents.
	].
	^ OrderedCollection with: (Pragma keyword: #primitive: arguments: #(120)) with: fn with: 120  with: nodes first second with: nodes fifth second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 7/25/2006 13:37'!
externalFunction: nodes
	^nodes first value withoutQuoting asSymbol.! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 7/25/2006 13:37'!
externalIndex: nodes
	^nodes first value.! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:40'!
externalModuleCall: nodes
	| fn |
	Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn|
		fn := xfn name: nodes third 
				module: nodes last value withoutQuoting asSymbol
				callType: nodes first first
				returnType: nodes second first
				argumentTypes: nodes fifth first contents.
	].
	^ OrderedCollection with: (Pragma keyword: #primitive: arguments: #(120)) with: fn with: 120 with: nodes first second with: nodes last! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:30'!
externalType: nodes
	
	^OrderedCollection with: (self externalTypeOn: nodes) with: nodes last
	! !

!SqueakParser methodsFor: 'private' stamp: 'ms 9/4/2006 00:20'!
externalTypeOn: aNode
	| xType descriptorClass |
	descriptorClass := Smalltalk at: #ExternalFunction ifAbsent:[^nil].
	xType := descriptorClass atomicTypeNamed: aNode first value.
	xType == nil ifTrue:["Look up from class scope"
		Symbol hasInterned: aNode first value ifTrue:[:sym|
			xType := descriptorClass structTypeNamed: sym]].
	xType == nil ifTrue:[
		"Raise an error if user is there"
		self interactive ifTrue:[^nil].
		"otherwise go over it silently"
		xType := descriptorClass forceTypeNamed: aNode first value].
	^xType.! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:34'!
externalTypePointer: nodes

	| xType |
	xType := self externalTypeOn: nodes.
	xType ifNil:[^nodes].
	^OrderedCollection with: xType asPointerType with: nodes last! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/11/2006 17:21'!
findErrorHandlerIfNoneUseErrorNumber: anInteger

	| state reduceEntry items reduceIndex |
	state := self stateErrorShiftInto.
	state = 0 
		ifFalse:[reduceIndex := (self findReduceActionForState: state).
				stateStack addLast: state.
			     reduceEntry := self reduceTable at: reduceIndex.
			     items := OrderedCollection new: (reduceEntry at: 2).
			     self performReduceMethod: (reduceEntry at: 3) with: items].
	self reportError: anInteger
	! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 10/20/2006 17:33'!
findReduceActionForState: state

	1 to: self errorTokenId do: [:i |
		| action |
		action := self actionForState: state and: i.
		(action bitAnd: self actionMask) = self reduceAction 
			ifTrue: [^action bitShift: -2]].
	^0! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:53'!
first: nodes

	^ nodes first! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:01'!
firstIn: nodes

	^ {nodes first}! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 10/20/2006 18:00'!
handleError: anInteger 

	errorToken isNil ifTrue: [errorToken := currentToken].
	self hasErrorHandler not ifTrue: [self reportError: anInteger].
	self findErrorHandlerIfNoneUseErrorNumber: anInteger! !

!SqueakParser methodsFor: 'private' stamp: 'ms 7/13/2006 09:48'!
ignoreEmptyStatement
	
	currentToken _ nil.
	self getNextToken.
	^ self actionForCurrentToken! !

!SqueakParser methodsFor: 'private' stamp: 'ms 7/13/2006 09:59'!
isEmptyStatementId: id

	^ ((id = scanner periodId) and: [nodeStack isEmpty]) 
		or: [(id = scanner periodId) and: [(nodeStack last isKindOf: SmaCCToken) and: [nodeStack last id first = scanner periodId]]] ! !

!SqueakParser methodsFor: 'private' stamp: 'ms 7/13/2006 09:58'!
isNegativeNumberId: id

	^ scanner negativeNumberId = id! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/19/2006 16:25'!
litArray: nodes

	| litToken |
	litToken := (SqueakToken
			value: (String new: (nodes fourth stop - nodes second start + 1))
			start: nodes second start).
	litToken previous: nodes first previous.
	litToken next: nodes last next.
	^ (RBLiteralNode
		literalToken: litToken
		value: nodes third contents) 
			firstToken: nodes first; 
			lastToken: nodes last; 
			yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:16'!
litChar: nodes

	^ RBLiteralNode
		literalToken: nodes first
		value: (nodes first value at: 2)! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:14'!
litFalse: nodes

	^ RBLiteralNode
		literalToken: nodes first
		value: false! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:14'!
litNil: nodes

	^ RBLiteralNode
		literalToken: nodes first
		value: nil! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'md 10/18/2004 17:23'!
litNumber: nodes

	| str num |
	str _ nodes first value readStream.
	num _ Number readFrom: str.
	str atEnd ifFalse: [
		currentToken _ nil.
		scanner position: scanner position - (str originalContents size - str position) + 1.
		self reportErrorMessage: 'Digit out of range'].
	^ RBLiteralNode
		literalToken: nodes first
		value: num! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:18'!
litString: nodes

	| s |
	s _ nodes first value.
	^ RBLiteralNode
		literalToken: nodes first
		value: ((s copyFrom: 2 to: s size - 1)
				copyReplaceAll: '''''' with: '''')! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 3/31/2007 17:53'!
litStringSymbol: nodes

	| s |
	s := nodes second value.
	^ (RBLiteralNode
		literalToken: nodes second
		value: ((s copyFrom: 2 to: s size - 1)
				copyReplaceAll: '''''' with: '''') asSymbol) firstToken: nodes first; yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 19:12'!
litSymbol: nodes

	^ (RBLiteralNode
		literalToken: nodes second
		value: nodes second value asSymbol) firstToken: nodes first; yourself! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:14'!
litTrue: nodes

	^ RBLiteralNode
		literalToken: nodes first
		value: true! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/11/2006 12:29'!
literalMissing: nodes
	
	messageError := 'Literal constant expected'.
	^nodes! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:52'!
messagePart: nodes

	^ {{nodes first}. {nodes second}}! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:28'!
messagePragma: nodes
	"self haltIf: [(nodes first first isKindOf: Pragma) not]."
	^nodes first
! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:13'!
messageSend: nodes

	^ RBMessageNode new
		receiver: nodes first
		selectorParts: nodes second first
		arguments: nodes second last! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:48'!
method: nodes

	^ RBMethodNode new
		selectorParts: nodes first first
		arguments: nodes first last;
		body: nodes second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 7/15/2006 19:07'!
methodPragma: nodes
	^RBMethodNode new
		selectorParts: nodes first first
		arguments: nodes first last;
		body: nodes third;
		pragmas:nodes second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'pmm 11/11/2006 14:12'!
methodPragmaTempsPragma: nodes

	| sequence |
	sequence := (RBSequenceNode
		temporaries: nodes third first
		statements: nodes fifth) 
		firstToken: nodes third second; 
		yourself.
	nodes fifth isEmpty ifFalse: [
		sequence lastToken: nodes third third ].
	^ RBMethodNode new 
		selectorParts: nodes first first
		arguments: nodes first last;
		body: sequence;
		pragmas: (nodes second addAll: nodes fourth; yourself)! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'pmm 11/11/2006 14:15'!
methodTempsPragma: nodes

	| sequence |
	sequence := (RBSequenceNode
		temporaries: nodes second first
		statements: nodes fourth)
		firstToken: nodes second second; 
		yourself.
	nodes fourth isEmpty ifFalse: [
			sequence lastToken: nodes second third ].
	^ RBMethodNode new
		selectorParts: nodes first first
		arguments: nodes first last;
		body: sequence;
		pragmas: nodes third! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/11/2006 12:12'!
moduleArgMissing: nodes
	
	messageError := 'Module name expected'.
	^nodes! !

!SqueakParser methodsFor: 'private' stamp: 'ms 9/17/2006 15:27'!
negativeNumberToBinaryString
	
	currentToken := (SqueakToken 
		value: '-'
		start: currentToken startPosition
		id: (Array with: scanner binarySymbolId)) substitueTo: currentToken; yourself.
	scanner position: currentToken stopPosition.
	^ self actionForCurrentToken! !

!SqueakParser methodsFor: 'private' stamp: 'ajh 3/6/2003 00:02'!
nodeStack

	^ nodeStack! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:31'!
parameterExtCall: nodes

	| args |
	args := WriteStream on: Array new.
	args nextPut: nodes first first.
	^OrderedCollection with: args with: nodes first second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:34'!
parametersExtCall: nodes

	| aCol |
	aCol := nodes first.
	aCol  first nextPut: (nodes second first).
	aCol at: 2 put: nodes second second.
	^aCol! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 17:13'!
pragma: nodes
	"self haltIf: [nodes second first isKindOf: Pragma]."
	"| pragmaNode |
	pragmaNode := RBPragmasNode withPragma: nodes second first spec: nodes second second.
	nodes second third ifNotNil: [pragmaNode primitiveNumber: nodes second third].
	^pragmaNode"
	
	| rbPragma |
	rbPragma := RBPragmaNode pragma: nodes second first 
								spec: nodes second second 
								start: nodes first start 
								stop: nodes third stop 
								firstToken: nodes first
								lastToken: nodes last.
	nodes second third ifNotNil: [rbPragma primitiveNumber: nodes second third].
	^OrderedCollection with: rbPragma! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/1/2006 01:34'!
pragmaEndMissing: nodes
	
	messageError := '> expected'.
	^nodes! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 11/11/2006 17:42'!
pragmaMessage: nodes

	| arguments keyword |
	keyword := String new.
	arguments := (nodes first second collect: [:each | each value]).
	nodes first first do: [:each | keyword := keyword, each value].
	^OrderedCollection with:(Pragma keyword: keyword asSymbol arguments: arguments)
					  with: nil
					  with: nil
					  with: nodes first first first
					  with: nodes first second last token
	
	
	! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/10/2006 22:32'!
pragmaMissing: nodes

	messageError := 'Pragma declaration expected'.
	^ nodes! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 01:47'!
pragmaUnaryMessage: nodes

	^OrderedCollection with:(Pragma keyword: nodes first first first value asSymbol arguments: nodes first second)
					  with: nil
					  with: nil
					  with: nodes first first first
					  with: nodes first first first
	
	
	! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 17:24'!
pragmas: nodes
	"nodes first addPragma: nodes third first withSpec: nodes third second.
	nodes third third ifNotNil: [nodes first primitiveNumber: nodes third third].
	^nodes first"
	
	| rbPragma |
	rbPragma := RBPragmaNode pragma: nodes third first 
								spec: nodes third second 
								start: nodes second start 
								stop: nodes fourth stop 
								firstToken: nodes second 
								lastToken: nodes last.
	nodes third third ifNotNil: [rbPragma primitiveNumber: nodes third third].
	nodes first add: rbPragma.
	^nodes first
	! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/11/2006 12:10'!
primitiveArgMissing: nodes
	
	messageError := 'String or number primitive expected'.
	^nodes! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 00:54'!
primitiveModule: nodes
	^OrderedCollection with: (Pragma keyword: #primitive:module: 
									 arguments: (Array with: nodes second value withoutQuoting asSymbol
														with: nodes fourth value withoutQuoting asSymbol)) 
					  with: (Array with: nodes fourth value withoutQuoting asSymbol 
								    with: nodes second value withoutQuoting asSymbol 
								    with: 0 with: 0)
					  with: 117
					  with: nodes first
					  with: nodes last

	! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 00:54'!
primitiveNumber: nodes

	^OrderedCollection with: (Pragma keyword: #primitive: arguments: (Array with: nodes second value asInteger)) 
					  with: nil
					  with: nodes second value asInteger
					  with: nodes first
					  with: nodes second
	! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/17/2006 00:53'!
primitiveString: nodes

	^OrderedCollection with: (Pragma keyword: #primitive: 
									 arguments: (Array with: nodes second value withoutQuoting asSymbol)) 
					   with: (Array with: nil 
									with: nodes second value withoutQuoting asSymbol 
									with: 0 with: 0)
					   with: 117
					   with: nodes first
					   with: nodes second! !

!SqueakParser methodsFor: 'generated-reduction actions' stamp: 'ms 4/7/2007 03:32'!
reduceActionForOptionalXXXperiodX1: nodes 
	^ nil! !

!SqueakParser methodsFor: 'generated-reduction actions' stamp: 'ms 4/7/2007 03:32'!
reduceActionForOptionalXXXperiodX2: nodes 
	^ nodes at: 1! !

!SqueakParser methodsFor: 'generated-tables' stamp: 'ms 4/7/2007 03:32'!
reduceTable
	^#(
#(39 1 #reduceFor:)
#(40 1 #variable:)
#(41 2 #messagePart:)
#(41 2 #argumentNameMissing:)
#(41 3 #addMessagePart:)
#(41 3 #argumentNameMissing:)
#(42 2 #method:)
#(42 3 #methodPragma:)
#(42 5 #methodPragmaTempsPragma:)
#(42 4 #methodTempsPragma:)
#(43 0 #array)
#(43 2 #add:)
#(44 1 #firstIn:)
#(44 3 #add3:)
#(45 0 #reduceActionForOptionalXXXperiodX1:)
#(45 1 #reduceActionForOptionalXXXperiodX2:)
#(46 1 #first:)
#(46 1 #first:)
#(46 1 #first:)
#(47 2 #secondIn:)
#(47 2 #argumentNameMissing:)
#(47 3 #add3:)
#(47 3 #argumentNameMissing:)
#(48 5 #blockWithArgs:)
#(48 3 #blockNoArgs:)
#(48 3 #blockArgs:)
#(48 7 #blockWithTemps:)
#(49 3 #assignment:)
#(49 3 #expressionMissing:)
#(50 1 #first:)
#(50 3 #cascade:)
#(50 3 #cascadeMMissing:)
#(51 0 #array)
#(51 2 #first:)
#(51 5 #returnAdd:)
#(51 3 #return:)
#(52 3 #array:)
#(53 1 #litTrue:)
#(53 1 #litFalse:)
#(53 1 #litNil:)
#(53 1 #litNumber:)
#(53 1 #litNumber:)
#(53 1 #litChar:)
#(53 1 #litString:)
#(53 2 #litStringSymbol:)
#(53 2 #litSymbol:)
#(53 2 #litSymbol:)
#(53 2 #litSymbol:)
#(53 2 #litSymbol:)
#(53 2 #litSymbol:)
#(53 4 #litArray:)
#(53 4 #litArray:)
#(53 1 #litString:)
#(54 1 #first:)
#(54 1 #first:)
#(54 1 #first:)
#(55 1 #arrayAddToken:)
#(55 3 #secondAddToken:)
#(55 3 #verticalBarMissing:)
#(56 1 #sequence:)
#(56 2 #sequenceWithTemps:)
#(57 2 #messageSend:)
#(57 2 #messageSend:)
#(57 2 #messageSend:)
#(58 2 #messageSend:)
#(58 2 #messageSend:)
#(58 2 #messageSend:)
#(59 2 #messageSend:)
#(59 2 #messageSend:)
#(60 1 #unaryMessage:)
#(61 2 #messagePart:)
#(61 2 #argumentMissing:)
#(62 2 #messagePart:)
#(62 2 #argumentMissing:)
#(62 3 #addMessagePart:)
#(62 3 #argumentMissing:)
#(63 1 #first:)
#(63 1 #first:)
#(63 1 #first:)
#(64 1 #first:)
#(64 1 #first:)
#(65 3 #pragma:)
#(65 3 #pragmaEndMissing:)
#(65 2 #pragmaMissing:)
#(65 4 #pragmas:)
#(65 4 #pragmaEndMissing:)
#(65 3 #pragmaMissing:)
#(66 0 #byteStream)
#(66 2 #byteStreamPut:)
#(67 0 #stream)
#(67 2 #streamPut:)
#(68 1 #value:)
#(68 1 #valueSymbol:)
#(68 1 #valueSymbol:)
#(68 1 #valueSymbol:)
#(68 1 #valueSymbol:)
#(68 1 #valueSymbol:)
#(68 3 #contents2:)
#(68 3 #contents2:)
#(68 1 #valueSymbol:)
#(69 3 #secondWithParenthesis:)
#(69 1 #first:)
#(69 1 #first:)
#(69 1 #first:)
#(69 1 #first:)
#(70 6 #externalCall:)
#(70 8 #externalModuleCall:)
#(71 2 #primitiveString:)
#(71 2 #primitiveNumber:)
#(71 2 #primitiveArgMissing:)
#(71 4 #primitiveModule:)
#(71 4 #moduleArgMissing:)
#(72 1 #pragmaMessage:)
#(72 1 #pragmaMessage:)
#(72 1 #pragmaUnaryMessage:)
#(73 2 #messagePart:)
#(73 2 #literalMissing:)
#(73 3 #addMessagePart:)
#(73 3 #literalMissing:)
#(74 2 #messagePart:)
#(74 2 #argumentMissing:)
#(75 1 #first:)
#(75 1 #first:)
#(75 1 #first:)
#(75 1 #first:)
#(76 1 #callConvention:)
#(76 1 #callConvention:)
#(77 1 #externalType:)
#(77 2 #externalTypePointer:)
#(78 1 #externalFunction:)
#(78 1 #externalIndex:)
#(79 1 #parameterExtCall:)
#(79 2 #parametersExtCall:)
#(82 1 #unaryMessage:)
#(82 2 #messagePart:)
#(82 2 #argumentNameMissing:)
#(82 1 #first:)
#(83 1 #first:)
#(83 1 #first:)
#(83 1 #first:)
#(84 1 #messagePragma:)
#(84 1 #messagePragma:)
#(84 1 #messagePragma:)
)! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 10/19/2006 22:15'!
reportError: anInteger 

	messageError ifNil:[
		| acceptedToken |
		messageError := ''.
		acceptedToken := self collectAcceptableToken asArray.
		acceptedToken 
			do: [:each | acceptedToken last == each 
							ifFalse:[messageError := messageError,  
										(self class tokenDescription: each)]
							ifTrue:[messageError := messageError, 
										(self class tokenDescription: each), ' expected']]
			separatedByNext:[:each | acceptedToken last == each 
							ifFalse:[messageError := messageError, ', ']
							ifTrue:[messageError := messageError, ' or ']].
	messageError := messageError capitalized].
	self reportErrorMessage: (anInteger = 0 
				ifTrue: [messageError]
				ifFalse: [self errorTable at: anInteger])
	
	! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 18:50'!
return: nodes

	^ {(RBReturnNode
		return: nodes first start
		value: nodes second) firstToken: nodes first; yourself}! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/19/2003 13:49'!
returnAdd: nodes

	^ nodes first copyWith: (RBReturnNode
		return: nodes third start
		value: nodes fourth)! !

!SqueakParser methodsFor: 'private' stamp: 'ajh 3/6/2003 00:19'!
scanner

	^ scanner! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:58'!
second: nodes

	^ nodes second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 3/31/2007 20:31'!
secondAddToken: nodes
	
	^OrderedCollection with: nodes second with: nodes first with: nodes last! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:06'!
secondIn: nodes

	^ {nodes second}! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/18/2006 17:47'!
secondPutToken: nodes

	nodes second firstToken: nodes first.
	nodes second lastToken: nodes last.
	^nodes second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 3/31/2007 17:51'!
secondWithParenthesis: nodes

	nodes second addParenthesis: (nodes first start to: nodes last stop).
	nodes second firstToken: nodes first.
	nodes second lastToken: nodes last.
	^nodes second! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:57'!
sequence: nodes

	^ RBSequenceNode
		statements: nodes first! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ms 9/25/2006 12:55'!
sequenceWithTemps: nodes

	nodes second ifNotEmpty: [^ (RBSequenceNode
					temporaries: nodes first first
					statements: nodes second) firstToken: nodes first second; yourself]
				ifEmpty:[^ (RBSequenceNode
					temporaries: nodes first first
					statements: nodes second) 
						firstToken: nodes first second;
						lastToken:nodes first third]! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 11/10/2006 22:31'!
stateErrorShiftInto

	stateStack size to: 1
		by: -1
		do: 
			[:i | 
			| action |
			action := self actionForState: (stateStack at: i) and: self errorTokenId.
			(action bitAnd: self actionMask) = self reduceAction 
				ifTrue:[self reduce:(action bitShift: -2).
						^self stateErrorShiftInto].
			(action bitAnd: self actionMask) = self shiftAction 
				ifTrue: [^ action bitShift: -2].
			stateStack removeLast].
	^ 0! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:23'!
stream

	^ Array new writeStream! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:26'!
streamPut: nodes

	^ nodes first
		nextPut: nodes second;
		yourself! !

!SqueakParser methodsFor: 'generated-tables' stamp: 'ms 4/7/2007 03:32'!
transitionTable
	^#(
#(3 17 22 21 23 25 25 29 41 33 42 37 82)
#(3 41 1 45 2 49 4 53 5 57 8 61 9 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 109 44 113 46 117 48 121 49 125 50 129 51 133 52 137 53 141 54 145 55 149 56 153 57 157 58 161 59 165 69 134 80)
#(3 17 22 21 23 25 25 29 41 169 82)
#(2 538 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(3 97 22 173 40 177 81)
#(3 97 22 181 40 185 81)
#(3 550 1 550 2 550 4 550 5 550 6 550 8 550 9 550 10 550 15 550 16 550 17 550 18 550 19 550 20 550 21 550 22 189 23 550 30 550 80)
#(2 0 80)
#(3 41 1 45 2 49 4 53 5 193 6 57 8 61 9 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 109 44 113 46 117 48 121 49 125 50 129 51 133 52 137 53 141 54 197 55 201 56 153 57 157 58 161 59 205 65 165 69 134 80)
#(3 41 1 45 2 49 4 53 5 57 8 61 9 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 134 33 209 36 105 40 109 44 113 46 213 47 117 48 121 49 125 50 129 51 133 52 137 53 141 54 145 55 217 56 153 57 157 58 161 59 165 69)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 221 46 117 48 121 49 125 50 133 52 137 53 141 54 153 57 157 58 161 59 165 69)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 225 46 117 48 121 49 125 50 133 52 137 53 141 54 153 57 157 58 161 59 165 69)
#(3 41 1 45 2 49 4 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 134 34 105 40 109 44 113 46 117 48 121 49 125 50 229 51 133 52 137 53 141 54 153 57 157 58 161 59 165 69)
#(2 230 1 2 4 5 6 10 15 16 17 18 19 20 21 22 30 33 80)
#(3 46 9 46 22 233 43 46 81)
#(2 154 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 158 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 162 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(3 237 1 241 2 245 21 249 22 253 23 257 24 261 25 265 27)
#(2 214 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 166 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 170 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 178 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 10 1 2 4 5 6 7 8 9 10 15 16 17 18 19 20 21 22 23 25 26 30 31 33 34 35 36 37 80 81)
#(2 174 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(3 422 22 422 23 422 25 269 26 422 31 422 33 422 34 422 35 422 80)
#(3 273 31 62 33 62 34 277 45 62 80)
#(2 54 31 33 34 80)
#(2 414 22 23 25 31 33 34 35 37 80)
#(2 70 31 33 34 35 80)
#(3 74 31 74 33 74 34 74 35 281 37 74 80)
#(2 242 33 80)
#(2 410 22 23 25 31 33 34 35 37 80)
#(2 418 22 23 25 31 33 34 35 37 80)
#(2 122 31 33 34 35 37 80)
#(3 41 1 45 2 49 4 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 134 33 105 40 109 44 113 46 117 48 121 49 125 50 285 51 133 52 137 53 141 54 153 57 157 58 161 59 165 69 134 80)
#(2 0 80)
#(2 218 31 33 34 35 37 80)
#(3 289 23 293 25 222 31 222 33 222 34 222 35 222 37 297 61 301 62 222 80)
#(3 305 22 289 23 293 25 226 31 226 33 226 34 226 35 226 37 309 60 313 61 317 62 226 80)
#(3 305 22 289 23 293 25 78 31 78 33 78 34 78 35 321 60 325 61 329 62 78 80)
#(2 0 80)
#(2 14 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 23 30 80)
#(2 18 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 23 30 80)
#(2 542 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(2 546 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(3 97 22 333 40 337 81)
#(3 341 3 345 11 349 14 305 22 353 23 357 25 361 60 365 62 369 70 373 71 377 72 381 73 385 74 389 76 393 81 397 84)
#(3 41 1 45 2 49 4 53 5 193 6 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 109 44 113 46 117 48 121 49 125 50 285 51 133 52 137 53 141 54 153 57 157 58 161 59 401 65 165 69 134 80)
#(2 30 80)
#(3 41 1 45 2 49 4 53 5 405 6 57 8 61 9 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 109 44 113 46 117 48 121 49 125 50 129 51 133 52 137 53 141 54 409 55 413 56 153 57 157 58 161 59 165 69 134 80)
#(3 97 22 417 40 421 81)
#(3 425 8 429 9 433 33 437 36)
#(2 441 33)
#(2 445 35)
#(3 449 31 62 33 62 34 453 45 62 80)
#(2 457 34)
#(3 461 9 97 22 465 40 469 81)
#(3 354 19 354 33 473 66)
#(3 362 1 362 2 362 10 362 15 362 16 362 17 362 18 362 19 362 20 362 21 362 22 362 23 362 24 362 25 362 27 362 30 362 35 362 38 477 67)
#(2 182 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 186 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 194 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 198 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 190 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 202 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 481 46 117 48 121 49 125 50 133 52 137 53 141 54 153 57 157 58 161 59 165 69 485 81)
#(3 41 1 45 2 489 4 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 66 33 66 34 105 40 493 46 117 48 121 49 125 50 133 52 137 53 141 54 153 57 157 58 161 59 165 69 66 80)
#(2 138 33 34 80)
#(3 305 22 289 23 293 25 497 60 501 61 505 62 509 81 513 83)
#(2 246 33 80)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 517 40 117 48 133 52 137 53 521 58 525 59 529 63 533 69 537 81)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 517 40 117 48 133 52 137 53 541 59 545 64 549 69 553 81)
#(2 262 23 25 31 33 34 35 37 80)
#(3 557 23 250 31 250 33 250 34 250 35 250 37 250 80)
#(2 282 7 22 23 25 31 33 34 35 37 80 81)
#(2 274 22 23 25 31 33 34 35 37 80)
#(2 266 23 25 31 33 34 35 37 80)
#(3 557 23 254 31 254 33 254 34 254 35 254 37 254 80)
#(2 278 22 23 25 31 33 34 35 37 80)
#(2 270 23 25 31 33 34 35 37 80)
#(3 557 23 258 31 258 33 258 34 258 35 258 37 258 80)
#(2 22 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 23 30 80)
#(2 26 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 23 30 80)
#(3 561 19 565 21 569 81)
#(2 510 22)
#(2 506 22)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 573 40 577 48 581 52 585 53 521 58 525 59 529 63 533 69 589 75 593 81)
#(3 41 1 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 597 40 601 48 605 52 609 53 613 75 617 81)
#(2 462 7 81)
#(2 621 23)
#(2 566 7 81)
#(2 570 7 81)
#(2 574 7 81)
#(2 454 7 81)
#(2 458 7 81)
#(3 625 22 629 77)
#(2 338 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(3 633 7 637 81)
#(3 41 1 45 2 49 4 53 5 405 6 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 109 44 113 46 117 48 121 49 125 50 641 51 133 52 137 53 141 54 153 57 157 58 161 59 165 69 134 80)
#(3 341 3 345 11 349 14 305 22 353 23 357 25 361 60 365 62 369 70 373 71 377 72 381 73 385 74 389 76 645 81 649 84)
#(3 41 1 45 2 49 4 53 5 193 6 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 109 44 113 46 117 48 121 49 125 50 285 51 133 52 137 53 141 54 153 57 157 58 161 59 653 65 165 69 134 80)
#(2 34 80)
#(2 82 8 9 33 36)
#(2 86 8 9 33 36)
#(3 46 9 46 22 657 43)
#(3 41 1 45 2 49 4 53 5 57 8 61 9 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 134 33 105 40 109 44 113 46 117 48 121 49 125 50 129 51 133 52 137 53 141 54 145 55 661 56 153 57 157 58 161 59 165 69)
#(2 106 7 22 23 25 31 33 34 35 37 80 81)
#(3 97 22 665 40 669 81)
#(2 102 7 22 23 25 31 33 34 35 37 80 81)
#(2 406 22 23 25 31 33 34 35 37 80)
#(2 66 33 34 80)
#(2 146 33 34 80)
#(2 150 7 22 23 25 31 33 34 35 37 80 81)
#(2 234 1 2 4 5 6 10 15 16 17 18 19 20 21 22 30 33 80)
#(2 50 9 22 81)
#(2 238 1 2 4 5 6 10 15 16 17 18 19 20 21 22 30 33 80)
#(3 673 19 677 33)
#(3 681 1 685 2 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 689 22 693 23 697 24 701 25 705 27 101 30 709 35 713 38 717 53 721 68)
#(2 114 31 33 34 35 80)
#(2 118 31 33 34 35 80)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 725 46 117 48 121 49 125 50 133 52 137 53 141 54 153 57 157 58 161 59 165 69)
#(2 58 31 33 34 80)
#(2 554 31 33 34 35 37 80)
#(2 558 31 33 34 35 37 80)
#(3 557 23 562 31 562 33 562 34 562 35 562 37 562 80)
#(2 130 31 33 34 35 37 80)
#(2 126 31 33 34 35 37 80)
#(2 422 22 23 25 31 33 34 35 37 80)
#(3 310 23 293 25 310 31 310 33 310 34 310 35 310 37 297 61 310 80)
#(3 305 22 314 23 293 25 314 31 314 33 314 34 314 35 314 37 309 60 313 61 314 80)
#(2 294 23 31 33 34 35 37 80)
#(3 305 22 318 23 293 25 318 31 318 33 318 34 318 35 318 37 321 60 325 61 318 80)
#(2 298 23 31 33 34 35 37 80)
#(3 305 22 322 23 322 25 322 31 322 33 322 34 322 35 322 37 309 60 322 80)
#(2 286 23 25 31 33 34 35 37 80)
#(3 305 22 326 23 326 25 326 31 326 33 326 34 326 35 326 37 321 60 326 80)
#(2 290 23 25 31 33 34 35 37 80)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 517 40 117 48 133 52 137 53 521 58 525 59 729 63 533 69 733 81)
#(2 438 7 81)
#(3 434 7 737 13 434 81)
#(2 442 7 81)
#(3 502 7 422 22 422 23 422 25 502 81)
#(3 494 7 414 22 414 23 414 25 494 81)
#(3 490 7 410 22 410 23 410 25 490 81)
#(3 498 7 418 22 418 23 418 25 498 81)
#(2 466 7 81)
#(3 470 7 298 23 470 81)
#(2 502 7 81)
#(2 494 7 81)
#(2 490 7 81)
#(2 498 7 81)
#(2 482 7 81)
#(2 486 7 81)
#(3 41 1 45 2 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 573 40 577 48 581 52 585 53 521 58 525 59 729 63 533 69 741 75 745 81)
#(3 749 12 514 19 514 21 514 22 514 35)
#(3 753 19 757 21 761 78)
#(2 330 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(2 334 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(2 42 80)
#(2 350 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(3 765 7 769 81)
#(3 41 1 45 2 49 4 53 5 405 6 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 105 40 109 44 113 46 117 48 121 49 125 50 773 51 133 52 137 53 141 54 153 57 157 58 161 59 165 69 134 80)
#(3 777 9 97 22 465 40)
#(2 781 33)
#(2 90 8 9 33 36)
#(2 94 8 9 33 36)
#(2 358 19 33)
#(2 206 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(3 354 19 354 33 785 66)
#(3 362 1 362 2 362 10 362 15 362 16 362 17 362 18 362 19 362 20 362 21 362 22 362 23 362 24 362 25 362 27 362 30 362 35 362 38 789 67)
#(2 374 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 382 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 386 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 378 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 390 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 210 1 2 7 10 15 16 17 18 19 20 21 22 23 24 25 27 30 31 33 34 35 37 38 80 81)
#(2 402 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 370 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 366 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(3 449 31 62 33 62 34 793 45 62 80)
#(2 302 23 31 33 34 35 37 80)
#(2 306 23 31 33 34 35 37 80)
#(3 797 21 801 81)
#(2 474 7 81)
#(3 478 7 306 23 478 81)
#(2 518 19 21 22 35)
#(2 526 2)
#(2 522 2)
#(2 805 2)
#(2 342 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(2 346 1 2 4 5 6 8 9 10 15 16 17 18 19 20 21 22 30 80)
#(2 38 80)
#(3 41 1 45 2 49 4 53 5 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 97 22 101 30 134 33 105 40 109 44 113 46 117 48 121 49 125 50 809 51 133 52 137 53 141 54 153 57 157 58 161 59 165 69)
#(2 98 7 22 23 25 31 33 34 35 37 80 81)
#(3 673 19 813 33)
#(3 681 1 685 2 65 10 69 15 73 16 77 17 81 18 85 19 89 20 93 21 689 22 693 23 697 24 701 25 705 27 101 30 817 35 713 38 717 53 721 68)
#(2 142 33 34 80)
#(2 446 7 81)
#(2 450 7 81)
#(3 625 22 821 77 825 79)
#(2 829 33)
#(2 398 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 394 1 2 10 15 16 17 18 19 20 21 22 23 24 25 27 30 35 38)
#(2 530 22 35)
#(3 625 22 833 35 837 77)
#(2 110 7 22 23 25 31 33 34 35 37 80 81)
#(3 426 7 841 13 426 81)
#(2 534 22 35)
#(2 845 21)
#(2 430 7 81)
)! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/14/2003 23:52'!
unaryMessage: nodes

	^ {{nodes first}. #()}! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:27'!
value: nodes

	^ nodes first value! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:27'!
valueSymbol: nodes

	^ nodes first value asSymbol! !

!SqueakParser methodsFor: 'reduction actions' stamp: 'ajh 3/15/2003 00:13'!
variable: nodes

	^ RBVariableNode new
		identifierToken: nodes first! !

!SqueakParser methodsFor: 'error handling' stamp: 'ms 10/20/2006 17:44'!
verticalBarMissing: nodes
	
	messageError := 'Vertical bar expected'.
	^nodes! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'ajh 6/28/2004 13:52'!
compiledMethod

	^ self ir compiledMethod! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'md 2/21/2006 14:41'!
generate
	"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."

	^self generate: #(0 0 0 0)! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'ajh 3/10/2003 20:23'!
generate: trailer

	^ self generateIR compiledMethodWith: trailer! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'md 4/8/2007 17:45'!
generateIR
	| irm |
	
	irm := ASTTranslator new translateBlockNode: self; ir.
	self privIR: irm.
	^irm.! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'pmm 8/16/2006 21:34'!
generateWith: trailer using: aCompiledMethodClass

	^ self generateIR compiledMethodWith: trailer using: aCompiledMethodClass! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'md 4/8/2007 17:48'!
ir
	^ self propertyAt: #ir ifAbsent: [self generateIR].! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'md 2/27/2006 18:13'!
methodNodeFormattedAndDecorated: decorate
	"Answer a method node made from pretty-printed (and colorized, if decorate is true) 
	 source text."

	^ self method methodNodeFormattedAndDecorated: decorate.! !

!RBBlockNode methodsFor: '*newcompiler' stamp: 'md 4/8/2007 17:49'!
privIR: irMethod

	irMethod ifNil: [^self removeProperty: #ir ifAbsent: []].
	self propertyAt: #ir put: irMethod.! !

SmaCCScanner subclass: #SqueakScanner
	instanceVariableNames: 'previousToken comments'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SqueakScanner commentStamp: 'ajh 3/24/2003 21:31' prior: 0!
I parse Smalltalk text into tokens which are used by the SqueakParser.  Methods under 'generated-*' categories were automatically generated using SmaCC.!

SqueakScanner subclass: #SqueakMethodPatternScanner
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Syntax'!

!SqueakMethodPatternScanner class methodsFor: 'generated-comments' stamp: 'ms 11/19/2006 17:05'!
scannerDefinitionComment

	"<decimalNumber>:	[0-9]+ (\. [0-9]+)? ;
<radixNumber>:		[0-9]+ r [0-9A-Z]+ (\. [0-9A-Z]+)? ;
<scaledNumber>:		<decimalNumber> s [0-9]+ ;
<exponentNumber>:	(<decimalNumber> | <radixNumber>) e \-? [0-9]+ ;
<number>:			<decimalNumber> | <radixNumber> | <exponentNumber> | <scaledNumber> ;
<negativeNumber>:	\- <number> ;
<string>:				\'  [^\']* \' (\' [^\']* \')* ;
<name>:				[a-zA-Z] [a-zA-Z0-9]* ;
<keyword>:			<name> \: ;
<multikeyword>:		<name> \: (<name> \: )+ ;
<binarySymbol>:		[\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,] [\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,]* ;
<assignment>:		\: \= | \_ ;
<alternateKeyword>:	\: <name> \: (<name> \:)* ;
<whitespace>:		\s+ ;
<comment>:			\"" [^\""]* \"" ;
<character>:			\$ . ;
<period>:				\. ;
<variableAssignment>:	<name> \: \= ;
<rightBoxBrackets>:	];
<rightCurlyBrackets>:	};
<rightParentheses>:	\);
<colon>:				\:;
<semicolon>:			\;;
<anyChar>:			. ; # For VW literal arrays that handle #(;) -> #(#';');"! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
assignmentId
	^16! !

!SqueakMethodPatternScanner methodsFor: 'token hanling' stamp: 'ms 11/25/2006 10:00'!
binarySymbol
	matchActions := {self binarySymbolId}.
	^ self createTokenFor: outputStream contents! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
binarySymbolId
	^15! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
characterId
	^20! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
colonId
	^26! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
emptySymbolTokenId
	^35! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
errorTokenId
	^36! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
keywordId
	^13! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
multikeywordId
	^14! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
nameId
	^12! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
negativeNumberId
	^10! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
numberId
	^9! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
periodId
	^21! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
rightBoxBracketsId
	^23! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
rightCurlyBracketsId
	^24! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
rightParenthesesId
	^25! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan1
	self step.
	currentCharacter isDigit 
		ifTrue: 
			[
			[self recordMatch: #(10 ).
			self step.
			currentCharacter isDigit] 
					whileTrue.
			^ self reportLastMatch].
	currentCharacter == $- ifTrue: [^ self scan2].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan10
	self step.
	currentCharacter isDigit 
		ifTrue: 
			[
			[self recordMatch: #(7 9 ).
			self step.
			currentCharacter isDigit] 
					whileTrue.
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan11
	self recordMatch: #(13 ).
	self step.
	((currentCharacter between: $A and: $Z) 
		or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan5].
	currentCharacter == $= 
		ifTrue: [^ self recordAndReportMatch: #variableAssignment].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan2
	self step.
	currentCharacter isDigit 
		ifTrue: 
			[
			[self recordMatch: #(10 ).
			self step.
			currentCharacter isDigit] 
					whileTrue.
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan3
	
	[self step.
	currentCharacter ~~ $'] whileTrue.
	^ self scan4! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan4
	self recordMatch: #(11 ).
	self step.
	currentCharacter == $' ifTrue: [^ self scan3].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan5
	
	[self step.
	(currentCharacter between: $0 and: $9) or: 
			[(currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]]] 
			whileTrue.
	currentCharacter == $: 
		ifTrue: 
			[self recordMatch: #(14 ).
			self step.
			((currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan5].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan6
	
	[self step.
	(currentCharacter between: $0 and: $9) or: 
			[(currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]]] 
			whileTrue.
	currentCharacter == $: 
		ifTrue: 
			[self recordMatch: #(17 ).
			self step.
			((currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan6].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan7
	self step.
	(currentCharacter isDigit or: [currentCharacter between: $A and: $Z]) 
		ifTrue: 
			[
			[self recordMatch: #(6 9 ).
			self step.
			currentCharacter isDigit or: [currentCharacter between: $A and: $Z]] 
					whileTrue.
			currentCharacter == $. 
				ifTrue: 
					[self step.
					(currentCharacter isDigit or: [currentCharacter between: $A and: $Z]) 
						ifTrue: 
							[
							[self recordMatch: #(6 9 ).
							self step.
							currentCharacter isDigit or: [currentCharacter between: $A and: $Z]] 
									whileTrue.
							currentCharacter == $e ifTrue: [^ self scan8].
							^ self reportLastMatch].
					^ self reportLastMatch].
			currentCharacter == $e ifTrue: [^ self scan8].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan8
	self step.
	currentCharacter isDigit 
		ifTrue: 
			[
			[self recordMatch: #(8 9 ).
			self step.
			currentCharacter isDigit] 
					whileTrue.
			^ self reportLastMatch].
	currentCharacter == $- 
		ifTrue: 
			[self step.
			currentCharacter isDigit 
				ifTrue: 
					[
					[self recordMatch: #(8 9 ).
					self step.
					currentCharacter isDigit] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scan9
	self step.
	currentCharacter isDigit 
		ifTrue: 
			[
			[self recordMatch: #(5 9 ).
			self step.
			currentCharacter isDigit] 
					whileTrue.
			currentCharacter == $e ifTrue: [^ self scan8].
			currentCharacter == $s ifTrue: [^ self scan10].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-scanner' stamp: 'ms 11/19/2006 17:05'!
scanForToken
	self step.
	(currentCharacter <= Character backspace or: 
			[(currentCharacter between: (Character value: 14) and: (Character value: 31)) 
				or: 
					[currentCharacter == $# or: 
							[currentCharacter == $^ 
								or: [currentCharacter == $` or: [currentCharacter >= $]]]]]) 
		ifTrue: [^ self recordAndReportMatch: #(28 )].
	((currentCharacter between: $A and: $Z) 
		or: [currentCharacter between: $a and: $z]) 
			ifTrue: 
				[self recordMatch: #(12 28 ).
				self step.
				((currentCharacter between: $0 and: $9) or: 
						[(currentCharacter between: $A and: $Z) 
							or: [currentCharacter between: $a and: $z]]) 
					ifTrue: 
						[
						[self recordMatch: #(12 ).
						self step.
						(currentCharacter between: $0 and: $9) or: 
								[(currentCharacter between: $A and: $Z) 
									or: [currentCharacter between: $a and: $z]]] 
								whileTrue.
						currentCharacter == $: ifTrue: [^ self scan11].
						^ self reportLastMatch].
				currentCharacter == $: ifTrue: [^ self scan11].
				^ self reportLastMatch].
	(currentCharacter == $!! or: 
			[(currentCharacter between: $% and: $&) or: 
					[(currentCharacter between: $* and: $,) or: 
							[currentCharacter == $/ or: 
									[(currentCharacter between: $< and: $@) 
										or: [currentCharacter == $\ or: [currentCharacter == $~]]]]]]) 
		ifTrue: 
			[self recordMatch: #binarySymbol.
			self step.
			currentCharacter isSpecial 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter isSpecial] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter isDigit 
		ifTrue: 
			[self recordMatch: #(5 9 28 ).
			self step.
			currentCharacter isDigit 
				ifTrue: 
					[
					[self recordMatch: #(5 9 ).
					self step.
					currentCharacter isDigit] 
							whileTrue.
					currentCharacter == $. ifTrue: [^ self scan9].
					currentCharacter == $e ifTrue: [^ self scan8].
					currentCharacter == $r ifTrue: [^ self scan7].
					currentCharacter == $s ifTrue: [^ self scan10].
					^ self reportLastMatch].
			currentCharacter == $. ifTrue: [^ self scan9].
			currentCharacter == $e ifTrue: [^ self scan8].
			currentCharacter == $r ifTrue: [^ self scan7].
			currentCharacter == $s ifTrue: [^ self scan10].
			^ self reportLastMatch].
	(currentCharacter isSeparator 
		or: [currentCharacter == (Character value: 11)]) 
			ifTrue: 
				[self recordMatch: #whitespace.
				self step.
				(currentCharacter isSeparator 
					or: [currentCharacter == (Character value: 11)]) 
						ifTrue: 
							[
							[self recordMatch: #whitespace.
							self step.
							currentCharacter isSeparator 
								or: [currentCharacter == (Character value: 11)]] 
									whileTrue.
							^ self reportLastMatch].
				^ self reportLastMatch].
	currentCharacter == $" 
		ifTrue: 
			[self recordMatch: #(28 ).
			self step.
			currentCharacter ~~ $" 
				ifTrue: 
					[
					[self step.
					currentCharacter ~~ $"] whileTrue.
					^ self recordAndReportMatch: #comment].
			currentCharacter == $" ifTrue: [^ self recordAndReportMatch: #comment].
			^ self reportLastMatch].
	currentCharacter == $$ 
		ifTrue: 
			[self recordMatch: #(28 ).
			self step.
			^ self recordAndReportMatch: #(20 )].
	currentCharacter == $' 
		ifTrue: 
			[self recordMatch: #(28 ).
			self step.
			currentCharacter ~~ $' ifTrue: [^ self scan3].
			currentCharacter == $' ifTrue: [^ self scan4].
			^ self reportLastMatch].
	currentCharacter == $( ifTrue: [^ self recordAndReportMatch: #(4 28 )].
	currentCharacter == $) ifTrue: [^ self recordAndReportMatch: #(25 28 )].
	currentCharacter == $- 
		ifTrue: 
			[self recordMatch: #binarySymbol.
			self step.
			currentCharacter isSpecial 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter isSpecial] 
							whileTrue.
					^ self reportLastMatch].
			currentCharacter isDigit 
				ifTrue: 
					[
					[self recordMatch: #(10 ).
					self step.
					currentCharacter isDigit] 
							whileTrue.
					currentCharacter == $. 
						ifTrue: 
							[self step.
							currentCharacter isDigit 
								ifTrue: 
									[
									[self recordMatch: #(10 ).
									self step.
									currentCharacter isDigit] 
											whileTrue.
									currentCharacter == $e ifTrue: [^ self scan1].
									currentCharacter == $s ifTrue: [^ self scan2].
									^ self reportLastMatch].
							^ self reportLastMatch].
					currentCharacter == $e ifTrue: [^ self scan1].
					currentCharacter == $r 
						ifTrue: 
							[self step.
							(currentCharacter isDigit or: [currentCharacter between: $A and: $Z]) 
								ifTrue: 
									[
									[self recordMatch: #(10 ).
									self step.
									currentCharacter isDigit or: [currentCharacter between: $A and: $Z]] 
											whileTrue.
									currentCharacter == $. 
										ifTrue: 
											[self step.
											(currentCharacter isDigit or: [currentCharacter between: $A and: $Z]) 
												ifTrue: 
													[
													[self recordMatch: #(10 ).
													self step.
													currentCharacter isDigit or: [currentCharacter between: $A and: $Z]] 
															whileTrue.
													currentCharacter == $e ifTrue: [^ self scan1].
													^ self reportLastMatch].
											^ self reportLastMatch].
									currentCharacter == $e ifTrue: [^ self scan1].
									^ self reportLastMatch].
							^ self reportLastMatch].
					currentCharacter == $s ifTrue: [^ self scan2].
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter == $. ifTrue: [^ self recordAndReportMatch: #(21 28 )].
	currentCharacter == $: 
		ifTrue: 
			[self recordMatch: #(26 28 ).
			self step.
			((currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan6].
			currentCharacter == $= ifTrue: [^ self recordAndReportMatch: #(16 )].
			^ self reportLastMatch].
	currentCharacter == $; ifTrue: [^ self recordAndReportMatch: #(27 28 )].
	currentCharacter == $[ ifTrue: [^ self recordAndReportMatch: #(1 28 )].
	currentCharacter == $] ifTrue: [^ self recordAndReportMatch: #(23 28 )].
	currentCharacter == $_ ifTrue: [^ self recordAndReportMatch: #(16 28 )].
	currentCharacter == ${ ifTrue: [^ self recordAndReportMatch: #(2 28 )].
	currentCharacter == $| 
		ifTrue: 
			[self recordMatch: #(3 15 28 ).
			self step.
			currentCharacter isSpecial 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter isSpecial] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter == $} ifTrue: [^ self recordAndReportMatch: #(24 28 )].
	^ self reportLastMatch! !

!SqueakMethodPatternScanner methodsFor: 'generated-tokens' stamp: 'ms 11/19/2006 17:05'!
stringId
	^11! !

!SqueakScanner class methodsFor: 'generated-initialization' stamp: 'ms 4/7/2007 03:32'!
initializeKeywordMap
	keywordMap := Dictionary new.
	#(
		#(#binarySymbol '||' 8 )
		#(22 'false' 15 )
		#(22 'nil' 16 )
		#(22 'true' 10 )
		#(23 'apicall:' 14 )
		#(23 'cdecl:' 11 )
		#(23 'module:' 13 )
		#(23 'primitive:' 3 )
	) do: 
				[:each | 
				(keywordMap at: each first ifAbsentPut: [Dictionary new]) at: (each at: 2)
					put: each last].
	^ keywordMap! !

!SqueakScanner class methodsFor: 'generated-comments' stamp: 'ms 4/7/2007 03:32'!
scannerDefinitionComment

	"<decimalNumber>:	[0-9]+ (\. [0-9]+)? ;
<radixNumber>:		[0-9]+ r [0-9A-Z]+ (\. [0-9A-Z]+)? ;
<scaledNumber>:		<decimalNumber> s [0-9]+ ;
<exponentNumber>:	(<decimalNumber> | <radixNumber>) e \-? [0-9]+ ;
<number>:			<decimalNumber> | <radixNumber> | <exponentNumber> | <scaledNumber> ;
<negativeNumber>:	\- <number> ;
<string>:				\'  [^\']* \' (\' [^\']* \')* ;
<name>:				[a-zA-Z] [a-zA-Z0-9]* ;
<keyword>:			<name> \: ;
<multikeyword>:		<name> \: (<name> \: )+ ;
<binarySymbol>:		[\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,] [\~\!!\@\%\&\*\-\+\=\\\|\?\/\>\<\,]* ;
<assignment>:		\: \= | \_ ;
<alternateKeyword>:	\: <name> \: (<name> \:)* ;
<whitespace>:		\s+ ;
<comment>:			\"" [^\""]* \"" ;
<character>:			\$ . ;
<period>:				\. ;
<variableAssignment>:	<name> \: \= ;
<rightBoxBrackets>:	];
<rightCurlyBrackets>:	};
<rightParentheses>:	\);
<colon>:				\:;
<semicolon>:			\;;
<anyChar>:			. ; # For VW literal arrays that handle #(;) -> #(#';');"! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
assignmentId
	^26! !

!SqueakScanner methodsFor: 'token handling' stamp: 'ms 3/31/2007 21:31'!
binarySymbol
	"Negative number takes precedence over binary symbol, so for example, '0@-1' means '0 @ -1', rather than '0 @- 1', which is how the scanner reads it. If the symbol is just $- and the next char is a digit, then the negative number token takes precedence and SqueakParser>>actionForCurrentToken converts it to a binary symbol. If there is space between $- and the digit, then it reaches here and we convert it to a negativeNumber token (and let SqueakParser>>actionForCurrentToken deal with it)."

	| string negPos prevReturnMatchBlock |
	string _ outputStream contents.
	string last = $- ifFalse: [
		matchActions _ {self binarySymbolId}.
		^ self createTokenFor: outputStream contents].

	stream peek ifNil: [
		matchActions _ {self binarySymbolId}.
		^ self createTokenFor: outputStream contents].

	stream peek isDigit ifTrue: [
		"Back up one and let scanner find negativeNumber token"
		outputStream skip: -1.
		stream skip: -1.
		matchActions _ {self binarySymbolId}.
		^ self createTokenFor: outputStream contents].

	(stream peek = $  and: [string size = 1]) ifFalse: [
		matchActions _ {self binarySymbolId}.
		^ self createTokenFor: outputStream contents].

	"Allow space between negative sign and number (wierd, but allowed in Smalltalk ANSI standard)"
	negPos _ stream position.
	[stream peek = $ ] whileTrue: [stream next].

	stream peek isDigit ifFalse: [
		stream position: negPos.
		matchActions _ {self binarySymbolId}.
		^ self createTokenFor: outputStream contents].

	"scan number but catch return and convert it to a negative number"
	prevReturnMatchBlock _ returnMatchBlock.
	returnMatchBlock _ [:token | 
		returnMatchBlock _ prevReturnMatchBlock.
		token id first = self numberId ifFalse: [self error: 'unexpected token'].
		token value: '-', token value
			start: token start - 1
			id: {self negativeNumberId}.
		returnMatchBlock value: token].
	self whitespace.  "eats whitespace and scans next token"! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
binarySymbolId
	^25! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
characterId
	^30! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
colonId
	^36! !

!SqueakScanner methodsFor: 'token handling' stamp: 'ms 9/16/2006 18:15'!
comment
	| value |
	value := outputStream contents.
	comments add: {value. start}.
	previousToken :=  SqueakCommentToken 
		value: value 
		start: start 
		id: #comment 
		prevToken: previousToken.
	self resetScanner.
	self scanForToken
! !

!SqueakScanner methodsFor: 'private' stamp: 'ajh 3/6/2003 00:16'!
comments

	^ comments! !

!SqueakScanner methodsFor: 'private' stamp: 'ms 4/7/2007 03:31'!
createTokenFor: string
	
	| token |
	token := SqueakToken 
				value: string
				start: start + 1
				id: matchActions
				prevToken: previousToken.
	previousToken := token.
	outputStream reset.
	matchActions := nil.
	returnMatchBlock value: token! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
emptySymbolTokenId
	^80! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
errorTokenId
	^81! !

!SqueakScanner methodsFor: 'private' stamp: 'ajh 3/6/2003 00:13'!
initialize

	super initialize.
	comments _ OrderedCollection new.
! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
keywordId
	^23! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
multikeywordId
	^24! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
nameId
	^22! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
negativeNumberId
	^20! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
numberId
	^19! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
periodId
	^31! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
rightBoxBracketsId
	^33! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
rightCurlyBracketsId
	^34! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
rightParenthesesId
	^35! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan1
	
	[self step.
	currentCharacter ~= $'] whileTrue.
	currentCharacter = $' ifTrue: [^ self scan2].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan10
	self step.
	(currentCharacter between: $0 and: $9) 
		ifTrue: 
			[
			[self recordMatch: #(20 ).
			self step.
			currentCharacter between: $0 and: $9] 
					whileTrue.
			^ self reportLastMatch].
	currentCharacter = $- ifTrue: [^ self scan11].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan11
	self step.
	(currentCharacter between: $0 and: $9) 
		ifTrue: 
			[
			[self recordMatch: #(20 ).
			self step.
			currentCharacter between: $0 and: $9] 
					whileTrue.
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan2
	self recordMatch: #(21 ).
	self step.
	currentCharacter = $' ifTrue: [^ self scan1].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan3
	self step.
	(currentCharacter between: $0 and: $9) 
		ifTrue: 
			[
			[self recordMatch: #(19 ).
			self step.
			currentCharacter between: $0 and: $9] 
					whileTrue.
			currentCharacter = $e ifTrue: [^ self scan4].
			currentCharacter = $s ifTrue: [^ self scan5].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan4
	self step.
	(currentCharacter between: $0 and: $9) 
		ifTrue: 
			[
			[self recordMatch: #(19 ).
			self step.
			currentCharacter between: $0 and: $9] 
					whileTrue.
			^ self reportLastMatch].
	currentCharacter = $- ifTrue: [^ self scan5].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan5
	self step.
	(currentCharacter between: $0 and: $9) 
		ifTrue: 
			[
			[self recordMatch: #(19 ).
			self step.
			currentCharacter between: $0 and: $9] 
					whileTrue.
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan6
	self step.
	((currentCharacter between: $0 and: $9) 
		or: [currentCharacter between: $A and: $Z]) 
			ifTrue: 
				[
				[self recordMatch: #(19 ).
				self step.
				(currentCharacter between: $0 and: $9) 
					or: [currentCharacter between: $A and: $Z]] 
						whileTrue.
				currentCharacter = $. 
					ifTrue: 
						[self step.
						((currentCharacter between: $0 and: $9) 
							or: [currentCharacter between: $A and: $Z]) 
								ifTrue: 
									[
									[self recordMatch: #(19 ).
									self step.
									(currentCharacter between: $0 and: $9) 
										or: [currentCharacter between: $A and: $Z]] 
											whileTrue.
									currentCharacter = $e ifTrue: [^ self scan4].
									^ self reportLastMatch].
						^ self reportLastMatch].
				currentCharacter = $e ifTrue: [^ self scan4].
				^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan7
	
	[self step.
	(currentCharacter between: $0 and: $9) or: 
			[(currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]]] 
			whileTrue.
	currentCharacter = $: 
		ifTrue: 
			[self recordMatch: #(27 ).
			self step.
			((currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan7].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan8
	self recordMatch: #(23 ).
	self step.
	((currentCharacter between: $A and: $Z) 
		or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan9].
	currentCharacter = $= 
		ifTrue: [^ self recordAndReportMatch: #variableAssignment].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scan9
	
	[self step.
	(currentCharacter between: $0 and: $9) or: 
			[(currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]]] 
			whileTrue.
	currentCharacter = $: 
		ifTrue: 
			[self recordMatch: #(24 ).
			self step.
			((currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan9].
			^ self reportLastMatch].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-scanner' stamp: 'ms 4/7/2007 03:32'!
scanForToken
	self step.
	(currentCharacter <= Character backspace or: 
			[(currentCharacter between: (Character value: 14) and: (Character value: 31)) 
				or: [currentCharacter = $` or: [currentCharacter >= $]]]) 
		ifTrue: [^ self recordAndReportMatch: #(38 )].
	((currentCharacter between: $A and: $Z) 
		or: [currentCharacter between: $a and: $z]) 
			ifTrue: 
				[self recordMatch: #(22 38 ).
				self step.
				((currentCharacter between: $0 and: $9) or: 
						[(currentCharacter between: $A and: $Z) 
							or: [currentCharacter between: $a and: $z]]) 
					ifTrue: 
						[
						[self recordMatch: #(22 ).
						self step.
						(currentCharacter between: $0 and: $9) or: 
								[(currentCharacter between: $A and: $Z) 
									or: [currentCharacter between: $a and: $z]]] 
								whileTrue.
						currentCharacter = $: ifTrue: [^ self scan8].
						^ self reportLastMatch].
				currentCharacter = $: ifTrue: [^ self scan8].
				^ self reportLastMatch].
	(currentCharacter = $!! or: 
			[(currentCharacter between: $% and: $&) or: 
					[(currentCharacter between: $+ and: $,) or: 
							[currentCharacter = $/ or: 
									[currentCharacter = $= or: 
											[(currentCharacter between: $? and: $@) 
												or: [currentCharacter = $\ or: [currentCharacter = $~]]]]]]]) 
		ifTrue: 
			[self recordMatch: #binarySymbol.
			self step.
			(currentCharacter = $!! or: 
					[(currentCharacter between: $% and: $&) or: 
							[(currentCharacter between: $* and: $-) or: 
									[currentCharacter = $/ or: 
											[(currentCharacter between: $< and: $@) or: 
													[currentCharacter = $\ 
														or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter = $!! or: 
							[(currentCharacter between: $% and: $&) or: 
									[(currentCharacter between: $* and: $-) or: 
											[currentCharacter = $/ or: 
													[(currentCharacter between: $< and: $@) or: 
															[currentCharacter = $\ 
																or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	(currentCharacter between: $0 and: $9) 
		ifTrue: 
			[self recordMatch: #(19 38 ).
			self step.
			(currentCharacter between: $0 and: $9) 
				ifTrue: 
					[
					[self recordMatch: #(19 ).
					self step.
					currentCharacter between: $0 and: $9] 
							whileTrue.
					currentCharacter = $. ifTrue: [^ self scan3].
					currentCharacter = $e ifTrue: [^ self scan4].
					currentCharacter = $r ifTrue: [^ self scan6].
					currentCharacter = $s ifTrue: [^ self scan5].
					^ self reportLastMatch].
			currentCharacter = $. ifTrue: [^ self scan3].
			currentCharacter = $e ifTrue: [^ self scan4].
			currentCharacter = $r ifTrue: [^ self scan6].
			currentCharacter = $s ifTrue: [^ self scan5].
			^ self reportLastMatch].
	((currentCharacter between: Character tab and: Character cr) 
		or: [currentCharacter = Character space]) 
			ifTrue: 
				[self recordMatch: #whitespace.
				self step.
				((currentCharacter between: Character tab and: Character cr) 
					or: [currentCharacter = Character space]) 
						ifTrue: 
							[
							[self recordMatch: #whitespace.
							self step.
							(currentCharacter between: Character tab and: Character cr) 
								or: [currentCharacter = Character space]] 
									whileTrue.
							^ self reportLastMatch].
				^ self reportLastMatch].
	currentCharacter = $" 
		ifTrue: 
			[self recordMatch: #(38 ).
			self step.
			currentCharacter ~= $" 
				ifTrue: 
					[
					[self step.
					currentCharacter ~= $"] whileTrue.
					currentCharacter = $" ifTrue: [^ self recordAndReportMatch: #comment].
					^ self reportLastMatch].
			currentCharacter = $" ifTrue: [^ self recordAndReportMatch: #comment].
			^ self reportLastMatch].
	currentCharacter = $# 
		ifTrue: 
			[self recordMatch: #(17 38 ).
			self step.
			currentCharacter = $: ifTrue: [^ self recordAndReportMatch: #(18 )].
			^ self reportLastMatch].
	currentCharacter = $$ 
		ifTrue: 
			[self recordMatch: #(38 ).
			self step.
			currentCharacter <= $ÿ ifTrue: [^ self recordAndReportMatch: #(30 )].
			^ self reportLastMatch].
	currentCharacter = $' 
		ifTrue: 
			[self recordMatch: #(38 ).
			self step.
			currentCharacter ~= $' ifTrue: [^ self scan1].
			currentCharacter = $' ifTrue: [^ self scan2].
			^ self reportLastMatch].
	currentCharacter = $( ifTrue: [^ self recordAndReportMatch: #(2 38 )].
	currentCharacter = $) ifTrue: [^ self recordAndReportMatch: #(35 38 )].
	currentCharacter = $* 
		ifTrue: 
			[self recordMatch: #(12 25 38 ).
			self step.
			(currentCharacter = $!! or: 
					[(currentCharacter between: $% and: $&) or: 
							[(currentCharacter between: $* and: $-) or: 
									[currentCharacter = $/ or: 
											[(currentCharacter between: $< and: $@) or: 
													[currentCharacter = $\ 
														or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter = $!! or: 
							[(currentCharacter between: $% and: $&) or: 
									[(currentCharacter between: $* and: $-) or: 
											[currentCharacter = $/ or: 
													[(currentCharacter between: $< and: $@) or: 
															[currentCharacter = $\ 
																or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter = $- 
		ifTrue: 
			[self recordMatch: #binarySymbol.
			self step.
			(currentCharacter = $!! or: 
					[(currentCharacter between: $% and: $&) or: 
							[(currentCharacter between: $* and: $-) or: 
									[currentCharacter = $/ or: 
											[(currentCharacter between: $< and: $@) or: 
													[currentCharacter = $\ 
														or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter = $!! or: 
							[(currentCharacter between: $% and: $&) or: 
									[(currentCharacter between: $* and: $-) or: 
											[currentCharacter = $/ or: 
													[(currentCharacter between: $< and: $@) or: 
															[currentCharacter = $\ 
																or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] 
							whileTrue.
					^ self reportLastMatch].
			(currentCharacter between: $0 and: $9) 
				ifTrue: 
					[
					[self recordMatch: #(20 ).
					self step.
					currentCharacter between: $0 and: $9] 
							whileTrue.
					currentCharacter = $. 
						ifTrue: 
							[self step.
							(currentCharacter between: $0 and: $9) 
								ifTrue: 
									[
									[self recordMatch: #(20 ).
									self step.
									currentCharacter between: $0 and: $9] 
											whileTrue.
									currentCharacter = $e ifTrue: [^ self scan10].
									currentCharacter = $s ifTrue: [^ self scan11].
									^ self reportLastMatch].
							^ self reportLastMatch].
					currentCharacter = $e ifTrue: [^ self scan10].
					currentCharacter = $r 
						ifTrue: 
							[self step.
							((currentCharacter between: $0 and: $9) 
								or: [currentCharacter between: $A and: $Z]) 
									ifTrue: 
										[
										[self recordMatch: #(20 ).
										self step.
										(currentCharacter between: $0 and: $9) 
											or: [currentCharacter between: $A and: $Z]] 
												whileTrue.
										currentCharacter = $. 
											ifTrue: 
												[self step.
												((currentCharacter between: $0 and: $9) 
													or: [currentCharacter between: $A and: $Z]) 
														ifTrue: 
															[
															[self recordMatch: #(20 ).
															self step.
															(currentCharacter between: $0 and: $9) 
																or: [currentCharacter between: $A and: $Z]] 
																	whileTrue.
															currentCharacter = $e ifTrue: [^ self scan10].
															^ self reportLastMatch].
												^ self reportLastMatch].
										currentCharacter = $e ifTrue: [^ self scan10].
										^ self reportLastMatch].
							^ self reportLastMatch].
					currentCharacter = $s ifTrue: [^ self scan11].
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter = $. ifTrue: [^ self recordAndReportMatch: #(31 38 )].
	currentCharacter = $: 
		ifTrue: 
			[self recordMatch: #(36 38 ).
			self step.
			((currentCharacter between: $A and: $Z) 
				or: [currentCharacter between: $a and: $z]) ifTrue: [^ self scan7].
			currentCharacter = $= ifTrue: [^ self recordAndReportMatch: #(26 )].
			^ self reportLastMatch].
	currentCharacter = $; ifTrue: [^ self recordAndReportMatch: #(37 38 )].
	currentCharacter = $< 
		ifTrue: 
			[self recordMatch: #(6 25 38 ).
			self step.
			(currentCharacter = $!! or: 
					[(currentCharacter between: $% and: $&) or: 
							[(currentCharacter between: $* and: $-) or: 
									[currentCharacter = $/ or: 
											[(currentCharacter between: $< and: $@) or: 
													[currentCharacter = $\ 
														or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter = $!! or: 
							[(currentCharacter between: $% and: $&) or: 
									[(currentCharacter between: $* and: $-) or: 
											[currentCharacter = $/ or: 
													[(currentCharacter between: $< and: $@) or: 
															[currentCharacter = $\ 
																or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter = $> 
		ifTrue: 
			[self recordMatch: #(7 25 38 ).
			self step.
			(currentCharacter = $!! or: 
					[(currentCharacter between: $% and: $&) or: 
							[(currentCharacter between: $* and: $-) or: 
									[currentCharacter = $/ or: 
											[(currentCharacter between: $< and: $@) or: 
													[currentCharacter = $\ 
														or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter = $!! or: 
							[(currentCharacter between: $% and: $&) or: 
									[(currentCharacter between: $* and: $-) or: 
											[currentCharacter = $/ or: 
													[(currentCharacter between: $< and: $@) or: 
															[currentCharacter = $\ 
																or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter = $[ ifTrue: [^ self recordAndReportMatch: #(1 38 )].
	currentCharacter = $] ifTrue: [^ self recordAndReportMatch: #(33 38 )].
	currentCharacter = $^ ifTrue: [^ self recordAndReportMatch: #(4 38 )].
	currentCharacter = $_ ifTrue: [^ self recordAndReportMatch: #(26 38 )].
	currentCharacter = ${ ifTrue: [^ self recordAndReportMatch: #(5 38 )].
	currentCharacter = $| 
		ifTrue: 
			[self recordMatch: #(9 25 38 ).
			self step.
			(currentCharacter = $!! or: 
					[(currentCharacter between: $% and: $&) or: 
							[(currentCharacter between: $* and: $-) or: 
									[currentCharacter = $/ or: 
											[(currentCharacter between: $< and: $@) or: 
													[currentCharacter = $\ 
														or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]) 
				ifTrue: 
					[
					[self recordMatch: #binarySymbol.
					self step.
					currentCharacter = $!! or: 
							[(currentCharacter between: $% and: $&) or: 
									[(currentCharacter between: $* and: $-) or: 
											[currentCharacter = $/ or: 
													[(currentCharacter between: $< and: $@) or: 
															[currentCharacter = $\ 
																or: [currentCharacter = $| or: [currentCharacter = $~]]]]]]]] 
							whileTrue.
					^ self reportLastMatch].
			^ self reportLastMatch].
	currentCharacter = $} ifTrue: [^ self recordAndReportMatch: #(34 38 )].
	^ self reportLastMatch! !

!SqueakScanner methodsFor: 'generated-tokens' stamp: 'ms 4/7/2007 03:32'!
stringId
	^21! !

!SqueakScanner methodsFor: 'token handling' stamp: 'ajh 7/16/2004 10:57'!
variableAssignment

	outputStream skip: -2.
	stream skip: -2.
	matchActions _ {self nameId}.
	self createTokenFor: outputStream contents.
! !

!SqueakScanner methodsFor: 'token handling' stamp: 'ms 9/16/2006 18:18'!
whitespace
	| value  |
	value := outputStream contents.
	previousToken := (SqueakWhitespaceToken 
		value: value 
		start: start 
		id: #whitespace 
		prevToken: previousToken).
	super whitespace. "eats the whitespace"
! !

!SequenceableCollection methodsFor: '*newcompiler' stamp: 'kwl 6/25/2006 19:07'!
literalIndexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of anElement within the receiver. If the receiver does 
	not contain anElement, answer the result of evaluating the argument, 
	exceptionBlock."
	1 to: self size do:
		[:i | ((self at: i) literalEqual: anElement) ifTrue: [^ i]].
	^ exceptionBlock value! !

RBProgramNodeVisitor subclass: #ASTChecker
	instanceVariableNames: 'scope'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ASTChecker commentStamp: 'ajh 6/23/2004 19:43' prior: 0!
I visit each node in the abstract syntax tree while growing and shrinking a SemScope chain. Each method and block node is linked with its corresponding scope object, and each variable def and ref is linked with its corresponding ScopeVar. Exceptions are raised for undefined variable references and so on (see subclasses of SemanticWarning).
!

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'ajh 2/25/2003 19:43'!
acceptArrayNode: anArrayNode 
	anArrayNode statements do: [:each | self visitNode: each]! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/11/2003 18:21'!
acceptAssignmentNode: anAssignmentNode

	| var |
	self visitNode: anAssignmentNode value.
	var _ (scope lookupVar: anAssignmentNode variable name)
		ifNil: [self undeclaredVariable: anAssignmentNode variable].
	var markWrite.
	anAssignmentNode variable binding: var.
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'ajh 6/25/2004 17:28'!
acceptBlockNode: aBlockNode

	aBlockNode isInlined ifTrue: [^ self acceptInlinedBlockNode: aBlockNode].

	scope _ scope newFunctionScope.
	aBlockNode scope: scope.
	(scope addTemp: 'parent env') markArg. "first temp is receiver"
	aBlockNode arguments do: [:node | (self declareVariableNode: node) markArg].
	self visitNode: aBlockNode body.
	scope _ scope popScope.
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'md 6/29/2005 12:20'!
acceptDoItNode: aDoItNode

	| doItReceiverName |
	doItReceiverName := scope isInstanceScope
		ifTrue: ['self']
		ifFalse: [(scope rawVar: 'theContext')
			ifNil: ['theContext']
			ifNotNil: ['the context']].

	scope := scope newMethodScope.
	"hack for Bytesurgeon: inlined code is a doit, yet we want access to self "
	aDoItNode byteSurgeon ifTrue: [(scope addTemp: 'self')].
	aDoItNode scope: scope.

	(scope addTemp: doItReceiverName) markArg. "first temp is receiver"
	self visitNode: aDoItNode body.
	scope := scope popScope.
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'md 11/11/2004 16:05'!
acceptInlinedBlockNode: aBlockNode
	
	aBlockNode arguments do: [:node | (self declareVariableNode: node) markWrite "given"].
	self visitNode: aBlockNode body.
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'md 4/14/2007 00:36'!
acceptMessageNode: aMessageNode

	(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
		ifTrue: [self visitNode: aMessageNode receiver].
	aMessageNode arguments do: [:each | self visitNode: each].
	"aMessageNode binding:"
		((scope lookupSelector: aMessageNode selector asString)
			ifNil: [self undeclaredSelector: aMessageNode])! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'ms 3/31/2007 18:38'!
acceptMethodNode: aMethodNode

	scope := scope newMethodScope.
	aMethodNode scope: scope.
	(scope addTemp: 'self') markArg.  "first temp is receiver"
	aMethodNode arguments do: [:node | (self declareVariableNode: node) markArg].
	
	aMethodNode pragmas do: [:each | self visitNode: each].
	self visitNode: aMethodNode body.
	scope _ scope outerScope.
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'ms 11/11/2006 17:43'!
acceptPragmaNode: aPragmaNode
	
	aPragmaNode method addPragma: aPragmaNode pragma.
	aPragmaNode isPrimitive ifTrue: [
		aPragmaNode method primitiveNode: aPragmaNode primitive ]
	! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'ajh 6/26/2004 18:22'!
acceptReturnNode: aReturnNode

	| var |
	self visitNode: aReturnNode value.
	var _ scope lookupVar: 'top env'.  "nil var means local return"
	var ifNotNil: [var markRead].
	aReturnNode homeBinding: var.
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'ms 7/22/2006 19:11'!
acceptSequenceNode: aSequenceNode

	aSequenceNode temporaries do: [:node | self declareVariableNode: node].
	aSequenceNode statements do: [:each | self visitNode: each].
	aSequenceNode temporaries do: [:node |
		node binding isUnused ifTrue: [self unusedVariable: node]].
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'md 11/16/2004 14:33'!
acceptVariableNode: aVariableNode

	| var name |
	name := aVariableNode name.
	name = 'super' ifTrue: [name := 'self'].
	var := (scope lookupVar: name)
		ifNil: [self undeclaredVariable: aVariableNode].
	var isUndefined
		ifTrue: [self uninitializedVariable: aVariableNode].
	var markRead.
	aVariableNode binding: var.
! !

!ASTChecker methodsFor: 'visitor-double dispatching' stamp: 'md 11/11/2004 16:22'!
declareVariableNode: aVariableNode

	| name var |
	name := aVariableNode name.
	var := scope rawVar: name.
	var ifNotNil: [
		var scope = scope ifTrue: [
			"Reuse same var"
			var := scope lookupVar: name.
		] ifFalse: [
			"Create new var that shadows outer one"
			self variable: aVariableNode shadows: var.
			var := scope addTemp: name.
		]
	] ifNil: [
		"new var"
		var := scope addTemp: name.
	].
	aVariableNode binding: var.
	^ var! !

!ASTChecker methodsFor: 'initialize-release' stamp: 'ajh 6/23/2004 20:40'!
initialize

	scope _ GlobalScope new.  "in case never initialized"! !

!ASTChecker methodsFor: 'initialize-release' stamp: 'ajh 2/26/2003 19:58'!
scope: aSemScope

	scope _ aSemScope! !

!ASTChecker methodsFor: 'error handling' stamp: 'ajh 3/11/2003 22:46'!
undeclaredSelector: messageNode

	^ UndeclaredSelectorWarning new
		messageNode: messageNode;
		signal! !

!ASTChecker methodsFor: 'error handling' stamp: 'ajh 3/11/2003 12:06'!
undeclaredVariable: variableNode

	^ UndeclaredVariableWarning new
		variableNode: variableNode;
		signal! !

!ASTChecker methodsFor: 'error handling' stamp: 'ajh 3/12/2003 13:35'!
uninitializedVariable: variableNode

	^ UninitializedVariableWarning new
		variableNode: variableNode;
		signal! !

!ASTChecker methodsFor: 'error handling' stamp: 'ajh 3/12/2003 14:10'!
unusedVariable: variableNode

	^ UnusedVariableWarning new
		variableNode: variableNode;
		signal! !

!ASTChecker methodsFor: 'error handling' stamp: 'ajh 3/19/2003 13:33'!
variable: variableNode shadows: semVar

	^ ShadowVariableWarning new
		variableNode: variableNode;
		shadowedVar: semVar;
		signal! !

RBProgramNodeVisitor subclass: #ASTCommenter
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptArrayNode: anArrayNode 
	anArrayNode peekAfterComment.
	anArrayNode peekBeforeComment.
	super acceptArrayNode: anArrayNode.
	anArrayNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptAssignmentNode: anAssignmentNode 
	anAssignmentNode peekAfterComment.
	anAssignmentNode peekBeforeComment.
	super acceptAssignmentNode: anAssignmentNode.
	anAssignmentNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptBlockNode: aBlockNode 
	aBlockNode peekAfterComment.
	aBlockNode peekBeforeComment.
	super acceptBlockNode: aBlockNode.
	aBlockNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptCascadeNode: aCascadeNode 
	aCascadeNode peekAfterComment.
	aCascadeNode peekBeforeComment.
	aCascadeNode messages 
		do: [:each | each arguments do: [:eachArg | self visitNode: eachArg]].
	aCascadeNode messages first isBlock 
		ifTrue: [self visitNode: aCascadeNode messages first body].
	aCascadeNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptLiteralNode: aLiteralNode 
	aLiteralNode peekAfterComment.
	aLiteralNode peekBeforeComment.
	aLiteralNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 10/14/2006 15:41'!
acceptMessageNode: aMessageNode 
	aMessageNode peekAfterComment.
	aMessageNode peekBeforeComment.
	aMessageNode arguments do: [:each | self visitNode: each].
	(aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) 
		ifTrue: [self visitNode: aMessageNode receiver].
	aMessageNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 10/14/2006 15:33'!
acceptMethodNode: aMethodNode 

	aMethodNode peekAfterComment.
	super acceptMethodNode: aMethodNode.
	aMethodNode peekInsideComment.
	aMethodNode peekBeforeComment
	! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptPragmaNode: aPragmaNode 
	aPragmaNode peekAfterComment.
	aPragmaNode peekBeforeComment.
	aPragmaNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptReturnNode: aReturnNode 
	aReturnNode peekAfterComment.
	aReturnNode peekBeforeComment.
	super acceptReturnNode: aReturnNode.
	aReturnNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptSequenceNode: aSequenceNode 
	aSequenceNode peekAfterComment.
	aSequenceNode temporaries ifNotEmpty: [aSequenceNode peekBeforeComment].
	super acceptSequenceNode: aSequenceNode.
	aSequenceNode temporaries ifEmpty: [aSequenceNode peekBeforeComment].
	aSequenceNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 20:19'!
acceptVariableNode: aVariableNode 
	aVariableNode peekAfterComment.
	aVariableNode peekBeforeComment.
	aVariableNode peekInsideComment! !

!ASTCommenter methodsFor: 'visitor-double dispatching' stamp: 'ms 9/20/2006 00:14'!
visitMethodArguments: aNodeCollection

	aNodeCollection reverse do: [:each | self visitNode: each]! !

RBProgramNodeVisitor subclass: #ASTTranslator
	instanceVariableNames: 'methodBuilder effectTranslator valueTranslator'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ASTTranslator commentStamp: 'ajh 3/24/2003 22:19' prior: 0!
I visit an abstract syntax tree and generate IR (intermediate representation) instructions for each node by sending the appropriate message to my methodBuilder (an IRBuilder).  I hold onto my two subclasses one for generating instructions for value, the other for generating instructions for effect.!

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ms 10/30/2006 18:17'!
acceptArrayNode: anArrayNode 

	| elementNodes |
	elementNodes := anArrayNode children.
	elementNodes size <= 4 ifTrue: [
		"Short form: Array braceWith: a with: b ..."
		methodBuilder pushLiteralVariable: Array binding.
		elementNodes do: [:node | valueTranslator visitNode: node].
		methodBuilder send: (#(braceWithNone braceWith: braceWith:with: braceWith:with:with: braceWith:with:with:with:) at: elementNodes size + 1).
	] ifFalse: [
		"Long form: (Array braceStream: N) nextPut: a; nextPut: b; ...; braceArray"
		methodBuilder pushLiteralVariable: Array binding.
		methodBuilder pushLiteral: elementNodes size.
		methodBuilder send: #braceStream:.
		elementNodes do: [:node |
			methodBuilder pushDup.
			valueTranslator visitNode: node.
			methodBuilder send: #nextPut:.
			methodBuilder popTop.
		].
		methodBuilder send: #braceArray.
	].
! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ms 10/30/2006 18:44'!
acceptAssignmentNode: anAssignmentNode 

	valueTranslator visitNode: anAssignmentNode value.
	anAssignmentNode variable binding emitStore: methodBuilder from: anAssignmentNode owningScope.
! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ajh 2/25/2003 00:51'!
acceptBlockNode: aBlockNode 
! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/10/2003 14:53'!
acceptCascadeNode: aCascadeNode 

	valueTranslator visitNode: aCascadeNode receiver.
	aCascadeNode messages allButLastDo: [:node |
		methodBuilder pushDup.
		effectTranslator visitNode: node.
	].
	valueTranslator visitNode: aCascadeNode messages last.
! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ajh 6/26/2004 13:48'!
acceptDoItNode: aDoItNode 

	methodBuilder numRargs: 1.
	methodBuilder addTemps: aDoItNode scope tempVars.
	aDoItNode scope emitPrologue: methodBuilder.
	valueTranslator visitNode: aDoItNode body.
	aDoItNode body lastIsReturn ifFalse: [
		methodBuilder returnTop].
! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ajh 2/25/2003 13:23'!
acceptMessageNode: aMessageNode 

	aMessageNode isInlineIf ifTrue: [^ self emitIfNode: aMessageNode].
	aMessageNode isInlineIfNil ifTrue: [^ self emitIfNilNode: aMessageNode].
	aMessageNode isInlineAndOr ifTrue: [^ self emitAndOrNode: aMessageNode].
	aMessageNode isInlineWhile ifTrue: [^ self emitWhileNode: aMessageNode].
	aMessageNode isInlineToDo ifTrue: [^ self emitToDoNode: aMessageNode].
	aMessageNode isInlineCase ifTrue: [^ self emitCaseNode: aMessageNode].
	^ self emitMessageNode: aMessageNode! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ms 7/13/2006 17:33'!
acceptMethodNode: aMethodNode 

	methodBuilder properties: aMethodNode properties.
	methodBuilder numRargs: aMethodNode arguments size + 1.
	methodBuilder primitiveNode: aMethodNode primitiveNode.
	methodBuilder addTemps: aMethodNode scope tempVars.
	aMethodNode scope emitPrologue: methodBuilder.
	effectTranslator visitNode: aMethodNode body.
	aMethodNode body lastIsReturn ifFalse: [
		methodBuilder pushReceiver; returnTop].! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ajh 7/8/2004 19:01'!
acceptReturnNode: aReturnNode

	valueTranslator visitNode: aReturnNode value.
	aReturnNode homeBinding ifNil: [
		methodBuilder returnTop.
	] ifNotNil: [
		aReturnNode homeBinding emitValue: methodBuilder from: aReturnNode owningScope.
		methodBuilder remoteReturn.
	].
! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'md 3/17/2006 14:17'!
acceptSequenceNode: aSequenceNode 

	aSequenceNode statements allButLastDo: [:n | effectTranslator visitNode: n].
	aSequenceNode statements notEmpty ifTrue: [self visitNode: aSequenceNode statements last].
! !

!ASTTranslator methodsFor: 'inline messages' stamp: 'ms 10/31/2006 11:39'!
emitAndOrNode: aMessageNode

	| arguments isOr |
	isOr := aMessageNode selector beginsWith: #or:.
	valueTranslator visitNode: aMessageNode receiver.
	arguments := aMessageNode arguments.
	
	arguments do: [ :each |
		methodBuilder jumpAheadTo: #else if: isOr.
		self visitNode: each body ].
	
	self isValueTranslator ifTrue: [
		methodBuilder jumpAheadTo: #end].
	
	"there has to be a one-to-one correspondence between every jump and target"	
	arguments size timesRepeat: [ methodBuilder jumpAheadTarget: #else ].
	
	self isValueTranslator ifTrue: [
		methodBuilder pushLiteral: isOr.
		methodBuilder jumpAheadTarget: #end.
	].
! !

!ASTTranslator methodsFor: 'inline messages' stamp: 'pmm 7/20/2006 20:51'!
emitCaseNode: aMessageNode

	| cases assocMessageNode s |
	cases _ aMessageNode arguments first statements.
	valueTranslator visitNode: aMessageNode receiver.
	1 to: cases size - 1 do: [:i |
		methodBuilder pushDup.
		assocMessageNode _ cases at: i.
		valueTranslator visitNode: assocMessageNode receiver body.
		methodBuilder send: #=.
		methodBuilder jumpAheadTo: #next if: false.
		methodBuilder popTop.
		self visitNode: assocMessageNode arguments first body.
		methodBuilder jumpAheadTo: #end.
		methodBuilder jumpAheadTarget: #next.
	].
	aMessageNode arguments size = 2 ifTrue: [
		"last case with otherwise"
		assocMessageNode _ cases last.
		valueTranslator visitNode: assocMessageNode receiver body.
		methodBuilder send: #=.
		methodBuilder jumpAheadTo: #next if: false.
		self visitNode: assocMessageNode arguments first body.
		methodBuilder jumpAheadTo: #end.
		methodBuilder jumpAheadTarget: #next.
		self visitNode: aMessageNode arguments last body.
	] ifFalse: [
		"last case without otherwise"
		methodBuilder pushDup.
		assocMessageNode _ cases last.
		valueTranslator visitNode: assocMessageNode receiver body.
		methodBuilder send: #=.
		methodBuilder jumpAheadTo: #next if: false.
		methodBuilder popTop.
		self visitNode: assocMessageNode arguments first body.
		methodBuilder jumpAheadTo: #end.
		methodBuilder jumpAheadTarget: #next.
		methodBuilder send: #caseError.
		aMessageNode lastIsReturn ifTrue: [
			(s _ aMessageNode owningScope) isBlockScope ifTrue: [
				(s lookupVar: 'top env') emitValue: methodBuilder from: aMessageNode owningScope.
				methodBuilder remoteReturn.
			] ifFalse: [
				methodBuilder returnTop.
			]
		] ifFalse: [
			self isEffectTranslator ifTrue: [methodBuilder popTop].
		].
	].

	"there has to be a one-to-one correspondence between every jump and target"	
	cases size timesRepeat: [methodBuilder jumpAheadTarget: #end].
! !

!ASTTranslator methodsFor: 'inline messages' stamp: 'ms 10/30/2006 18:30'!
emitIfNilNode: aMessageNode

	| args selector |
	valueTranslator visitNode: aMessageNode receiver.
	args := aMessageNode arguments.
	(selector := aMessageNode selector) caseOf: {
		[#ifNil:] -> [self isValueTranslator ifTrue: [methodBuilder pushDup]].
		[#ifNil:ifNotNil:] -> [args last arguments ifNotEmpty: [args first arguments first binding emitLocalStore: methodBuilder]].
		[#ifNotNil:] -> [args first arguments ifNotEmpty: [args first arguments first binding emitLocalStore: methodBuilder]].
		[#ifNotNilDo:] -> [args first arguments ifNotEmpty: [args first arguments first binding emitLocalStore: methodBuilder]].
		[#ifNotNil:ifNil:] -> [args first arguments ifNotEmpty: [args first arguments first binding emitLocalStore: methodBuilder]]
	}.
	methodBuilder pushLiteral: nil.
	methodBuilder send: #==.
	methodBuilder jumpAheadTo: #else if: (selector beginsWith: #ifNotNil).
	(self == valueTranslator and: [selector == #ifNil:])
		ifTrue: [methodBuilder popTop].
	self visitNode: args first body.
	(args size > 1 or: [self == valueTranslator and: [selector == #ifNotNil: or: [selector == #ifNotNilDo:]]])
		ifTrue: [methodBuilder jumpAheadTo: #end].
	methodBuilder jumpAheadTarget: #else.
	(args size > 1 or: [self isValueTranslator and: [selector == #ifNotNil: or: [selector == #ifNotNilDo:]]]) ifTrue: [
		args size > 1
			ifTrue: [self visitNode: args last body]
			ifFalse: [methodBuilder pushLiteral: nil].
		methodBuilder jumpAheadTarget: #end.
	].
! !

!ASTTranslator methodsFor: 'inline messages' stamp: 'pmm 7/19/2006 11:55'!
emitIfNode: aMessageNode

	| args |
	valueTranslator visitNode: aMessageNode receiver.
	methodBuilder jumpAheadTo: #else if: (aMessageNode selector beginsWith: #ifFalse:).
	args _ aMessageNode arguments.
	self visitNode: args first body.
	(args size > 1 or: [self isValueTranslator]) ifTrue: [
		methodBuilder jumpAheadTo: #end].
	methodBuilder jumpAheadTarget: #else.
	(args size > 1 or: [self isValueTranslator]) ifTrue: [
		args size > 1
			ifTrue: [self visitNode: args last body]
			ifFalse: [methodBuilder pushLiteral: nil].
		methodBuilder jumpAheadTarget: #end.
	].
! !

!ASTTranslator methodsFor: 'inline messages' stamp: 'pmm 4/24/2006 22:31'!
emitMessageNode: aMessageNode

	aMessageNode isCascaded ifFalse: [
		valueTranslator visitNode: aMessageNode receiver].
	aMessageNode arguments do: [:each | 
		valueTranslator visitNode: each].
	aMessageNode isSuperSend
		ifTrue: [methodBuilder send: aMessageNode selector toSuperOf: aMessageNode owningScope classEncoding]
		ifFalse: [methodBuilder send: aMessageNode selector].
! !

!ASTTranslator methodsFor: 'inline messages' stamp: 'md 3/17/2006 14:17'!
emitToDoNode: aMessageNode

	| limit step block iterator limitEmit |
	limit := aMessageNode arguments first.
	step := 1.
	aMessageNode arguments size = 3 ifTrue: [
		"to:by:do:"
		step := aMessageNode arguments second.
		step isLiteral ifFalse: [self error: 'should not have been inlined'].
		step := step value.
	].
	block := aMessageNode arguments last.

	"push start. allocate and initialize iterator"
	valueTranslator visitNode: aMessageNode receiver.
	iterator := block arguments first binding.
	iterator emitLocalStore: methodBuilder.

	"push limit, store in a temp if it's an expression or a changing variable"
	valueTranslator visitNode: limit.
	limitEmit := [valueTranslator visitNode: limit].
	(limit isLiteral or: 
	 [limit isVariable and:
	  [ParseTreeSearcher new
		matches: limit name , ' := `@object' do: [:n :a | false];
		executeTree: block initialAnswer: true]]
	) ifFalse: [
		limit := {iterator. #limit}.  "must be unique throughout method"
		methodBuilder addTemp: limit.
		methodBuilder storeTemp: limit.
		limitEmit := [methodBuilder pushTemp: limit].
	].

	"loop"
	methodBuilder jumpBackTarget: #start.
	methodBuilder send: (step > 0 ifTrue: [#<=] ifFalse: [#>=]).
	methodBuilder jumpAheadTo: #done if: false.
	effectTranslator visitNode: block body.
	iterator emitLocalValue: methodBuilder.
	methodBuilder pushLiteral: step.
	methodBuilder send: #+.
	iterator emitLocalStore: methodBuilder.
	limitEmit value.
	methodBuilder jumpBackTo: #start.
	methodBuilder jumpAheadTarget: #done.
! !

!ASTTranslator methodsFor: 'inline messages' stamp: 'md 10/15/2004 12:37'!
emitWhileNode: aMessageNode

	methodBuilder jumpBackTarget: #begin.
	valueTranslator visitNode: aMessageNode receiver body.
	aMessageNode selector caseOf: {
		[#whileTrue:]	-> [methodBuilder jumpAheadTo: #end if: false].
		[#whileTrue]	-> [methodBuilder jumpAheadTo: #end if: false].
		[#whileFalse:]	-> [methodBuilder jumpAheadTo: #end if: true].
		[#whileFalse]	-> [methodBuilder jumpAheadTo: #end if: true]
	}.
	aMessageNode arguments ifNotEmpty: [
		effectTranslator visitNode: aMessageNode arguments first body].
	methodBuilder jumpBackTo: #begin.
	methodBuilder jumpAheadTarget: #end.
! !

!ASTTranslator methodsFor: 'initialize' stamp: 'ms 10/31/2006 15:06'!
initialize

	methodBuilder := IRBuilder new.
	effectTranslator := self as: ASTTranslatorForEffect.
	valueTranslator := self as: ASTTranslatorForValue.
	effectTranslator instVarNamed: #effectTranslator put: effectTranslator.
	effectTranslator instVarNamed: #valueTranslator put: valueTranslator.
	valueTranslator instVarNamed: #valueTranslator put: valueTranslator.
! !

!ASTTranslator methodsFor: 'accessing' stamp: 'ajh 3/10/2003 17:59'!
ir

	^ methodBuilder ir! !

!ASTTranslator methodsFor: 'testing' stamp: 'pmm 7/19/2006 11:54'!
isEffectTranslator
	^self == effectTranslator! !

!ASTTranslator methodsFor: 'testing' stamp: 'pmm 7/19/2006 11:52'!
isValueTranslator
	^self == valueTranslator! !

!ASTTranslator methodsFor: 'visitor-double dispatching' stamp: 'ajh 6/26/2004 18:32'!
translateBlockNode: aBlockNode 

	methodBuilder numRargs: aBlockNode arguments size + 1.
	methodBuilder addTemps: aBlockNode scope tempVars.
	aBlockNode scope emitPrologue: methodBuilder.
	valueTranslator visitNode: aBlockNode body.
	aBlockNode body lastIsReturn ifFalse: [
		methodBuilder returnTop].
! !

!ASTTranslator methodsFor: 'visiting' stamp: 'ajh 3/2/2003 03:31'!
visitNode: aNode

	methodBuilder mapToNode: aNode.
	super visitNode: aNode.
	methodBuilder popMap.
! !

ASTTranslator subclass: #ASTTranslatorForEffect
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ASTTranslatorForEffect commentStamp: 'ajh 3/24/2003 22:20' prior: 0!
I override some methods in my super to generate instructions for effect only.!

!ASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/10/2003 14:56'!
acceptArrayNode: anArrayNode 

	super acceptArrayNode: anArrayNode.
	methodBuilder popTop.
! !

!ASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'md 7/26/2006 14:45'!
acceptAssignmentNode: anAssignmentNode 

	super acceptAssignmentNode: anAssignmentNode.
	methodBuilder popTop. 
! !

!ASTTranslatorForEffect methodsFor: 'visitor-double dispatching' stamp: 'ajh 3/10/2003 14:56'!
acceptCascadeNode: aCascadeNode 

	super acceptCascadeNode: aCascadeNode.
	methodBuilder popTop.
! !

!ASTTranslatorForEffect methodsFor: 'emit messages' stamp: 'ajh 3/10/2003 14:57'!
emitMessageNode: aMessageNode 

	super emitMessageNode: aMessageNode.
	methodBuilder popTop.
! !

ASTTranslator subclass: #ASTTranslatorForValue
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!ASTTranslatorForValue commentStamp: 'ajh 3/24/2003 22:20' prior: 0!
I override some methods in my super to generate instructions for effect and value only.!

!ASTTranslatorForValue methodsFor: 'visitor-double dispatching' stamp: 'md 11/16/2004 15:14'!
acceptBlockNode: aBlockNode 

	| blockMethod args blockTemps |

	Preferences compileBlocksAsClosures ifFalse: [	
 		args := aBlockNode arguments collect: [:each | each binding].
		blockTemps := aBlockNode body temporaries  collect: [:each | each binding].
		methodBuilder addTemps: args.
		methodBuilder addTemps: blockTemps.
		methodBuilder pushThisContext.
		methodBuilder pushLiteral: aBlockNode arguments size.
		methodBuilder send: #blockCopy:.
		methodBuilder jumpOverBlockTo: #jmp.
     		args reverse do: [:arg | methodBuilder storeTemp: arg. methodBuilder popTop].
		super visitNode: aBlockNode body.
		aBlockNode body lastIsReturn ifFalse: [
				methodBuilder blockReturnTop].
		methodBuilder jumpAheadTarget: #jmp.
	 ^self ].
	
	blockMethod := aBlockNode generateIR.

	aBlockNode freeVars isEmpty ifTrue: [
		"Create block at compile time"
		methodBuilder pushBlock: blockMethod.
	] ifFalse: [
		"Create block at run time"
		| outerScope envVar |
		outerScope := aBlockNode scope outerScope.
		envVar := outerScope hasEscapingEnv
			ifTrue: [outerScope thisEnvVar]
			ifFalse: [outerScope receiverVar].
		methodBuilder pushBlockMethod: blockMethod.
		envVar emitLocalValue: methodBuilder.
		methodBuilder send: #createBlock:.
	].
! !

!ASTTranslatorForValue methodsFor: 'visitor-double dispatching' stamp: 'ajh 2/27/2003 18:18'!
acceptLiteralNode: aLiteralNode

	methodBuilder pushLiteral: aLiteralNode value.
! !

!ASTTranslatorForValue methodsFor: 'visitor-double dispatching' stamp: 'ajh 2/25/2003 18:21'!
acceptSequenceNode: aSequenceNode 

	super acceptSequenceNode: aSequenceNode.
	aSequenceNode statements isEmpty ifTrue: [
		methodBuilder pushLiteral: nil].
! !

!ASTTranslatorForValue methodsFor: 'visitor-double dispatching' stamp: 'md 10/15/2004 14:49'!
acceptVariableNode: aVariableNode
	
	aVariableNode binding emitValue: methodBuilder from: aVariableNode owningScope.
	
	! !

!ASTTranslatorForValue methodsFor: 'emit messages' stamp: 'ajh 2/25/2003 16:50'!
emitToDoNode: aMessageNode

	super emitToDoNode: aMessageNode.
	methodBuilder pushLiteral: nil.
! !

!ASTTranslatorForValue methodsFor: 'emit messages' stamp: 'ajh 2/25/2003 16:49'!
emitWhileNode: aMessageNode

	super emitWhileNode: aMessageNode.
	methodBuilder pushLiteral: nil.
! !

RBProgramNodeVisitor subclass: #NonClosureScopeFixer
	instanceVariableNames: 'methodScope'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Semantics'!

!NonClosureScopeFixer commentStamp: 'md 3/16/2006 17:49' prior: 0!
Standard Squeak has only one scope for temporaries: the method. All temps and args,
even those of the blocks, are just temps of the method.

But when compiling, we for sure want to do a correct scope analysis to make sure
that we do not access temps from outside their static scope... even if that's not
part of the semantic model of non-Closure Squeak.

The idea now is to use the scoping of the ClosureCompiler to work normally, making
scopes for variables... checking for errors. And then, afterwards, we go over
the AST and rewrite all temp-bindings... ugly.
!

!NonClosureScopeFixer methodsFor: 'visitor-double dispatching' stamp: 'md 3/16/2006 17:52'!
acceptDoItNode: aDoItNode
	methodScope := aDoItNode scope.
	self visitNode: aDoItNode body.! !

!NonClosureScopeFixer methodsFor: 'visitor-double dispatching' stamp: 'md 3/16/2006 17:52'!
acceptMethodNode: aMethodNode
	methodScope := aMethodNode scope.
	self visitNode: aMethodNode body.! !

!NonClosureScopeFixer methodsFor: 'visitor-double dispatching' stamp: 'md 3/20/2006 14:58'!
acceptVariableNode: aVariableNode

	| temp |

	aVariableNode binding isTemp ifFalse: [^self].
	aVariableNode binding scope isHome ifTrue: [^self].
	
	temp := methodScope rawVar: aVariableNode name.
	temp ifNil: [temp := methodScope addTemp: aVariableNode name].
	temp markArg.
	aVariableNode binding: temp.
	! !

OrderedCollection subclass: #LiteralList
	instanceVariableNames: 'equalitySet'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Bytecodes'!

!LiteralList commentStamp: 'ajh 3/25/2003 00:31' prior: 0!
Holds a unique ordered collection of literals!

!LiteralList methodsFor: 'adding' stamp: 'ajh 3/6/2003 18:00'!
addLast: object
	"Only add if not already in list"

	(equalitySet includes: object) ifTrue: [^ object].
	equalitySet add: object.
	super addLast: object.
	^ object
! !

!LiteralList methodsFor: 'accessing' stamp: 'ajh 1/21/2003 12:21'!
indexOf: anElement startingAt: start ifAbsent: exceptionBlock

	start to: self size do:
		[:index | ((self at: index) literalEqual: anElement) ifTrue: [^ index]].
	^ exceptionBlock value! !

!LiteralList methodsFor: 'private' stamp: 'ajh 1/21/2003 12:21'!
setCollection: anArray

	super setCollection: anArray.
	equalitySet _ LiteralSet new: anArray size.
! !

LongTestCase subclass: #CompilerRegressionTest
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Tests'!

!CompilerRegressionTest commentStamp: 'md 3/22/2005 14:51' prior: 0!
These are tests that recompile the whole image. This takes a long time. But
if such a test runs to completion, we are sure that there are no errors.

These tests are disabled by default. To enable:

       CompilerRegressionTest runLongTestCases.

Disable:

       CompilerRegressionTest doNotRunLongTestCases.!

!CompilerRegressionTest methodsFor: 'testing' stamp: 'md 3/22/2005 15:56'!
testBytecodeDecompileToIR
	"decompile all the byteocde of all methods of all classes to IR"

	self shouldnt: [
		Smalltalk allClasses do: [:class |
				class methodDict values do: [:m |
							m ir.
				] displayingProgress: 'decompiling'
		]
	] raise: Error.! !

!CompilerRegressionTest methodsFor: 'testing' stamp: 'md 3/22/2005 15:56'!
testBytecodeDecompileToIRAndRegenerate
	"decompile all the byteocde of all methods of all classes to IR. Then it
      gnerates a new method using IRBuilder"

	self shouldnt: [
			Smalltalk allClasses do: [:class|
					class methodDict values do: [:m |
						(m ir) compiledMethodWith: #().
					] displayingProgress: 'recompiling'
			]
	] raise: Error.! !

!CompilerRegressionTest methodsFor: 'testing' stamp: 'md 3/22/2005 16:26'!
testBytecodeRecompile
	"recompile the image BC->IR->BC and install"

	| new |

	self shouldnt: [
			Smalltalk allClasses do: [:class|
					class methodDict keysAndValuesDo: [:s :m |
							new := (m ir) compiledMethodWith: m trailer.
							class methodDict at: s put: new.
					]
			]
	] raise: Error.! !

InstructionStream subclass: #BytecodeDecompiler
	instanceVariableNames: 'irBuilder'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'NewCompiler-Bytecodes'!

!BytecodeDecompiler commentStamp: 'ajh 3/25/2003 00:26' prior: 0!
I interpret bytecode instructions, sending the appropriate instruction messages to my IRBuilder, resulting in an IRMethod.!

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 10/11/2004 15:21'!
blockReturnTop

	irBuilder blockReturnTop! !

!BytecodeDecompiler methodsFor: 'public access' stamp: 'md 2/25/2006 16:20'!
decompile: aCompiledMethod

	| ir |
	self method: aCompiledMethod pc: aCompiledMethod initialPC.
	irBuilder := IRBuilder new.
	irBuilder primitiveNode: aCompiledMethod primitiveNode.
	irBuilder numRargs: aCompiledMethod numArgs + 1.
	irBuilder addTemps: (0 to: aCompiledMethod numTemps).
	irBuilder properties: aCompiledMethod properties copy.

	aCompiledMethod isQuick
		ifTrue: [self quickMethod]
		ifFalse: [self interpret].
	ir := irBuilder ir.
	ir privCompiledMethod: aCompiledMethod.
	^ ir! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/10/2003 14:53'!
doDup

	irBuilder pushDup! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/10/2003 14:55'!
doPop

	irBuilder popTop! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 8/2/2005 17:11'!
interpretNextInstructionFor: client

	| byteIndex |
	byteIndex := pc - self method initialPC + 1.
	irBuilder mapToByteIndex: byteIndex.
	irBuilder testJumpAheadTarget: byteIndex.
	super interpretNextInstructionFor: client.
! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 9/29/2005 11:24'!
jump: dist

	| index seq instr newSeq seqs |
	index := pc + dist - self method initialPC + 1.
	dist >= 0 ifTrue: [
		"Maybe we are jumping over a non-closure Block." 
		(irBuilder currentSequence notEmpty and: [irBuilder currentSequence last isSend] and: [
			irBuilder currentSequence last selector == #blockCopy:]) ifTrue:
						[^irBuilder jumpOverBlockTo: index].
		"jump forward"
		^ irBuilder jumpAheadTo: index].

	"jump backward"
	seqs := irBuilder ir allSequences.
	seq := seqs findLast: [:s | s notEmpty and: [s first bytecodeIndex <= index]].
	seq := seqs at: seq.
	seq first bytecodeIndex = index ifTrue: [
		newSeq := seq.
	] ifFalse: [
		instr := seq detect: [:i | (seq after: i) bytecodeIndex = index].
		newSeq := seq splitAfter: instr.
	].
	irBuilder addJumpBackTarget: index to: newSeq.
	irBuilder jumpBackTo: index.
! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 13:59'!
jump: dist if: bool

	| index |
	index _ pc + dist - self method initialPC + 1.
	dist >= 0 ifTrue: [
		"jump forward"
		^ irBuilder jumpAheadTo: index if: bool].

	self error: 'can only conditional jump forward'! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:34'!
methodReturnConstant: value

	self
		pushConstant: value;
		methodReturnTop! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:33'!
methodReturnReceiver

	self
		pushReceiver;
		methodReturnTop! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:31'!
methodReturnTop

	irBuilder returnTop! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 7/7/2005 14:12'!
popIntoLiteralVariable: offset

	self
		storeIntoLiteralVariable: offset;
		doPop! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:33'!
popIntoReceiverVariable: offset

	self
		storeIntoReceiverVariable: offset;
		doPop! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:34'!
popIntoTemporaryVariable: offset

	self
		storeIntoTemporaryVariable: offset;
		doPop! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:34'!
pushActiveContext

	irBuilder pushThisContext! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:35'!
pushConstant: value

	irBuilder pushLiteral: value! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 7/9/2005 22:28'!
pushLiteralVariable: assoc

	irBuilder pushLiteralVariable: assoc.! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:35'!
pushReceiver

	irBuilder pushReceiver! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 6/13/2005 13:58'!
pushReceiverVariable: offset

	Preferences compileBlocksAsClosures ifTrue: [self pushReceiver].
	irBuilder pushInstVar: offset + 1.
! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:36'!
pushTemporaryVariable: offset

	irBuilder pushTemp: offset + 1! !

!BytecodeDecompiler methodsFor: 'private' stamp: 'ajh 3/15/2003 15:43'!
quickMethod

	self method primitive = 256 ifTrue: [
		^ self methodReturnReceiver
	].
	self method isReturnSpecial ifTrue: [
		^ self methodReturnConstant: (BytecodeGenerator specialConstants at: self method primitive - 256)
	].
	self method isReturnField ifTrue: [
		self pushReceiverVariable: self method returnField.
		^ self methodReturnTop
	].
	self halt: 'quick method inconsistency'! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 6/20/2005 11:50'!
send: selector super: superFlag numArgs: numArgs

	selector == #privRemoteReturnTo: ifTrue: [^ irBuilder remoteReturn].
	superFlag
		ifTrue: [irBuilder send: selector toSuperOf: self method literals last value]
		ifFalse: [irBuilder send: selector]! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 7/7/2005 14:14'!
storeIntoLiteralVariable: value

	irBuilder storeIntoLiteralVariable: value! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'md 6/13/2005 14:01'!
storeIntoReceiverVariable: offset

	Preferences compileBlocksAsClosures ifTrue: [self pushReceiver].
	irBuilder storeInstVar: offset + 1.
! !

!BytecodeDecompiler methodsFor: 'instruction decoding' stamp: 'ajh 3/2/2003 11:39'!
storeIntoTemporaryVariable: offset

	irBuilder storeTemp: offset + 1! !

!SmaCCParserError methodsFor: '*newcompiler' stamp: 'ms 10/6/2006 15:21'!
description
	"Return a textual description of the exception."

	| desc mt |
	desc := self class name asString.
	^(mt := self messageText) == nil
		ifTrue: [desc]
		ifFalse: [mt]! !
ClosureCompiler initialize!
Compiler initialize!
BytecodeGenerator initialize!
ClosureRuntimeStats initialize!
Parser2 initialize!
SqueakParser initialize!