'From Croquet1.0beta of 11 April 2006 [latest update: #1] on 6 August 2008 at 12:53:02 pm'!
ParseNode subclass: #ConsArrayNode
	instanceVariableNames: 'numElements'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!
ParseNode subclass: #NewArrayNode
	instanceVariableNames: 'numElements'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!

!NewArrayNode commentStamp: '<historical>' prior: 0!
I represent a node for the genPushNewArray: opcode.!
]style[(51)i!

TempVariableNode subclass: #RemoteTempVectorNode
	instanceVariableNames: 'remoteTemps readNode writeNode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Compiler-ParseNodes'!

!RemoteTempVectorNode commentStamp: '<historical>' prior: 0!
I am a node for a vector of remote temps, created to share temps between closures when those temps are written to in closures other than their defining ones.!
]style[(157)i!


!BlockNode methodsFor: 'code generation (closures)' stamp: 'eem 5/19/2008 17:12'!
noteOptimized
	optimized := true! !


!LookupKey methodsFor: 'testing' stamp: 'ar 8/14/2003 01:52'!
isSpecialReadBinding
	"Return true if this variable binding is read protected, e.g., should not be accessed primitively but rather by sending #value messages"
	^false! !


!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']! !


!Parser methodsFor: 'public access' stamp: 'eem 5/14/2008 15:24'!
encoderClass: anEncoderClass
	encoder notNil ifTrue:
		[self error: 'encoder already set'].
	encoder := anEncoderClass new! !


!Object methodsFor: 'testing' stamp: 'eem 5/8/2008 11:13'!
isArray
	^false! !


!Array methodsFor: 'testing' stamp: 'eem 5/8/2008 11:13'!
isArray
	^true! !


!Behavior methodsFor: 'compiling' stamp: 'eem 5/13/2008 09:50'!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	"Nothing to do here; ClassDescription introduces named instance variables"
	^self! !

!Behavior methodsFor: 'compiling' stamp: 'eem 6/19/2008 09:08'!
variablesAndOffsetsDo: aBinaryBlock
	"This is the interface between the compiler and a class's instance or field names.  The
	 class should enumerate aBinaryBlock with the field definitions (with nil offsets) followed
	 by the instance variable name strings and their integer offsets (1-relative).  The order is
	 important; names evaluated later will override the same names occurring earlier."

	"Only need to do instance variables here.  CProtoObject introduces field definitions."
	self instVarNamesAndOffsetsDo: aBinaryBlock! !


!ClassBuilder methodsFor: 'class format' stamp: 'eem 6/13/2008 10:03'!
computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex
	"Compute the new format for making oldClass a subclass of newSuper.
	Return the format or nil if there is any problem."
	| instSize isVar isWords isPointers isWeak |
	type == #compiledMethod
		ifTrue:[^CompiledMethod format].
	instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]).
	instSize > 254 ifTrue:[
		self error: 'Class has too many instance variables (', instSize printString,')'.
		^nil].
	type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true].
	type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false].
	type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false].
	type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false].
	type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true].
	(isPointers not and:[instSize > 0]) ifTrue:[
		self error:'A non-pointer class cannot have instance variables'.
		^nil].
	^(self format: instSize 
		variable: isVar 
		words: isWords 
		pointers: isPointers 
		weak: isWeak) + (ccIndex bitShift: 11).! !

!ClassBuilder methodsFor: 'public' stamp: 'eem 6/13/2008 10:00'!
superclass: aClass
	variableByteSubclass: t instanceVariableNames: f 
	classVariableNames: d poolDictionaries: s category: cat
	"This is the standard initialization message for creating a new class as a 
	subclass of an existing class in which the subclass is to 
	have indexable byte-sized nonpointer variables."
	| oldClassOrNil actualType |
	(aClass instSize > 0)
		ifTrue: [^self error: 'cannot make a byte subclass of a class with named fields'].
	(aClass isVariable and: [aClass isWords])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with word fields'].
	(aClass isVariable and: [aClass isPointers])
		ifTrue: [^self error: 'cannot make a byte subclass of a class with pointer fields'].
	oldClassOrNil := aClass environment at: t ifAbsent:[nil].
	actualType := (oldClassOrNil notNil
				   and: [oldClassOrNil typeOfClass == #compiledMethod])
					ifTrue: [#compiledMethod]
					ifFalse: [#bytes].
	^self 
		name: t
		inEnvironment: aClass environment
		subclassOf: aClass
		type: actualType
		instanceVariableNames: f
		classVariableNames: d
		poolDictionaries: s
		category: cat! !


!ClassDescription methodsFor: 'compiling' stamp: 'eem 5/13/2008 09:48'!
instVarNamesAndOffsetsDo: aBinaryBlock
	"This is part of the interface between the compiler and a class's instance or field names.
	 The class should enumerate aBinaryBlock with the instance variable name strings and
	 their integer offsets.  The order is important. Names evaluated later will override the
	 same names occurring earlier."

	| superInstSize |
	(superInstSize := superclass notNil ifTrue: [superclass instSize] ifFalse: [0]) > 0 ifTrue:
		[superclass instVarNamesAndOffsetsDo: aBinaryBlock].
	1 to: self instSize - superInstSize do:
		[:i| aBinaryBlock value: (instanceVariables at: i) value: i + superInstSize]! !


!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: 'source mapping' stamp: 'eem 6/4/2008 19:21'!
rawSourceRanges

	^self rawSourceRangesAndMethodDo: [:rawSourceRanges :method| rawSourceRanges]! !

!MethodNode methodsFor: 'source mapping' stamp: 'eem 6/20/2008 15:09'!
rawSourceRangesAndMethodDo: aBinaryBlock
	"Evaluate aBinaryBlock with the rawSourceRanges and method generated from the receiver."

	| methNode method |
	methNode := sourceText
					ifNil: "No source, use decompile string as source to map from"
						[self parserClass new
							encoderClass: encoder class;
							parse: self decompileString
							class: self methodClass]
					ifNotNil: [self prepareForRegeneration.
							 self].
	method := methNode generate: #(0 0 0 0).  "set bytecodes to map to"
	^aBinaryBlock
		value: methNode encoder rawSourceRanges
		value: method! !


!Parser methodsFor: 'public access' stamp: 'eem 6/19/2008 09:38'!
encoder
	encoder isNil ifTrue:
		[encoder := Encoder new].
	^encoder! !

!Parser methodsFor: 'expression types' stamp: 'eem 7/16/2008 11:05'!
pattern: fromDoit inContext: ctxt
	" unarySelector | binarySelector arg | keyword arg {keyword arg} =>
	{selector, arguments, precedence}."
	| args selector |
	doitFlag := fromDoit.
	fromDoit ifTrue:
		[^ctxt == nil
			ifTrue: [{#DoIt. {}. 1}]
			ifFalse: [{#DoItIn:. {encoder encodeVariable: encoder doItInContextName}. 3}]].

	hereType == #word ifTrue: [^ {self advance asSymbol. {}. 1}].

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

	hereType == #keyword ifTrue: 
		[selector := WriteStream on: (String new: 32).
		args := OrderedCollection new.
		[hereType == #keyword] whileTrue:[
			selector nextPutAll: self advance.
			args addLast: (encoder bindArg: self argumentName).
		].
		^ {selector contents asSymbol. args. 3}].
	hereType == #positionalMessage ifTrue:[
		args := OrderedCollection new.
		selector := self advance.
		hereType == #rightParenthesis ifTrue:[self advance. ^{(selector,'/0') asSymbol. args. 1}].
		[
			args addLast: (encoder bindArg: self argumentName).
			hereType == #rightParenthesis ifTrue:[
				self advance. 
				selector := (selector,'/', args size printString) asSymbol.
				^{selector. args. 1}].
			here == #, ifFalse:[self expected: 'comma'].
			self advance.
		] repeat.
	].
	^self expected: 'Message pattern'! !

!Parser methodsFor: 'expression types' stamp: 'eem 8/4/2008 10:56'!
statements: argNodes innerBlock: inner blockNode: theBlockNode

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

"Postscript:
Rename MethodContext's receivermap inst var to closureOrNil, avoiding ClassBuilder issues by rudely overwriting the class's appropriate inst var name."
(MethodContext instVarNames at: 2) = 'receiverMap' ifTrue:
	[MethodContext instVarNames at: 2 put: 'closureOrNil']!