'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 6 August 2008 at 12:52:57 pm'!
"Change Set:		PreRecompilationPatches
Date:			6 May 2008
Author:			Eliot Miranda

This deletes the SQ00 dialect support form both the standard and Tweak compilers.  It removes SyntaxAttribute, DialectParser, DialectMethodNode, DialectStream and CDialectStream and replaces them with Shout.

Also fixes a bug in MessageNode>>printToDoOn:indent: which is only a to:do: if the increment is the SmallInteger 1, *not* 1.0."!

TextDiffBuilder subclass: #CodeDiffBuilder
	instanceVariableNames: 'class'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'System-FilePackage'!

!CodeDiffBuilder commentStamp: '<historical>' prior: 0!
I am a differencer that compares source in tokens tokenised by a parser.  I consider comments significant, but consider sequences of whitespace equivalent.  Depending on the definition of WhitespaceForCodeDiff>>at: sequences of whitespace containing carriage-returns may be considered different to sequences of whitespace lacking carriage-returns (which may result in better-formatted diffs).!
]style[(392)i!

ParseNode subclass: #BlockArgsNode
	instanceVariableNames: 'temporaries'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-Syntax'!
ParseNode subclass: #Encoder
	instanceVariableNames: 'scopeTable nTemps supered requestor class selector literalStream selectorSet litIndSet litSet sourceRanges globalSourceRanges'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-Kernel'!
ParseNode subclass: #MethodNode
	instanceVariableNames: 'selectorOrFalse precedence arguments block literals primitive encoder temporaries properties sourceText '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
Smalltalk renameClassNamed: #ParserRemovedUnusedTemps as: #ReparseAfterSourceEditing!
Notification subclass: #ReparseAfterSourceEditing
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-Support'!
SelectorNode subclass: #KeyWordNode
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-Syntax'!

!Metaclass methodsFor: 'fileIn/Out' stamp: 'eem 5/7/2008 12:02'!
definition
	"Refer to the comment in ClassDescription|definition."

	^ String streamContents: 
		[:strm |
		strm print: self;
			crtab;
			nextPutAll: 'instanceVariableNames: ';
			store: self instanceVariablesString]! !


!BlockNode methodsFor: 'accessing' stamp: 'gk 4/6/2006 11:29'!
returnSelfIfNoOther: encoder

	self returns ifTrue:[^self].
	statements last == NodeSelf ifFalse: [
		statements := statements copyWith: (encoder encodeVariable: 'self').
	].
	self returnLast.
! !


!Encoder methodsFor: 'accessing' stamp: 'ar 9/9/2006 12:06'!
selector
	^selector! !

!Encoder methodsFor: 'accessing' stamp: 'ar 9/9/2006 12:06'!
selector: aSymbol
	selector := aSymbol! !


!MessageNode methodsFor: 'private' stamp: 'eem 5/23/2008 10:45'!
checkBlock: node as: nodeName from: encoder maxArgs: maxArgs
	"vb: #canBeSpecialArgument for blocks hardcodes 0 arguments as the requirement for special blocks. We work around that here by further checking the number of arguments for blocks.."

	node canBeSpecialArgument ifTrue: 
		[^node isMemberOf: BlockNode].
	^(node isKindOf: BlockNode)
		ifTrue:
			[node numberOfArguments <= maxArgs
				ifTrue: [true]
				ifFalse: [encoder notify: '<- ', nodeName , ' of ' ,
					(MacroSelectors at: special) , ' has too many arguments']]
		ifFalse:
			[encoder notify: '<- ', nodeName , ' of ' ,
					(MacroSelectors at: special) , ' must be a block or variable']! !


!MethodNode methodsFor: 'printing' stamp: 'eem 5/10/2008 13:52'!
printPropertiesOn: aStream
	properties ifNil: [^self].
	properties keysAndValuesDo:
		[:prop :val|
		aStream crtab; nextPut: $<.
		prop = #on:in:
			ifTrue:
				[prop keywords with: val do:
					[:k :v | aStream nextPutAll: k; space; nextPutAll: v; space]]
			ifFalse:
				[prop = #on
					ifTrue: [aStream nextPutAll: prop; nextPutAll:': '; nextPutAll: val] 
					ifFalse: [aStream nextPutAll: prop; nextPutAll:': '; print: val]]. 
		aStream nextPut: $>]! !


!Parser methodsFor: 'public access' stamp: 'eem 7/2/2008 11:24'!
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)."

	| methNode repeatNeeded myStream s p |
	category := aCategory.
	myStream := sourceStream.
	[repeatNeeded := false.
	 p := myStream position.
	 s := myStream upToEnd.
	 myStream position: p.
	 self init: myStream notifying: req failBlock: [^ aBlock value].
	 doitFlag := noPattern.
	 failBlock:= aBlock.
	 [methNode := self
					method: noPattern
					context: ctxt
					encoder: (self encoder init: class context: ctxt notifying: self)] 
		on: ReparseAfterSourceEditing 
		do:	[ :ex |
			repeatNeeded := true.
			myStream := ReadStream on: requestor text string].
	 repeatNeeded] whileTrue:
		[encoder := self encoder class new].
	methNode sourceText: s.
	^methNode
! !


!ProtoObject methodsFor: 'testing' stamp: 'vb 4/15/2007 10:54'!
ifNil: nilBlock ifNotNil: ifNotNilBlock
	"Evaluate the block, unless I'm == nil (q.v.)"

	^ ifNotNilBlock valueWithPossibleArgs: {self}! !

!ProtoObject methodsFor: 'testing' stamp: 'eem 5/23/2008 11:02'!
ifNotNil: ifNotNilBlock
	"Evaluate the block, unless I'm == nil (q.v.)"

	^ ifNotNilBlock valueWithPossibleArgs: {self}! !

!ProtoObject methodsFor: 'testing' stamp: 'vb 4/15/2007 10:55'!
ifNotNil: ifNotNilBlock ifNil: nilBlock 
	"If I got here, I am not nil, so evaluate the block ifNotNilBlock"

	^ ifNotNilBlock valueWithPossibleArgs: {self}! !


!BlockContext methodsFor: 'printing' stamp: 'eem 5/16/2008 12:03'!
printOn: aStream
	| decompilation blockString truncatedBlockString |

	home == nil ifTrue: [^aStream nextPutAll: 'a BlockContext with home=nil'].
	aStream nextPutAll: '[] in '.
	super printOn: aStream.
	decompilation := [self decompile ifNil: ['--source missing--']]
						on: Error
						do: [:ex| ' (error in decompilation)'].
	blockString := ((decompilation isString
					ifTrue: [decompilation]
					ifFalse: [decompilation printString])
						replaceAll: Character cr with: Character space)
							replaceAll: Character tab with: Character space.
	truncatedBlockString := blockString truncateWithElipsisTo: 80.
	truncatedBlockString size < blockString size ifTrue:
		[truncatedBlockString := truncatedBlockString, ']}'].
	aStream space; nextPutAll: truncatedBlockString! !


!ClassDescription methodsFor: 'fileIn/Out' stamp: 'eem 5/7/2008 12:02'!
definition
	"Answer a String that defines the receiver."

	| aStream path |
	aStream := WriteStream on: (String new: 300).
	superclass == nil
		ifTrue: [aStream nextPutAll: 'ProtoObject']
		ifFalse: [path := ''.
				self environment scopeFor: superclass name from: nil
						envtAndPathIfFound: [:envt :remotePath | path := remotePath].
				aStream nextPutAll: path , superclass name].
	aStream nextPutAll: self kindOfSubclass;
			store: self name.
	aStream cr; tab; nextPutAll: 'instanceVariableNames: ';
			store: self instanceVariablesString.
	aStream cr; tab; nextPutAll: 'classVariableNames: ';
			store: self classVariablesString.
	aStream cr; tab; nextPutAll: 'poolDictionaries: ';
			store: self sharedPoolsString.
	aStream cr; tab; nextPutAll: 'category: ';
			store: (SystemOrganization categoryOfElement: self name) asString.

	superclass ifNil: [ 
		aStream nextPutAll: '.'; cr.
		aStream nextPutAll: self name.
		aStream space; nextPutAll: 'superclass: nil'. ].

	^ aStream contents! !

!ClassDescription methodsFor: '*Tweak-Hacks' stamp: 'eem 5/7/2008 12:03'!
browserDefinition: style
	"Answer a String that defines the receiver."
	^self definition! !


!Class class methodsFor: 'instance creation' stamp: 'eem 5/7/2008 12:06'!
templateForSubclassOf: priorClassName category: systemCategoryName 
	"Answer an expression that can be edited and evaluated in order to define a new class, given that the class previously looked at was as given"

	^priorClassName asString, ' subclass: #NameOfSubclass
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''' , systemCategoryName asString , ''''! !


!CodeHolder methodsFor: 'contents' stamp: 'eem 5/7/2008 12:06'!
contentsSymbol
	"Answer a symbol indicating what kind of content should be shown for the method; for normal showing of source code, this symbol is #source.  A nil value in the contentsSymbol slot will be set to #source by this method"

	^ contentsSymbol ifNil:
		[contentsSymbol := Preferences browseWithPrettyPrint
								ifTrue:
									[Preferences colorWhenPrettyPrinting
										ifTrue:	[#colorPrint]
										ifFalse:	[#prettyPrint]]
								ifFalse:
									[#source]]! !


!Browser methodsFor: 'class functions' stamp: 'eem 5/7/2008 12:04'!
classDefinitionText
	"return the text to display for the definition of the currently selected class"
	| theClass |
	^(theClass := self selectedClassOrMetaClass) ifNil: [''] ifNotNil: [theClass definition]! !


!CompiledMethod methodsFor: 'source code management' stamp: 'eem 5/6/2008 15:15'!
putSource: sourceStr fromParseNode: methodNode inFile: fileIndex withPreamble: preambleBlock
	"Store the source code for the receiver on an external file.
	If no sources are available, i.e., SourceFile is nil, then store
	temp names for decompilation at the end of the method.
	If the fileIndex is 1, print on *.sources;  if it is 2, print on *.changes,
	in each case, storing a 4-byte source code pointer at the method end."

	| file remoteString |
	(SourceFiles == nil or: [(file := SourceFiles at: fileIndex) == nil]) ifTrue:
		[^self become: (self copyWithTempNames: methodNode tempNames)].

	SmalltalkImage current assureStartupStampLogged.
	file setToEnd.

	preambleBlock value: file.  "Write the preamble"
	remoteString := RemoteString newString: sourceStr onFileNumber: fileIndex toFile: file.
	file nextChunkPut: ' '.
	InMidstOfFileinNotification signal ifFalse: [file flush].
	self checkOKToAdd: sourceStr size at: remoteString position.
	self setSourcePosition: remoteString position inFile: fileIndex! !


!Compiler methodsFor: 'public access' stamp: 'eem 5/6/2008 15:16'!
format: textOrStream in: aClass notifying: aRequestor contentsSymbol: aSymbol
	"Compile a parse tree from the argument, textOrStream. Answer a string containing the original code, formatted nicely.  If aBoolean is true, then decorate the resulting text with color and hypertext actions"

	| aNode |
	self from: textOrStream
		class: aClass
		context: nil
		notifying: aRequestor.
	aNode := self format: sourceStream noPattern: false ifFail: [^ nil].

	aSymbol == #colorPrint ifTrue:
		[^aNode asColorizedSmalltalk80Text].

	^aNode decompileString! !

!Compiler methodsFor: 'public access' stamp: 'eem 5/15/2008 15:11'!
parse: 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.
	^self parser
		parse: sourceStream
		class: class
		noPattern: false
		context: context
		notifying: requestor
		ifFail: []! !


!Debugger methodsFor: 'code pane' stamp: 'eem 6/5/2008 10:54'!
pcRange
	"Answer the indices in the source code for the method corresponding to 
	the selected context's program counter value."

	(selectingPC and: [contextStackIndex ~= 0]) ifFalse:
		[^1 to: 0].
	self selectedContext isDead ifTrue:
		[^1 to: 0].
	debuggerMap ifNil:
		[debuggerMap := self selectedContext debuggerMap].
	^debuggerMap
		rangeForPC: self selectedContext pc
		contextIsActiveContext: contextStackIndex = 1! !


!Decompiler methodsFor: 'public access' stamp: 'eem 5/12/2008 17:23'!
decompile: aSelector in: aClass method: aMethod using: aConstructor

	| block |
	constructor := aConstructor.
	method := aMethod.
	self initSymbols: aClass.  "create symbol tables"
	method isQuick
		ifTrue: [block := self quickMethod]
		ifFalse: 
			[stack := OrderedCollection new: method frameSize.
			caseExits := OrderedCollection new.
			statements := OrderedCollection new: 20.
			super method: method pc: method initialPC.
			block := self blockTo: method endPC + 1.
			stack isEmpty ifFalse: [self error: 'stack not empty']].
	^constructor
		codeMethod: aSelector
		block: block
		tempVars: tempVars
		primitive: method primitive
		class: aClass! !


!InstructionPrinter methodsFor: 'instruction decoding' stamp: 'eem 5/23/2008 13:58'!
pushConstant: obj
	"Print the Push Constant, obj, on Top Of Stack bytecode."

	self print: (String streamContents:
				[:s |
				s nextPutAll: 'pushConstant: '.
				(obj isKindOf: LookupKey)
					ifFalse: [obj printOn: s]
					ifTrue: [obj key
						ifNotNil: [s nextPutAll: '##'; nextPutAll: obj key]
						ifNil: [s nextPutAll: '###'; nextPutAll: obj value soleInstance name]]]).

	(obj isKindOf: CompiledMethod) ifTrue:
		[obj longPrintOn: stream indent: self indent + 2.
		^self].! !


!Metaclass methodsFor: '*Tweak-Hacks' stamp: 'eem 5/7/2008 12:03'!
browserDefinition: style
	"Answer a String that defines the receiver."
	^self definition! !


!ParseNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:50'!
printCommentOn: aStream indent: indent 
	| thisComment |
	self comment == nil ifTrue: [^ self].
	1 to: self comment size
	   do: [:index |
		index > 1 ifTrue: [aStream crtab: indent].
		aStream nextPut: $".
		thisComment := self comment at: index.
		self printSingleComment: thisComment
			on: aStream
			indent: indent.
		aStream nextPut: $"].
	self comment: nil! !

!ParseNode methodsFor: 'printing' stamp: 'eem 5/6/2008 15:18'!
printOn: aStream 
	"Refer to the comment in Object|printOn:."

	aStream nextPut: ${.
	self printOn: aStream indent: 0.
	aStream nextPut: $}.! !


!AssignmentNode methodsFor: 'printing' stamp: 'eem 5/6/2008 13:48'!
printOn: aStream indent: level 
	variable printOn: aStream indent: level.
	aStream nextPutAll: ' := '.
	value printOn: aStream indent: level + 2! !

!AssignmentNode methodsFor: 'printing' stamp: 'eem 5/9/2008 18:44'!
printOn: aStream indent: level precedence: p

	aStream nextPut: $(.
	self printOn: aStream indent: level.
	aStream nextPut: $)! !


!BlockNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:28'!
printArgumentsOn: aStream indent: level
	arguments size = 0 ifTrue: [^ self].
	arguments do:
		[:arg | aStream nextPut: $:;  nextPutAll: arg key;  space].
	aStream nextPut: $|; space.
	"If >0 args and >1 statement, put all statements on separate lines"
	statements size > 1 ifTrue:
		[aStream crtab: level]! !

!BlockNode methodsFor: 'printing' stamp: 'eem 6/21/2008 13:01'!
printTemporariesOn: aStream indent: level

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


!BlockNode class methodsFor: 'instance creation' stamp: 'eem 5/19/2008 17:10'!
withJust: aNode
	^ self new statements: (Array with: aNode) returns: false! !


!Encoder methodsFor: 'initialize-release' stamp: 'eem 5/6/2008 12:12'!
initScopeAndLiteralTables

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


!LeafNode methodsFor: 'initialize-release' stamp: 'ar 3/26/2004 15:44'!
key: object code: byte

	key := object.
	code := byte! !

!LeafNode methodsFor: 'initialize-release' stamp: 'ar 3/26/2004 15:44'!
name: ignored key: object code: byte

	key := object.
	code := byte! !

!LeafNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:44'!
emitLong: mode on: aStream 
	"Emit extended variable access."
	| type index |
	code < 256
		ifTrue:
			[code < 16
			ifTrue: [type := 0.
					index := code]
			ifFalse: [code < 32
					ifTrue: [type := 1.
							index := code - 16]
					ifFalse: [code < 96
							ifTrue: [type := code // 32 + 1.
									index := code \\ 32]
							ifFalse: [self error: 
									'Sends should be handled in SelectorNode']]]]
		ifFalse: 
			[index := code \\ 256.
			type := code // 256 - 1].
	index <= 63 ifTrue:
		[aStream nextPut: mode.
		^ aStream nextPut: type * 64 + index].
	"Compile for Double-exetended Do-anything instruction..."
	mode = LoadLong ifTrue:
		[aStream nextPut: DblExtDoAll.
		aStream nextPut: (#(64 0 96 128) at: type+1).  "Cant be temp (type=1)"
		^ aStream nextPut: index].
	mode = Store ifTrue:
		[aStream nextPut: DblExtDoAll.
		aStream nextPut: (#(160 0 0 224) at: type+1).  "Cant be temp or const (type=1 or 2)"
		^ aStream nextPut: index].
	mode = StorePop ifTrue:
		[aStream nextPut: DblExtDoAll.
		aStream nextPut: (#(192 0 0 0) at: type+1).  "Can only be inst"
		^ aStream nextPut: index].
! !

!LeafNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 15:57'!
reserve: encoder 
	"If this is a yet unused literal of type -code, reserve it."

	code < 0 ifTrue: [code := self code: (index := encoder litIndex: key) type: 0 - code]! !

!LeafNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:44'!
sizeForValue: encoder
	self reserve: encoder.
	code < 256 ifTrue: [^ 1].
	(code \\ 256) <= 63 ifTrue: [^ 2].
	^ 3! !

!LeafNode methodsFor: 'copying' stamp: 'eem 7/12/2008 17:24'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"key := key.		Weakly copied"
code := code veryDeepCopyWith: deepCopier.
index := index veryDeepCopyWith: deepCopier.
! !


!LiteralNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:46'!
printOn: aStream indent: level

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


!MessageNode methodsFor: 'initialize-release' stamp: 'eem 5/10/2008 12:10'!
receiver: rcvr selector: aSelector arguments: args precedence: p from: encoder 
	"Compile."

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

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 5/23/2008 13:14'!
noteSpecialSelector: selectorSymbol
	"special > 0 denotes specially treated (potentially inlined) messages. "

	special := MacroSelectors indexOf: selectorSymbol.
! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 5/23/2008 10:51'!
transformIfNil: encoder

	"vb: Removed the original transformBoolean: which amounds to a test we perform in each of the branches below."
	(MacroSelectors at: special) = #ifNotNil: ifTrue:
		[(self checkBlock: arguments first as: 'ifNotNil arg' from: encoder maxArgs: 1) ifFalse:
			[^false].

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

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 5/23/2008 10:56'!
transformIfNilIfNotNil: encoder
	"vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we
	 transform the receiver to
		(var := receiver)
	 which is further transformed to
		(var := receiver) == nil ifTrue: .... ifFalse: ...
	 This does not allow the block variable to shadow an existing temp, but it's no different
	 from how to:do: is done."
	| ifNotNilArg |
	ifNotNilArg := arguments at: 2.
	((self checkBlock: (arguments at: 1) as: 'Nil arg' from: encoder)
	  and: [self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1]) ifFalse:
		[^false].

	ifNotNilArg numberOfArguments = 1 ifTrue:
		[receiver := AssignmentNode new
						variable: ifNotNilArg firstArgument
						value: receiver].

	selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
	receiver := MessageNode new
					receiver: receiver
					selector: #==
					arguments: (Array with: NodeNil)
					precedence: 2
					from: encoder.
	arguments do: [:arg| arg noteOptimized].
	^true! !

!MessageNode methodsFor: 'macro transformations' stamp: 'eem 5/23/2008 11:00'!
transformIfNotNilIfNil: encoder
	"vb: Changed to support one-argument ifNotNil: branch. In the 1-arg case we
	 transform the receiver to
		(var := receiver)
	 which is further transformed to
		(var := receiver) == nil ifTrue: .... ifFalse: ...
	 This does not allow the block variable to shadow an existing temp, but it's no different
	 from how to:do: is done."
	| ifNotNilArg |
	ifNotNilArg := arguments at: 1.
	((self checkBlock: ifNotNilArg as: 'NotNil arg' from: encoder maxArgs: 1)
	  and: [self checkBlock: (arguments at: 2) as: 'Nil arg' from: encoder]) ifFalse:
		[^false].

	ifNotNilArg numberOfArguments = 1 ifTrue:
		[receiver := AssignmentNode new
						variable: ifNotNilArg firstArgument
						value: receiver].

	selector := SelectorNode new key: #ifTrue:ifFalse: code: #macro.
	receiver := MessageNode new
					receiver: receiver
					selector: #==
					arguments: (Array with: NodeNil)
					precedence: 2
					from: encoder.
	arguments swap: 1 with: 2.
	arguments do: [:arg| arg noteOptimized].
	^true! !

!MessageNode methodsFor: 'code generation' stamp: 'eem 5/23/2008 10:47'!
emitIfNil: stack on: strm value: forValue

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

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 13:56'!
printCaseOn: aStream indent: level 
	"receiver caseOf: {[key]->[value]. ...} otherwise: [otherwise]"
	| braceNode otherwise extra |
	braceNode := arguments first.
	otherwise := arguments last.
	(arguments size = 1 or: [otherwise isJustCaseError]) ifTrue:
		[otherwise := nil].
	receiver
		printOn: aStream
		indent: level
		precedence: 3.
	aStream nextPutAll: ' caseOf: '.
	braceNode isVariableReference
		ifTrue: [braceNode printOn: aStream indent: level]
		ifFalse: 
			[aStream nextPutAll: '{'; crtab: level + 1.
			 braceNode casesForwardDo:
				[:keyNode :valueNode :last | 
				keyNode printOn: aStream indent: level + 1.
				aStream nextPutAll: ' -> '.
				valueNode isComplex
					ifTrue: 
						[aStream crtab: level + 2.
						extra := 1]
					ifFalse: [extra := 0].
				valueNode printOn: aStream indent: level + 1 + extra.
				last ifTrue: [aStream nextPut: $}]
					ifFalse: [aStream nextPut: $.;
							 crtab: level + 1]]].
	otherwise notNil ifTrue:
		[aStream crtab: level + 1; nextPutAll: ' otherwise: '.
		 extra := otherwise isComplex
					ifTrue: 
						[aStream crtab: level + 2.
						 1]
					ifFalse: [0].
		 otherwise printOn: aStream indent: level + 1 + extra]! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 13:57'!
printIfOn: aStream indent: level

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

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:35'!
printKeywords: key arguments: args on: aStream indent: level
	| keywords indent arg kwd doCrTab |
	args size = 0 ifTrue: [aStream space; nextPutAll: key. ^self].
	keywords := key keywords.
	doCrTab := args size > 2
				or: [{receiver} , args anySatisfy:
						[:thisArg |
						(thisArg isKindOf: BlockNode)
						or: [(thisArg isKindOf: MessageNode) and: [thisArg precedence >= 3]]]].
	1 to: (args size min: keywords size) do:
		[:i |
		arg := args at: i.
		kwd := keywords at: i.
		doCrTab
			ifTrue: [aStream crtab: level+1. indent := 1] "newline after big args"
			ifFalse: [aStream space. indent := 0].
		aStream nextPutAll: kwd; space.
		arg printOn: aStream
			indent: level + 1 + indent
			precedence: (precedence = 2 ifTrue: [1] ifFalse: [precedence])]! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:48'!
printKeywords: key arguments: args on: aStream indent: level prefix: isPrefix
	| keywords indent arg kwd doCrTab |
	args size = 0 ifTrue:
		[aStream space; nextPutAll: key. ^self].
	keywords := key keywords.
	doCrTab := args size > 2
				or: [{receiver} , args anySatisfy:
					[ :thisArg |
					(thisArg isKindOf: BlockNode)
					or: [(thisArg isKindOf: MessageNode) and: [thisArg precedence >= 3]]]].
	1 to: (args size min: keywords size) do:
		[:i | arg := args at: i.  kwd := keywords at: i.
		doCrTab
			ifTrue: [aStream crtab: level+1. indent := 1] "newline after big args"
			ifFalse: [aStream space. indent := 0].
		aStream nextPutAll: kwd; space.
		arg printOn: aStream indent: level + 1 + indent
			 	precedence: (precedence = 2 ifTrue: [1] ifFalse: [precedence])]! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:08'!
printOn: aStream indent: level
	"may not need this check anymore - may be fixed by the #receiver: change"
	special ifNil: [^aStream nextPutAll: '** MessageNode with nil special **'].

	special > 0 ifTrue:
		[^self perform: self macroPrinter with: aStream with: level].

	self printReceiver: receiver on: aStream indent: level.
	self printKeywords: selector key
		 arguments: arguments
		 on: aStream
		 indent: level! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:09'!
printReceiver: rcvr on: aStream indent: level
					
	rcvr ifNil: [^ self].

	"Force parens around keyword receiver of kwd message"
	rcvr printOn: aStream indent: level precedence: precedence! !

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:12'!
printToDoOn: aStream indent: level

	| limitNode |
	self printReceiver: receiver on: aStream indent: level.

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

!MessageNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:14'!
printWhileOn: aStream indent: level

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

!MessageNode methodsFor: 'private' stamp: 'vb 4/15/2007 09:10'!
checkBlock: node as: nodeName from: encoder

	^self checkBlock: node as: nodeName from: encoder maxArgs: 0! !


!MethodNode methodsFor: 'code generation' stamp: 'eem 5/20/2008 12:57'!
generate: trailer 
	"The receiver is the root of a parse tree. Answer a CompiledMethod. The
	argument, trailer, is the references to the source code that is stored with 
	every CompiledMethod."

	| blkSize nLits literals stack strm nArgs method |
	self generate: trailer ifQuick: 
		[:m |
		literals := encoder allLiterals.
		(nLits := literals size) > 255 ifTrue:
			[^self error: 'Too many literals referenced'].
		1 to: nLits do: [:lit | m literalAt: lit put: (literals at: lit)].
		m properties: properties.
		^m].
	nArgs := arguments size.
	blkSize := block sizeForEvaluatedValue: encoder.
	(nLits := (literals := encoder allLiterals) size) > 255 ifTrue:
		[^self error: 'Too many literals referenced'].
	method := CompiledMethod	"Dummy to allocate right size"
				newBytes: blkSize
				trailerBytes: trailer 
				nArgs: nArgs
				nTemps: encoder maxTemp
				nStack: 0
				nLits: nLits
				primitive: primitive.
	strm := ReadWriteStream with: method.
	strm position: method initialPC - 1.
	stack := ParseStack new init.
	block emitForEvaluatedValue: stack on: strm.
	stack position ~= 1 ifTrue:
		[^self error: 'Compiler stack discrepancy'].
	strm position ~= (method size - trailer size) ifTrue:
		[^self error: 'Compiler code size discrepancy'].
	method needsFrameSize: stack size.
	1 to: nLits do: [:lit | method literalAt: lit put: (literals at: lit)].
	method properties: properties.
	^method! !

!MethodNode methodsFor: 'converting' stamp: 'eem 7/18/2008 06:37'!
asColorizedSmalltalk80Text
	"Answer a colorized Smalltalk-80-syntax string description of the parse tree whose root is the receiver."

	| printText |
	printText := self printString asText.
	^(Smalltalk at: #SHTextStylerST80 ifAbsent: [nil])
		ifNotNil: [:stylerClass| stylerClass new styledTextFor: printText]
		ifNil: [printText]! !

!MethodNode methodsFor: 'converting' stamp: 'eem 5/6/2008 15:17'!
decompileString 
	"Answer a string description of the parse tree whose root is the receiver."

	^self printString
! !

!MethodNode methodsFor: 'converting' stamp: 'eem 5/6/2008 15:17'!
decompileText 
	"Answer a string description of the parse tree whose root is the receiver."

	^self asColorizedSmalltalk80Text! !

!MethodNode methodsFor: 'printing' stamp: 'eem 5/14/2008 12:13'!
printOn: aStream 

	precedence = 1
		ifTrue: 
			[(self selector includesSubString: '()/')
				ifTrue: [aStream nextPutAll: (self selector copyUpTo: $)).
						arguments
							do: [:arg| aStream nextPutAll: arg key]
							separatedBy: [aStream nextPutAll: ', '].
						aStream nextPut: $)]
				ifFalse: [aStream nextPutAll: self selector]]  "no node for method selector"
		ifFalse: 
			[self selector keywords with: arguments do: 
				[:kwd :arg | 
				aStream nextPutAll: kwd; space; nextPutAll: arg key; space]].
	comment == nil ifFalse: 
			[aStream crtab: 1.
			 self printCommentOn: aStream indent: 1].
	temporaries size > 0 ifTrue: 
			[aStream crtab: 1; nextPut: $|.
			temporaries do: [:temp | 
				aStream space.
				temp printOn: aStream indent: 0].
			aStream space; nextPut: $|].
	primitive > 0 ifTrue:
		[(primitive between: 255 and: 519) ifFalse:  "Dont decompile quick prims  e.g, ^ self or ^instVar"
			[aStream crtab: 1.
			 self printPrimitiveOn: aStream]].
	self printPropertiesOn: aStream.
	aStream crtab: 1.
	block printStatementsOn: aStream indent: 0! !


!Preferences class methodsFor: 'misc' stamp: 'eem 5/7/2008 12:07'!
defaultValueTableForCurrentRelease
	"Answer a table defining default values for all the preferences in the release.  Returns a list of (pref-symbol, boolean-symbol) pairs"

	^  #(
		(abbreviatedBrowserButtons false)
		(allowCelesteTell true)
		(alternativeBrowseIt false)
		(alternativeScrollbarLook true)
		(alternativeWindowLook true)
		(annotationPanes false)
		(areaFillsAreTolerant false)
		(areaFillsAreVeryTolerant false)
		(autoAccessors false)
		(automaticFlapLayout true)
		(automaticKeyGeneration false)
		(automaticPlatformSettings true)
		(automaticViewerPlacement true)
		(balloonHelpEnabled true)
		(balloonHelpInMessageLists false)
		(batchPenTrails false)
		(browseWithDragNDrop false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying false)
		(capitalizedReferences true)
		(caseSensitiveFinds false)
		(cautionBeforeClosing false)
		(celesteHasStatusPane false)
		(celesteShowsAttachmentsFlag false)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(checkForUnsavedProjects true)
		(classicNavigatorEnabled false)
		(classicNewMorphMenu false)
		(clickOnLabelToEdit false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(compactViewerFlaps false)
		(compressFlashImages false)
		(confirmFirstUseOfStyle true)
		(conversionMethodsAtFileOut false)
		(cpuWatcherEnabled false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose false)
		(dragNDropWithAnimation false)
		(eToyFriendly false)
		(eToyLoginEnabled false)
		(enableLocalSave true)
		(extractFlashInHighQuality true)
		(extractFlashInHighestQuality false)
		(fastDragWindowForMorphic true)
		(fenceEnabled true)
		(fullScreenLeavesDeskMargins true)
		(haloTransitions false)
		(hiddenScrollBars false)
		(higherPerformance false)
		(honorDesktopCmdKeys true)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars true)
		(includeSoundControlInNavigator false)
		(infiniteUndo false)
		(logDebuggerStackToFile true)
		(magicHalos false)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl false)  
		(modalColorPickers true)
		(mouseOverForKeyboardFocus false)
		(mouseOverHalos false)
		(mvcProjectsAllowed true)
		(navigatorOnLeftEdge true)
		(noviceMode false)
		(okToReinitializeFlaps true)
		(optionalButtons true)
		(passwordsOnPublish false)
		(personalizedWorldMenu true)
		(postscriptStoredAsEPS false)
		(preserveTrash true)
		(projectViewsInWindows true)
		(projectZoom true)
		(projectsSentToDisk false)
		(promptForUpdateServer true)
		(propertySheetFromHalo false)
		(readDocumentAtStartup true)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(roundedMenuCorners true)
		(roundedWindowCorners true)
		(scrollBarsNarrow false)
		(scrollBarsOnRight true)
		(scrollBarsWithoutMenuButton false)
		(securityChecksEnabled false)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(showDirectionForSketches false)
		(showDirectionHandles false)
		(showFlapsWhenPublishing false)
		(showProjectNavigator false)
		(showSecurityStatus true)
		(showSharedFlaps true)
		(signProjectFiles true)
		(simpleMenus false)
		(slideDismissalsToTrash true)
		(smartUpdating true)
		(soundQuickStart false)
		(soundStopWhenDone false)
		(soundsEnabled true)
		(startInUntrustedDirectory false)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(tileTranslucentDrag true)
		(timeStampsInMenuTitles true)
		(turnOffPowerManager false)
		(twentyFourHourFileStamps true)
		(twoSidedPoohTextures true)
		(typeCheckingInTileScripting true)
		(uniTilesClassic true)
		(uniqueNamesInHalos false)
		(universalTiles false)
		(unlimitedPaintArea false)
		(updateSavesFile false)
		(useButtonProprtiesToFire false)
		(useUndo true)
		(viewersInFlaps true)
		(warnAboutInsecureContent true)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))


"
Preferences defaultValueTableForCurrentRelease do:
	[:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo:
			[:pref | pref defaultValue: (pair last == true)]].
Preferences chooseInitialSettings.
"! !

!Preferences class methodsFor: 'themes' stamp: 'eem 5/7/2008 12:07'!
brightSqueak
	"The classic bright Squeak look.  Windows have saturated colors and relatively low contrast; scroll-bars are of the flop-out variety and are on the left.  Many power-user features are enabled."

	self setPreferencesFrom:
	#(
		(alternativeScrollbarLook false)
		(alternativeWindowLook false)
		(annotationPanes true)
		(automaticFlapLayout true)
		(balloonHelpEnabled true)
		(balloonHelpInMessageLists false)
		(browseWithDragNDrop true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(classicNavigatorEnabled false)
		(classicNewMorphMenu false)
		(clickOnLabelToEdit false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dragNDropWithAnimation true)
		(eToyFriendly false)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(haloTransitions false)
		(hiddenScrollBars false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(logDebuggerStackToFile true)
		(magicHalos false)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)  
		(mouseOverForKeyboardFocus true)
		(navigatorOnLeftEdge true)
		(noviceMode false)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(preserveTrash true)
		(projectViewsInWindows true)
		(projectZoom true)
		(propertySheetFromHalo false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(roundedMenuCorners true)
		(roundedWindowCorners true)
		(scrollBarsNarrow false)
		(scrollBarsOnRight false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(showProjectNavigator false)
		(showSharedFlaps true)
		(simpleMenus false)
		(smartUpdating true)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(timeStampsInMenuTitles true)
		(universalTiles false)
		(unlimitedPaintArea false)
		(useButtonProprtiesToFire false)
		(useUndo true)
		(viewersInFlaps true)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true)).

	self installBrightWindowColors! !

!Preferences class methodsFor: 'themes' stamp: 'eem 5/7/2008 12:07'!
paloAlto
	"Similar to the brightSqueak theme, but with a number of idiosyncratic personal settings.   Note that mouseOverForKeyboardFocus & caseSensitiveFinds are both true"


	self setPreferencesFrom:
	#(
		(abbreviatedBrowserButtons false)
		(accessOnlineModuleRepositories noOpinion)
		(allowCelesteTell noOpinion)
		(alternativeBrowseIt noOpinion)
		(alternativeScrollbarLook false)
		(alternativeWindowLook false)
		(annotationPanes true)
		(areaFillsAreTolerant true)
		(areaFillsAreVeryTolerant false)
		(autoAccessors false)
		(automaticFlapLayout true)
		(automaticKeyGeneration noOpinion)
		(automaticPlatformSettings noOpinion)
		(automaticViewerPlacement false)
		(balloonHelpEnabled true)
		(balloonHelpInMessageLists false)
		(batchPenTrails noOpinion)
		(browseWithDragNDrop false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying noOpinion)
		(capitalizedReferences true)
		(caseSensitiveFinds true)
		(cautionBeforeClosing false)
		(celesteHasStatusPane noOpinion)
		(celesteShowsAttachmentsFlag noOpinion)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(checkForUnsavedProjects noOpinion)
		(classicNavigatorEnabled false)
		(classicNewMorphMenu false)
		(clickOnLabelToEdit false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(compactViewerFlaps false)
		(compressFlashImages noOpinion)
		(confirmFirstUseOfStyle true)
		(conservativeModuleDeActivation noOpinion)
		(conversionMethodsAtFileOut true)
		(cpuWatcherEnabled noOpinion)
		(debugHaloHandle true)
		(debugPrintSpaceLog true)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose true)
		(dragNDropWithAnimation false)
		(duplicateControlAndAltKeys false)
		(eToyFriendly false)
		(eToyLoginEnabled noOpinion)
		(enableLocalSave true)
		(extractFlashInHighQuality noOpinion)
		(extractFlashInHighestQuality noOpinion)
		(extraDebuggerButtons true)
		(fastDragWindowForMorphic true)
		(fenceEnabled true)
		(fenceSoundEnabled  false)
		(fullScreenLeavesDeskMargins true)
		(haloTransitions false)
		(hiddenScrollBars false)
		(higherPerformance noOpinion)
		(honorDesktopCmdKeys true)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(includeSoundControlInNavigator true)
		(infiniteUndo false)
		(lenientScopeForGlobals noOpinion)
		(logDebuggerStackToFile true)
		(magicHalos false)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)  
		(modalColorPickers true)
		(modularClassDefinitions noOpinion)
		(mouseOverForKeyboardFocus true)
		(mouseOverHalos false)
		(mvcProjectsAllowed true)
		(navigatorOnLeftEdge true)
		(noviceMode false)
		(okToReinitializeFlaps true)
		(optionalButtons true)
		(passwordsOnPublish noOpinion)
		(personalizedWorldMenu true)
		(postscriptStoredAsEPS noOpinion)
		(preserveTrash false)
		(projectsSentToDisk noOpinion)
		(projectViewsInWindows true)
		(projectZoom true)
		(promptForUpdateServer false)
		(propertySheetFromHalo false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(roundedMenuCorners true)
		(roundedWindowCorners true)
		(scrollBarsNarrow false)
		(scrollBarsOnRight false)
		(scrollBarsWithoutMenuButton false)
		(securityChecksEnabled noOpinion)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(showDirectionForSketches true)
		(showDirectionHandles false)
		(showFlapsWhenPublishing false)
		(showProjectNavigator false)
		(showSecurityStatus noOpinion)
		(showSharedFlaps true)
		(signProjectFiles noOpinion)
		(simpleMenus false)
		(slideDismissalsToTrash true)
		(smartUpdating true)
		(soundQuickStart noOpinion)
		(soundsEnabled true)
		(soundStopWhenDone noOpinion)
		(startInUntrustedDirectory noOpinion)
		(strongModules noOpinion)
		(swapControlAndAltKeys noOpinion)
		(swapMouseButtons  noOpinion)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(tileTranslucentDrag noOpinion)
		(timeStampsInMenuTitles true)
		(turnOffPowerManager noOpinion)
		(twentyFourHourFileStamps false)
		(twoSidedPoohTextures noOpinion)
		(typeCheckingInTileScripting noOpinion)
		(uniqueNamesInHalos false)
		(uniTilesClassic noOpinion)
		(universalTiles false)
		(unlimitedPaintArea false)
		(updateSavesFile noOpinion)
		(useButtonProprtiesToFire false)
		(useUndo true)
		(viewersInFlaps true)
		(warnAboutInsecureContent noOpinion)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true)).

	self installBrightWindowColors! !

!Preferences class methodsFor: 'themes' stamp: 'eem 5/7/2008 12:07'!
smalltalk80
	"A traditional monochrome Smalltalk-80 look and feel, clean and austere, and lacking many features added to Squeak in recent years. Caution: this theme removes the standard Squeak flaps, turns off the 'smartUpdating' feature that keeps multiple browsers in synch, and much more."

	self setPreferencesFrom:

	#(	
		(alternativeScrollbarLook false)
		(alternativeWindowLook false)
		(annotationPanes false)
		(autoAccessors false)
		(balloonHelpEnabled false)
		(balloonHelpInMessageLists false)
		(batchPenTrails noOpinion)
		(browseWithDragNDrop false)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(caseSensitiveFinds true)
		(checkForSlips false)
		(classicNavigatorEnabled false)
		(clickOnLabelToEdit true)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(diffsInChangeList false)
		(diffsWithPrettyPrint false)
		(dragNDropWithAnimation false)
		(eToyFriendly false)
		(fastDragWindowForMorphic true)
		(fenceEnabled noOpinion)
		(honorDesktopCmdKeys false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(menuColorFromWorld false)
		(menuKeyboardControl false)  
		(mouseOverForKeyboardFocus true)
		(mvcProjectsAllowed true)
		(noviceMode false)
		(okToReinitializeFlaps true)
		(optionalButtons false)
		(personalizedWorldMenu false)
		(projectViewsInWindows true)
		(projectZoom true)
		(restartAlsoProceeds false)
		(roundedMenuCorners false)
		(roundedWindowCorners false)
		(scrollBarsNarrow false)
		(scrollBarsOnRight false)
		(scrollBarsWithoutMenuButton false)
		(securityChecksEnabled noOpinion)
		(showProjectNavigator false)
		(showSharedFlaps false)
		(simpleMenus false)
		(smartUpdating false)
		(thoroughSenders false)
		(timeStampsInMenuTitles false)).

	self installUniformWindowColors! !


!ProcessBrowser methodsFor: 'accessing' stamp: 'eem 6/12/2008 12:41'!
stackListIndex: index 
	stackListIndex := index.
	selectedContext := (stackList notNil
						and: [index > 0]) ifTrue:
							[stackList at: index ifAbsent: []].
	selectedClass := nil.
	selectedSelector := nil.
	methodText := nil.
	self changed: #stackListIndex.
	self changed: #selectedMethod! !

!ProcessBrowser methodsFor: 'stack list' stamp: 'eem 6/12/2008 12:44'!
pcRange
	"Answer the indices in the source code for the method corresponding to  
	the selected context's program counter value."
	(selectedContext isNil or: [methodText isEmptyOrNil])
		ifTrue: [^ 1 to: 0].
	^selectedContext debuggerMap
		rangeForPC: (selectedContext pc ifNotNil: [:pc| pc] ifNil: [selectedContext method endPC])
		contextIsActiveContext: stackListIndex = 1! !


!ReturnNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:18'!
printOn: aStream indent: level

	aStream nextPutAll: '^ '. "make this a preference??"
	expr printOn: aStream indent: level.
	expr printCommentOn: aStream indent: level! !


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


!Parser methodsFor: 'public access' stamp: 'ar 9/27/2005 19:19'!
parse: sourceStream class: class noPattern: noPattern context: ctxt notifying: req ifFail: aBlock 
	^self parse: sourceStream class: class category: nil noPattern: noPattern context: ctxt notifying: req ifFail: aBlock ! !

!Parser methodsFor: 'public access' stamp: 'eem 5/6/2008 13:42'!
parseArgsAndTemps: aString notifying: req 
        "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: [^#()].
        doitFlag := false.               "Don't really know if a doit or not!!"
        ^self initPattern: aString
                notifying: req
                return: [:pattern | (pattern at: 2) , (self temporariesIn: (pattern at: 1))]! !

!Parser methodsFor: 'error correction' stamp: 'eem 6/23/2008 10:42'!
removeUnusedTemps
	"Scan for unused temp names, and prompt the user about the prospect of removing each one found"

	| str end start madeChanges | 
	madeChanges := false.
	str := requestor text string.
	((tempsMark between: 1 and: str size)
		and: [(str at: tempsMark) = $|]) ifFalse: [^ self].
	encoder unusedTempNames do:
		[:temp |
		(UIManager default chooseFrom: #('yes' 'no') title:
			((temp , ' appears to be\unused in this method.\OK to remove it?' withCRs) asText makeBoldFrom: 1 to: temp size))
			= 1
		ifTrue:
		[(encoder encodeVariable: temp) isUndefTemp
			ifTrue:
			[end := tempsMark.
			["Beginning at right temp marker..."
			start := end - temp size + 1.
			end < temp size or: [temp = (str copyFrom: start to: end)
					and: [(str at: start-1) isSeparator & (str at: end+1) isSeparator]]]
				whileFalse:
					["Search left for the unused temp"
					end := requestor nextTokenFrom: end direction: -1].
			end < temp size ifFalse:
				[(str at: start-1) = $  ifTrue: [start := start-1].
				requestor correctFrom: start to: end with: ''.
				str := str copyReplaceFrom: start to: end with: ''. 
				madeChanges := true.
				tempsMark := tempsMark - (end-start+1)]]
			ifFalse:
			[self inform:
'You''ll first have to remove the\statement where it''s stored into' withCRs]]].
	madeChanges ifTrue: [ReparseAfterSourceEditing signal]! !

!Parser methodsFor: 'private'!
initPattern: aString notifying: req return: aBlock

	| result |
	self
		init: (ReadStream on: aString asString)
		notifying: req
		failBlock: [^nil].
	encoder := self.
	result := aBlock value: (self pattern: false inContext: nil).
	encoder := failBlock := nil.  "break cycles"
	^result! !


!SelectorNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:50'!
printOn: aStream indent: level 
	aStream nextPutAll: (key == nil
							ifTrue: ['<key==nil>']
							ifFalse: [key])! !


!SyntaxMorph methodsFor: 'menus' stamp: 'eem 5/6/2008 15:19'!
decompile
	"Produce Smalltalk code.  We have a tree of SyntaxMorphs, but not a tree of ParseNodes.  The user has dragged in many SyntaxMorphs, each with its own parseNode, but those nodes are not sewn together in a tree.  The only data we get from a ParseNode is its class.
	We produce really ugly code.  But we compile it and decompile (prettyPrint) again for the user to see."

	^Text streamContents: [:stream| self printOn: stream indent: 1]	"Tree walk and produce text of the code"! !


!TileMessageNode methodsFor: 'printing' stamp: 'eem 5/9/2008 18:56'!
printToDoOn: aMorph indent: level 
	| limitNode |
	limitNode := (arguments last isNil 
				or: [(arguments last isMemberOf: AssignmentNode) not]) 
					ifTrue: [arguments first]
					ifFalse: [arguments last value].
	(selector key = #to:by:do: 
		and: [arguments second isConstantNumber and: [arguments second key == 1]]) 
			ifTrue: 
				[self 
					printKeywords: #to:do:
					arguments: (Array with: limitNode with: (arguments third))
					on: aMorph
					indent: level]
			ifFalse: 
				[self 
					printKeywords: selector key
					arguments: (Array with: limitNode) , arguments allButFirst
					on: aMorph
					indent: level]! !


!VariableNode methodsFor: 'initialize-release' stamp: 'eem 5/14/2008 09:33'!
name: varName index: i type: type
	"Only used for initting instVar refs"
	^self name: varName key: varName index: i type: type! !

!VariableNode methodsFor: 'initialize-release' stamp: 'ar 3/26/2004 15:46'!
name: string key: object code: byte
	"Only used for initting std variables, nil, true, false, self, etc."
	name := string.
	key := object.
	code := byte! !

!VariableNode methodsFor: 'testing' stamp: 'eem 5/14/2008 09:11'!
assignmentCheck: encoder at: location
	^(encoder cantStoreInto: name) ifTrue: [location] ifFalse: [-1]! !

!VariableNode methodsFor: 'testing' stamp: 'ar 3/26/2004 15:46'!
canBeSpecialArgument
	"Can I be an argument of (e.g.) ifTrue:?"

	^code < LdNil! !

!VariableNode methodsFor: 'testing' stamp: 'eem 5/21/2008 11:06'!
index
	"This code attempts to reconstruct the index from its encoding in code."
	code < 0 ifTrue:[^nil].
	code > 256 ifTrue:
		[self assert: index = (code \\ 256).
		^code \\ 256].
	code >= (CodeBases at: self type) ifTrue:
		[self assert: index = (code - (CodeBases at: self type)).
		^code - (CodeBases at: self type)].
	self assert: index = (code - self type).
	^code - self type! !

!VariableNode methodsFor: 'testing' stamp: 'eem 5/14/2008 09:13'!
isSelfPseudoVariable
	"Answer if this ParseNode represents the 'self' pseudo-variable."

	^ key = 'self' or: [name = '{{self}}']! !

!VariableNode methodsFor: 'testing' stamp: 'eem 5/14/2008 09:18'!
type
	"This code attempts to reconstruct the type from its encoding in code.
		This allows one to test, for instance, (aNode type = LdInstType)."
	| type |
	code < 0 ifTrue: [^code negated].
	code >= 256 ifTrue: [^code // 256].
	type := CodeBases findFirst: [:one | code < one].
	^type = 0 ifTrue: [5] ifFalse: [type - 1]! !

!VariableNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:46'!
emitForReturn: stack on: strm

	(code >= LdSelf and: [code <= LdNil])
		ifTrue: 
			["short returns"
			strm nextPut: EndMethod - 4 + (code - LdSelf).
			stack push: 1 "doesnt seem right"]
		ifFalse: 
			[super emitForReturn: stack on: strm]! !

!VariableNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:46'!
emitForValue: stack on: strm

	code < 256
		ifTrue: 
			[strm nextPut: (code = LdSuper ifTrue: [LdSelf] ifFalse: [code]).
			stack push: 1]
		ifFalse: 
			[self emitLong: LoadLong on: strm.
			stack push: 1]! !

!VariableNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:46'!
emitStorePop: stack on: strm
	(code between: 0 and: 7)
		ifTrue: 
			[strm nextPut: ShortStoP + code "short stopop inst"]
		ifFalse:
			[(code between: 16 and: 23)
				ifTrue: [strm nextPut: ShortStoP + 8 + code - 16 "short stopop temp"]
				ifFalse: [(code >= 256 and: [code \\ 256 > 63 and: [code // 256 = 4]])
						ifTrue: [self emitLong: Store on: strm. strm nextPut: Pop]
						ifFalse: [self emitLong: StorePop on: strm]]].
	stack pop: 1! !

!VariableNode methodsFor: 'code generation' stamp: 'eem 5/14/2008 09:20'!
fieldOffset
	"Return temp or instVar offset for this variable"
	^code < 256
		ifTrue: [code \\ 16]
		ifFalse: [code \\ 256]! !

!VariableNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:46'!
sizeForReturn: encoder

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

!VariableNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:46'!
sizeForStore: encoder
	self reserve: encoder.
	code < 256 ifTrue: [^ 2].
	(code \\ 256) <= 63 ifTrue: [^ 2].
	^ 3! !

!VariableNode methodsFor: 'code generation' stamp: 'ar 3/26/2004 15:46'!
sizeForStorePop: encoder
	self reserve: encoder.
	(code < 24 and: [code noMask: 8]) ifTrue: [^ 1].
	code < 256 ifTrue: [^ 2].
	code \\ 256 <= 63 ifTrue: [^ 2].  "extended StorePop"
	code // 256 = 1 ifTrue: [^ 3].  "dbl extended StorePopInst"
	code // 256 = 4 ifTrue: [^ 4].  "dbl extended StoreLitVar , Pop"
	self halt.  "Shouldn't get here"! !

!VariableNode methodsFor: 'printing' stamp: 'eem 5/6/2008 14:37'!
printOn: aStream indent: level 

	aStream nextPutAll: name! !


!TempVariableNode methodsFor: 'initialize-release' stamp: 'eem 5/14/2008 09:51'!
name: varName index: i type: type scope: level
	"Only used for initting temporary variables"
	isAnArg := hasDefs := hasRefs := false.
	scope := level.
	^super name: varName key: varName index: i type: type! !

!TempVariableNode methodsFor: 'testing' stamp: 'eem 5/14/2008 09:11'!
assignmentCheck: encoder at: location
	^isAnArg ifTrue: [location] ifFalse: [-1]! !

!TempVariableNode methodsFor: 'printing' stamp: 'eem 5/8/2008 11:39'!
printOn: aStream indent: level 

	aStream nextPutAll: name! !

TempVariableNode removeSelector: #explanation!
VariableNode removeSelector: #explanation!
Stream removeSelector: #dialect!
Stream removeSelector: #withStyleFor:do:!

!Stream reorganize!
('accessing' basicNext basicNextPut: basicNextPutAll: binary contents flush localName next next: next:put: nextMatchAll: nextMatchFor: nextPut: nextPutAll: openReadOnly printContentsOn: printOn: readOnly upToEnd)
('testing' atEnd closed isStream isTypeHTTP nextWordsPutAll:)
('enumerating' do:)
('printing' print: printHtml:)
('filter streaming' write:)
('as yet unclassified' sleep)
('file open/close' close)
('*monticello' isMessageStream)
('*VRML' asVRMLStream)
('platform' nl print:digits: print:paddedTo:)
!

ReturnNode removeSelector: #explanation!
Preferences class removeSelector: #printAlternateSyntax!
MethodNode removeSelector: #asAltSyntaxText!
MethodNode removeSelector: #generateNative:!
ParseNode subclass: #MethodNode
	instanceVariableNames: 'selectorOrFalse precedence arguments block primitive encoder temporaries properties sourceText'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
LiteralNode removeSelector: #explanation!
BlockNode removeSelector: #arguments:statements:returns:from:sourceRange:!
AssignmentNode removeSelector: #explanation!
ParseNode removeSelector: #explanation!
Metaclass removeSelector: #definitionST80!
Metaclass removeSelector: #definitionST80:!
Compiler class removeSelector: #old!
Compiler removeSelector: #dialectParserClass!
Compiler removeSelector: #parse:in:notifying:dialect:!
CompiledMethod removeSelector: #cacheTempNames:!
CompiledMethod removeSelector: #setTempNamesIfCached:!
ClassDescription removeSelector: #definitionST80!
ClassDescription removeSelector: #definitionST80:!
Smalltalk removeClassNamed: #DialectMethodNode!
Smalltalk removeClassNamed: #DialectParser!
Smalltalk removeClassNamed: #DialectStream!
Smalltalk removeClassNamed: #RequestAlternateSyntaxSetting!
Smalltalk removeClassNamed: #SyntaxAttribute!
"Postscript:
Can't recompile CompiledMethod so have to remove the class var explicitly."
(CompiledMethod classPool includesKey: #TempNameCache) ifTrue:
	[CompiledMethod removeClassVarName: #TempNameCache]!