'From Cuis 2.6 of 10 August 2010 [latest update: #540] on 28 August 2010 at 10:49:32 pm'!
!classDefinition: #BlockNode category: #'Compiler-ParseNodes'!
ParseNode subclass: #BlockNode
	instanceVariableNames: 'arguments statements returns nArgsNode size remoteCopyNode temporaries optimized optimizedMessageNode actualScopeIfOptimized blockExtent remoteTempNode copiedValues closureCreationNode startOfLastStatement tempsMark '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
!classDefinition: #MethodNode category: #'Compiler-ParseNodes'!
ParseNode subclass: #MethodNode
	instanceVariableNames: 'selectorOrFalse precedence arguments block primitive encoder temporaries properties sourceText localsPool locationCounter '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
!classDefinition: #UndeclaredVariableNode category: #'Compiler-ParseNodes'!
VariableNode subclass: #UndeclaredVariableNode
	instanceVariableNames: 'tag'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
!classDefinition: #VariableScopeFinder category: #'Compiler-Support'!
ParseNodeVisitor subclass: #VariableScopeFinder
	instanceVariableNames: 'theVariable'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-Support'!

!BlockNode methodsFor: 'accessing' stamp: 'eem 8/13/2010 15:44'!
tempsMark
	^tempsMark! !

!BlockNode methodsFor: 'accessing' stamp: 'eem 8/13/2010 15:44'!
tempsMark: anInteger
	tempsMark := anInteger! !


!CodeHolder methodsFor: 'message list' stamp: 'jmv 8/27/2010 18:27'!
validateMessageSource: sourceString forSelector: aSelector inClass: theClass
	"Check whether there is evidence that method source is invalid"

	(theClass parserClass new parseSelector: sourceString asString) = aSelector
		ifFalse: [
			self inform: 'There may be a problem with your sources file!!

The source code for every method should (usually) start with the
method selector but this is not the case with this method!! You may
proceed with caution but it is recommended that you get a new source file.'].! !


!Encoder methodsFor: 'results' stamp: 'eem 8/13/2010 16:51'!
undeclaredTemps 
	^(scopeTable select: [:var | var isVariableNode and: [var isUndeclared]]) values! !

!Encoder methodsFor: 'temps' stamp: 'eem 8/14/2010 19:35'!
newUndeclaredTemp: name
	^UndeclaredVariableNode new name: name! !

!Encoder methodsFor: 'encoding' stamp: 'eem 8/15/2010 08:29'!
lookupVariable: name ifAbsent: aBlock
	"Answer the binding of name in the scope table or aBlock's vaue if none.
	 Do not bind and do not lookup in pools.  Used for correction, explanation etc"
	^scopeTable at: name ifAbsent: aBlock! !

!Encoder methodsFor: 'private' stamp: 'eem 8/13/2010 16:06'!
bindUndeclaredTemp: name
	^scopeTable at: name put: (self newUndeclaredTemp: name)! !


!Exception methodsFor: 'defaults' stamp: 'ar 2/13/2010 15:20'!
defaultResumeValue
	"Answer the value that by default should be returned if the exception is resumed"
	^nil! !


!MessageNode class methodsFor: 'class initialization' stamp: 'eem 8/15/2010 10:22'!
initialize		"MessageNode initialize"
	MacroSelectors := 
		#(	ifTrue: ifFalse: ifTrue:ifFalse: ifFalse:ifTrue:
			and: or:
			whileFalse: whileTrue: whileFalse whileTrue
			to:do: to:by:do:
			caseOf: caseOf:otherwise:
			ifNil: ifNotNil:  ifNil:ifNotNil: ifNotNil:ifNil:).
	MacroTransformers := 
		#(	transformIfTrue: transformIfFalse: transformIfTrueIfFalse: transformIfFalseIfTrue:
			transformAnd: transformOr:
			transformWhile: transformWhile: transformWhile: transformWhile:
			transformToDo: transformToDo:
			transformCase: transformCase:
			transformIfNil: transformIfNil:  transformIfNilIfNotNil: transformIfNotNilIfNil:).
	MacroEmitters := 
		#(	emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
			emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
			emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:
			emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
			emitCodeForWhile:encoder:value: emitCodeForWhile:encoder:value:
			emitCodeForToDo:encoder:value: emitCodeForToDo:encoder:value:
			emitCodeForCase:encoder:value: emitCodeForCase:encoder:value:
			emitCodeForIfNil:encoder:value: emitCodeForIfNil:encoder:value:
			emitCodeForIf:encoder:value: emitCodeForIf:encoder:value:).
	MacroSizers := 
		#(	sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value: sizeCodeForIf:value:
			sizeCodeForIf:value: sizeCodeForIf:value:
			sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value: sizeCodeForWhile:value:
			sizeCodeForToDo:value: sizeCodeForToDo:value:
			sizeCodeForCase:value: sizeCodeForCase:value:
			sizeCodeForIfNil:value: sizeCodeForIfNil:value: sizeCodeForIf:value: sizeCodeForIf:value:).
	MacroPrinters := 
		#(	printIfOn:indent: printIfOn:indent: printIfOn:indent: printIfOn:indent:
			printIfOn:indent: printIfOn:indent:
			printWhileOn:indent: printWhileOn:indent: printWhileOn:indent: printWhileOn:indent:
			printToDoOn:indent: printToDoOn:indent:
			printCaseOn:indent: printCaseOn:indent:
			printIfNil:indent: printIfNil:indent: printIfNilNotNil:indent: printIfNilNotNil:indent:)! !


!MethodNode methodsFor: 'code generation' stamp: 'jmv 8/28/2010 10:04'!
generateWithTempNames
	"Should adopt at least a reduced version of method trailers it seems...
	Otherwise, perhaps, decide not to store any trail... Consequences?"
	^ self generate copyWithTempsFromMethodNode: self.! !

!MethodNode methodsFor: 'debugger support' stamp: 'Igor.Stasenko 12/20/2009 03:59'!
blockExtentsToTempsMap
	"Answer a Dictionary of blockExtent to temp locations for the current method.
	 This is used by the debugger to locate temp vars in contexts.  A temp map
	 entry is a pair of the temp's name and its index, where an index is either an
	 integer for a normal temp or a pair of the index of the indirect temp vector
	 containing  the temp and the index of the temp in its indirect temp vector."

	^encoder blockExtentsToTempsMap ifNil:
		[| methNode |
		methNode := encoder classEncoding parserClass new
						encoderClass: encoder class;
						parse: (sourceText ifNil: [self decompileString])
						class: self methodClass.
		"As a side effect generate: creates data needed for the map."
		methNode generate.
		methNode encoder blockExtentsToTempsMap]! !

!MethodNode methodsFor: 'debugger support' stamp: 'eem 7/1/2009 13:45'!
hasGeneratedMethod
	^encoder hasGeneratedMethod! !

!MethodNode methodsFor: 'debugger support' stamp: 'Igor.Stasenko 12/20/2009 03:58'!
schematicTempNamesString
	"Answer the temp names for the current method node in a form that captures
	 temp structure.  The temps at each method and block scope level occur
	 space-separated, with any indirect temps enclosed in parentheses.  Each block
	 level is enclosed in square brackets.  e.g.
		'method level temps (indirect temp)[block args and temps (indirect)]'
	 This representation can be reconstituted into a blockExtentsToTempsMap
	 by a CompiledMethod that has been copied with the schematicTempNamesString."
	encoder hasGeneratedMethod ifFalse:
		["create the encoder's blockExtentsToLoals map, except if the method is quick
		  in which case it has no temps."
		(self generate) isQuick ifTrue:
			[^'']].
	^encoder schematicTempNamesString! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 5/29/2008 15:27'!
addLocalsToPool: locals "<Set of: TempVariableNode>"
	localsPool isNil ifTrue:
		[localsPool := IdentitySet new].
	localsPool addAll: locals! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 7/24/2008 10:04'!
ensureClosureAnalysisDone
	block blockExtent ifNil:
		[temporaries := block analyseArguments: arguments temporaries: temporaries rootNode: self]! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 5/20/2008 13:43'!
locationCounter
	^locationCounter! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 5/30/2008 11:27'!
noteBlockEntry: aBlock
	"Evaluate aBlock with the numbering for the block entry."
	locationCounter isNil ifTrue:
		[locationCounter := -1].
	aBlock value: locationCounter + 1.
	locationCounter := locationCounter + 2! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 6/2/2008 12:12'!
noteBlockExit: aBlock
	"Evaluate aBlock with the numbering for the block exit."
	aBlock value: locationCounter + 1.
	locationCounter := locationCounter + 2! !

!MethodNode methodsFor: 'code generation (closures)' stamp: 'eem 5/29/2008 16:07'!
referencedValuesWithinBlockExtent: anInterval 
	^(localsPool select:
		[:temp|
		 temp isReferencedWithinBlockExtent: anInterval]) collect:
			[:temp|
			temp isRemote ifTrue: [temp remoteNode] ifFalse: [temp]]! !


!ParseNodeVisitor methodsFor: 'visiting' stamp: 'eem 8/13/2010 16:50'!
visitUndeclaredVariableNode: aVariableNode! !


!Scanner methodsFor: 'error handling' stamp: 'nice 2/25/2010 02:56'!
notify: string at: posiiton
	"Parser compatible message"
	 
	^self notify: string ! !


!Parser methodsFor: 'error correction' stamp: 'eem 8/17/2010 16:35'!
declareTemp: name at: levelTag
	"Defer declaring the temp until the parse has completed.  This allows
	 the parser to declare the temp in the minimum enclosing block instead
	 of always at method level.  See Parser>>declareUndeclaredTemps:"
	^(encoder bindUndeclaredTemp: name)
		tag: levelTag;
		yourself! !

!Parser methodsFor: 'error correction' stamp: 'eem 8/17/2010 16:37'!
declareUndeclaredTemps: methodNode
	"Declare any undeclared temps, declaring them at the smallest enclosing scope."

	| undeclared userSelection blocksToVars |
	(undeclared := encoder undeclaredTemps) isEmpty ifTrue:
		[^self].
	userSelection := requestor selectionInterval.
	blocksToVars := IdentityDictionary new.
	undeclared do:
		[:var|
		(blocksToVars
			at: (var tag == #method
					ifTrue: [methodNode block]
					ifFalse: [methodNode accept: (VariableScopeFinder new ofVariable: var)])
			ifAbsentPut: [SortedCollection new]) add: var name].
	(blocksToVars removeKey: methodNode block ifAbsent: []) ifNotNil:
		[:rootVars|
		rootVars do: [:varName| self pasteTempAtMethodLevel: varName]].
	(blocksToVars keys sorted: [:a :b| a tempsMark < b tempsMark]) do:
		[:block| | decl |
		decl := (blocksToVars at: block) reduce: [:a :b| a, ' ', b].
		block temporaries isEmpty
			ifTrue:
				[self substituteWord: ' | ', decl, ' |'
					wordInterval: (block tempsMark + 1 to: block tempsMark)
					offset: requestorOffset]
			ifFalse:
				[self substituteWord: decl, ' '
					wordInterval: (block tempsMark to: block tempsMark - 1)
					offset: requestorOffset]].
	requestor selectInvisiblyFrom: userSelection first to: userSelection last + requestorOffset.
	ReparseAfterSourceEditing signal! !

!Parser methodsFor: 'error correction' stamp: 'eem 8/13/2010 19:34'!
pasteTempAtMethodLevel: name
	| insertion delta theTextString characterBeforeMark |

	theTextString := requestor text string.
	characterBeforeMark := theTextString at: tempsMark-1 ifAbsent: [$ ].
	(theTextString at: tempsMark) = $| ifTrue: [
  		"Paste it before the second vertical bar"
		insertion := name, ' '.
		characterBeforeMark isSeparator ifFalse: [insertion := ' ', insertion].
		delta := 0.
	] ifFalse: [
		"No bars - insert some with CR, tab"
		insertion := '| ' , name , ' |',String cr.
		delta := 2.	"the bar and CR"
		characterBeforeMark = Character tab ifTrue: [
			insertion := insertion , String tab.
			delta := delta + 1.	"the tab"
		].
	].
	tempsMark := tempsMark +
		(self substituteWord: insertion
			wordInterval: (tempsMark to: tempsMark-1)
			offset: 0) - delta! !


!SystemDictionary methodsFor: 'browsing' stamp: 'dtl 8/1/2010 10:12'!
browseMyChanges
	"Browse only the changes (in the changes file) by the current author.
	Smalltalk browseMyChanges
	"
	self browseAllSelect: [ :method |
       method fileIndex > 1 "only look at changes file"
               and: [ method timeStamp beginsWith: Utilities authorInitials ]]! !

!SystemDictionary methodsFor: 'system attributes' stamp: 'eem 7/22/2010 17:44'!
flagInterpretedMethods: aBoolean
	"The Cog VM can be instructed to set the flag bit of CompiledMethods that
	 it executes but will only interpret.  This can be used e.g. to profile startup.
	 See CompiledMethod>>#flag & CompiledMethod>>#clearFlag.  
	 This flag persists across snapshots, stored in the image header."

	self vmParameterAt: 48 put: ((self vmParameterAt: 48) bitClear: 2) + (aBoolean ifTrue: [2] ifFalse: [0])! !

!SystemDictionary methodsFor: 'system attributes' stamp: 'eem 7/22/2010 17:23'!
processHasThreadIdInstVar: aBoolean
	"The threaded VM needs to know if the 4th inst var of Process
	 is threadId which it uses to control process-to-thread binding.
	 This flag persists across snapshots, stored in the image header."
	aBoolean ifTrue: [self assert: (Process instVarNames at: 4) ='threadId'].
	self vmParameterAt: 48 put: ((self vmParameterAt: 48) bitClear: 1) + (aBoolean ifTrue: [1] ifFalse: [0])! !

!SystemDictionary methodsFor: 'system attributes' stamp: 'eem 7/22/2010 17:51'!
processPreemptionYields
	"Answer whether the VM causes a process to yield on process preemption,
	 i.e. to put a preempted process at the back of its run queue.  If the parameter
	 is unavailable (non-Cog VMs) or bit 2 (4) is 0 then preemption yields."

	^(([self vmParameterAt: 48]
			on: Error
			do: [:ex| ^true]) allMask: 4) not! !

!SystemDictionary methodsFor: 'system attributes' stamp: 'eem 7/22/2010 17:26'!
processPreemptionYields: aBoolean
	"The Cog VM can be instructed not to yield on process preemption,
	 i.e. not to put a preempted process at the back of its run queue.  By
	 default preempting a process causes it to yield (Blue Book semantics)
	 which can have unfortunate effects.
	 This flag persists across snapshots, stored in the image header."

	self vmParameterAt: 48 put: ((self vmParameterAt: 48) bitClear: 4) + (aBoolean ifTrue: [0] ifFalse: [4])! !


!UndeclaredVariableWarning methodsFor: 'initialize-release' stamp: 'ar 2/13/2010 15:21'!
defaultResumeValue
	"Answer the value that by default should be returned if the exception is resumed"
	^true! !


!VariableNode methodsFor: 'testing' stamp: 'eem 8/13/2010 15:34'!
isUndeclared
	^false! !


!TempVariableNode methodsFor: 'testing' stamp: 'eem 8/14/2010 11:02'!
isDeclaredAtMethodLevel
	"For the explainer."
	^scope = 0! !

!classDefinition: #MethodNode category: #'Compiler-ParseNodes'!
ParseNode subclass: #MethodNode
	instanceVariableNames: 'selectorOrFalse precedence arguments block primitive encoder temporaries properties sourceText locationCounter localsPool'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
MessageNode initialize!
!classDefinition: #BlockNode category: #'Compiler-ParseNodes'!
ParseNode subclass: #BlockNode
	instanceVariableNames: 'arguments statements returns nArgsNode size remoteCopyNode temporaries optimized optimizedMessageNode actualScopeIfOptimized blockExtent remoteTempNode copiedValues closureCreationNode startOfLastStatement tempsMark'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
"Postscript:
Leave the line above, and replace the rest of this comment by a useful one.
Executable statements should follow this comment, and should
be separated by periods, with no exclamation points (!!).
Be sure to put any further comments in double-quotes, like this one."
MessageNode initialize!

