'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 21 January 2006 at 1:55:02 am'!
Object subclass: #Apple
	instanceVariableNames: 'one two three'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!
WriteStream subclass: #CinnabarCodeStream
	instanceVariableNames: 'depth'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarCodeStream commentStamp: '<historical>' prior: 0!
CinnabarCodeStream is a WriteStream buffer for writing C++ code for Cinnabar with nice indentation.

Use #write: to append a line.  If the line ends in '{' or '}' then the indentation will be adjusted
accordingly.

The #saveToUnixFile: method will convert squeak CR to unix LF line terminators.
!

Object subclass: #CinnabarFirstPass
	instanceVariableNames: 'blockParents blockStack method class blockIsFlat specialFlatCases captures generator selfIsCaptured'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!
Object subclass: #CinnabarGenClasses
	instanceVariableNames: 'done headerCode instanceCode initCode'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarGenClasses commentStamp: '<historical>' prior: 0!
CinnabarGenClasses translates Smalltalk classes into C++ header files, to run on the Cinnabar Virtual Machine.

(CinnabarGenMethods translates the method definitions)

 !

Smalltalk renameClassNamed: #CinnabarGen as: #CinnabarGenMethods!
Object subclass: #CinnabarGenMethods
	instanceVariableNames: 'methodNum stMethodsToCbar nextSerialNumber declarations initializations body specialCases firstPass blockStack method contextStack saveStack theClass captureStack'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarGenMethods commentStamp: '<historical>' prior: 0!
CinnabarGenMethods translates Smalltalk methods into C++ code, to run on the Cinnabar Virtual Machine.

(CinnabarGenClasses translates the class definitions)

 !

Smalltalk renameClassNamed: #Fib2Test as: #CinnabarUnitTests!
TestCase subclass: #CinnabarUnitTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!
Object subclass: #ClassHacks
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!ClassHacks commentStamp: 'strick 1/20/2006 19:14' prior: 0!
Cinnabar ClassHacks is just a testbed.  The class is not needed.
!

Object subclass: #Fib
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!Apple methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 21:24'!
alter2468

	"
 self new alter2468 
 self new return2468
"

	| x | 
	x := self return2468.
	x at: 2 put: #bogus.
	x := self return2468.
	^x! !

!Apple methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 21:28'!
return2468
	^ #(2 4 6 8)   ! !

!Apple methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 19:51'!
returnSmalltalk
	^ Smalltalk! !

!Apple methodsFor: 'as yet unclassified' stamp: 'strick 11/25/2005 07:49'!
returnSomething
	^42! !

!Apple methodsFor: 'as yet unclassified' stamp: 'strick 11/25/2005 07:49'!
returnSomethingElse
	^69! !

!Apple methodsFor: 'as yet unclassified' stamp: 'strick 12/25/2005 20:42'!
ttest

	"(self returnSomething = 42) ifTrue: [
		(self returnSomethingElse = 69) ifTrue: [
			(self varStoreReturn = 42) ifTrue: [ ^true].
		].
	]."

	"^false"

	"self alter2468."

	-999999 < 999999 ifTrue: [
		'Apple test is good' say.
		"self error: 'try throwing this error!!!!!!'."
		^true
	].

	^ false! !

!Apple methodsFor: 'as yet unclassified' stamp: 'strick 12/9/2005 16:11'!
varStoreReturn
	| someVar |

	someVar _ 42.
	^someVar.! !


!ByteSymbol methodsFor: 'converting' stamp: 'strick 12/23/2005 06:38'!
acceptVisitor: aVisitor

	^aVisitor visitByteSymbol: self! !


!CinnabarCodeStream methodsFor: 'as yet unclassified' stamp: 'strick 12/18/2005 10:29'!
contentsForUnix
	^ self contents
		copyReplaceAll: String cr
		with: String lf
		asTokens: false
! !

!CinnabarCodeStream methodsFor: 'as yet unclassified' stamp: 'Ryan 12/13/2005 11:55'!
initialize

	depth := 0.! !

!CinnabarCodeStream methodsFor: 'as yet unclassified' stamp: 'strick 12/19/2005 21:15'!
saveToUnixFile: filename 
	| fileStream |
	fileStream := StandardFileStream forceNewFileNamed: filename.
	[fileStream nextPutAll: "self contents"
	self contentsForUnix]
		ensure: [fileStream close]! !

!CinnabarCodeStream methodsFor: 'as yet unclassified' stamp: 'strick 12/19/2005 21:13'!
write: aString 
	"a Pretty-Writer for generating C code -- writes one line. 
	* The last character in the string can be ${ or $} to guide nesting.
	"
	"set tail to last char, or to something bogus like $ if empty"
	| n tail |
	n := aString size.
	n > 0
		ifTrue: [tail := aString at: n]
		ifFalse: [tail := $$].
	$} = tail
		ifTrue: [depth := depth - 1].
	""
	self assert: depth >= 0.
	""
	1
		to: depth
		do: [:i | self nextPutAll: '    '].
	self nextPutAll: aString;
		 nextPut: Character lf.
	${ = tail
		ifTrue: [depth := depth + 1]! !


!CinnabarCodeStream class methodsFor: 'as yet unclassified' stamp: 'strick 12/16/2005 00:50'!
new

	^ (CinnabarCodeStream with: String new) initialize.! !


!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 16:56'!
howManyArgsForSelector: aString 
	^ aString first isAlphaNumeric
		ifTrue: [aString
				inject: 0
				into: [:z :c | c = $:
						ifTrue: [z + 1]
						ifFalse: [z]]]
		ifFalse: ["binary operators have one receiver and 1 argumnet"
			1]! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 1/1/2006 17:50'!
initialize
	blockParents := Dictionary new.
	blockStack := OrderedCollection new.
	blockIsFlat := Dictionary new.
	"captures : aScope -> aDictionary : aString -> true"
	captures := IdentityDictionary new.
	specialFlatCases := Set new.
	specialFlatCases add: #ifTrue:;
		 add: #ifFalse:;
		 add: #ifNil:;
		 add: #ifNotNil:;
		 add: #ifTrue:ifFalse:;
		 add: #ifFalse:ifTrue:;
		 add: #ifNil:ifNotNil:;
		 add: #ifNotNil:ifNil:;
		 add: #to:by:do:;
		 add: #to:do:! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 16:49'!
rememberCapturedVariable: aString inScope: aScope 
	"what's the standard, normal way of implementing a double-dictionary?"
	| d |
	"Transcript cr show: '// rememberCapturedVariable: ' , aString , ' inScope: ' , aScope asString."
	self
		assert: (aString class == ByteString
				or: [aString class == ByteSymbol]).
	d := captures
				at: aScope
				ifAbsent: [captures at: aScope put: Dictionary new.
					captures at: aScope].
	d at: aString put: true! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 16:48'!
testCapturedVariable: aString inScope: aScope 
	| d |
	"Transcript cr show: '// testCapturedVariable: ' , aString , ' inScope: ' , aScope asString."
	d := captures
				at: aScope
				ifAbsent: [^ false].
	^ d
		at: aString
		ifAbsent: [^ false]! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 14:35'!
visitAssignmentNode: anAssignmentNode 
	anAssignmentNode variable acceptVisitor: self.
	anAssignmentNode value acceptVisitor: self! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 19:59'!
visitBlockNode: aBlockNode 


	| shouldBeTheBlockNode |

	"is this Flat? We should put this in visitMessageNode"
	"blockIsFlat at: aBlockNode put: false."

	"remember this node's parent"
	blockParents at: aBlockNode put: (
		blockStack size > 0 ifTrue: [blockStack last] 
	).

	"push the blockNode & recurse "
	blockStack addLast: (blockStack size == 0 ifTrue: [method] ifFalse: [aBlockNode]).

	aBlockNode statements do: [ :aNode | 
		aNode acceptVisitor: self
	].

	"pop ourself back off "
	shouldBeTheBlockNode := blockStack removeLast.

	blockStack size == 0 ifTrue: [
		self assert: (shouldBeTheBlockNode==method) .
	] ifFalse: [
		self assert: (shouldBeTheBlockNode==aBlockNode) .
	]

! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 17:06'!
visitBraceNode: aBraceNode 
	aBraceNode elements
		do: [:aNode | aNode acceptVisitor: self]! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 02:32'!
visitCascadeNode: aCascadeNode 


	aCascadeNode messages
		do: [:m | "
			--- Create a temporary MessageNode, so we can set its receiver
			correctly. Necessary because the receiver in the Cascade's
			MessageNodes is nil.
			The result of the last message in the cascade is our result. ---
			"
			self visitMessageNode: (MessageNode new 
							receiver: aCascadeNode receiver;
							 selector: m selector;
							 arguments: m arguments)].! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 02:35'!
visitLiteralNode: aLiteralNode 

	nil.! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 02:45'!
visitLiteralVariableNode: aLiteralVariableNode 

	nil.! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 18:06'!
visitMessageNode: aMessageNode 
	| selector |
	selector := aMessageNode selector.
	"Usually selector is SelectorNode, but occasionally is just a ByteSymbol."
	selector class == SelectorNode
		ifTrue: ["convert Node to Symbol"
			selector := selector key].
	"are any args a block to be flattened? only for specialFlatCases."
	(specialFlatCases includes: selector)
		ifTrue: [aMessageNode arguments
				do: [:arg | arg class == BlockNode
						ifTrue: [
							blockIsFlat at: arg put: true]]].
	aMessageNode receiver acceptVisitor: self.
	1
		to: (self howManyArgsForSelector: selector)
		do: [:i | 
			| node | 
			node := aMessageNode arguments at: i.
			node
				ifNotNil: [node acceptVisitor: self]]! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 18:01'!
visitMethodNode: aMethodNode forClass: aClass for: aGen 

	"generator needed for serial"
	generator := aGen.
	method := aMethodNode.
	class := aClass.
	aMethodNode block acceptVisitor: self! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 02:33'!
visitParseNode: aParseNode

	self error: 'FirstPass: Visiting unimplemented node type ', aParseNode asString
! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 02:30'!
visitReturnNode: aReturnNode

	aReturnNode expr acceptVisitor: self
! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 1/1/2006 16:35'!
visitTempVariableNode: v 
	blockStack size
		to: 1
		by: -1
		do: [:i | 
			| b | 
			b := blockStack at: i.
			b arguments
				do: [:arg | arg name = v name
						ifTrue: [^ self]].
			b temporaries
				ifNotNil: [b temporaries
						do: [:arg | arg name = v name
								ifTrue: [^ self]]].
			(blockIsFlat keys includes: b)
				ifFalse: ["We did not find it in the bottom scope or any flat scopes
					that merge with it -- so we now continue climbing up
					into separate scopes looking for the scope in which to
					mark the variable as captured."
					i - 1
						to: 1
						by: -1
						do: [:ii | 
							| bb | 
							"use ii and bb in this inner loop. This inner loop
							will not return back to the outer loop -- it will
							remember the capture, and answer self."
							bb := blockStack at: ii.
							bb arguments
								do: [:arg | arg name = v name
										ifTrue: [self rememberCapturedVariable: v name inScope: bb.
											^ self]].
							bb temporaries
								ifNotNil: [bb temporaries
										do: [:arg | arg name = v name
												ifTrue: [self rememberCapturedVariable: v name inScope: bb.
													^ self]]].
							blockIsFlat keys includes: bb].
					self assert: nil == 'Should not be reached']].! !

!CinnabarFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 1/1/2006 17:50'!
visitVariableNode: aVariableNode 

	nil.! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 1/2/2006 18:18'!
blockIsFlat: anObject

	^ blockIsFlat at: anObject ifAbsent: [^false]! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 03:19'!
blockParents
	"Answer the value of blockParents"

	^ blockParents! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 03:19'!
blockParents: anObject
	"Set the value of blockParents"

	blockParents _ anObject! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 03:19'!
blockStack
	"Answer the value of blockStack"

	^ blockStack! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 03:19'!
blockStack: anObject
	"Set the value of blockStack"

	blockStack _ anObject! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 20:26'!
class: anObject
	"Set the value of class"

	class _ anObject! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 03:19'!
method
	"Answer the value of method"

	^ method! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 03:19'!
method: anObject
	"Set the value of method"

	method _ anObject! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 20:26'!
specialFlatCases
	"Answer the value of specialFlatCases"

	^ specialFlatCases! !

!CinnabarFirstPass methodsFor: 'accessing' stamp: 'strick 12/29/2005 20:26'!
specialFlatCases: anObject
	"Set the value of specialFlatCases"

	specialFlatCases _ anObject! !


!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/19/2005 20:45'!
addCategoryAndSubclasses: aCategoryName 
	(SystemOrganization listAtCategoryNamed: aCategoryName)
		do: [:eachClass | self addClassAndSubclasses: (Smalltalk at: eachClass)]! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/19/2005 20:51'!
addCategoryMatchAndSubclasses: aCategoryPattern

	SystemOrganization categories 
		select: [ :eachCategory | aCategoryPattern match: eachCategory ]
		thenDo: [ :selectedCategory |


	(SystemOrganization listAtCategoryNamed: selectedCategory)
		do: [:eachClass | self
				addClassAndSubclasses: (Smalltalk at: eachClass)]
]! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/19/2005 21:03'!
addCategoryPattern: aCategoryPattern 
	SystemOrganization categories
		select: [:eachCategory | aCategoryPattern match: eachCategory]
		thenDo: [:selectedCategory | (SystemOrganization listAtCategoryNamed: selectedCategory)
				do: [:eachClass | self
						addClass: (Smalltalk at: eachClass)]]! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/18/2005 11:14'!
addClassAndSubclasses: aClass 
	self addClass: aClass.
	aClass subclasses do: [ :sub | self addClassAndSubclasses: sub ]
! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 07:43'!
addClass: aClass 
	"
	self new run 
	"
	"*** quick recursion stopper ***"
	| superC className superClassName clsObjName n typeObjName |
	(done includes: aClass)
		ifTrue: [^ self].
	"
	*** recurse for superclasses ***
	"
	className := self translateSpacesToDollars: aClass name.
	superC := aClass superclass.
	superC
		ifNil: [superClassName := 'Header']
		ifNotNil: [superClassName := 'C_'
						, (self translateSpacesToDollars: superC name).
			self addClass: superC].
	"*** another recursion stopper (because supers have metas) ***"
	(done includes: aClass)
		ifTrue: [^ self].
	"*** about to emit aClass, so mark it done. ***"
	done add: aClass.
	"
	*** struct defintion ***
	"
	n := done size asString.
	headerCode write: '#define   C_' , className , '_TypeIndex    ' , n.
	headerCode write: 'struct C_' , className , ' : public ' , superClassName , ' /*' , aClass kindOfSubclass , '*/ {'.
	(aClass instanceVariablesString findTokens: ' ')
		do: [:var | headerCode write: 'oop  f_' , var , ';'].
	headerCode write: '/*' , aClass instSize asString , '*/ }'.
	headerCode write: ';'.
	"curious"
	(('*$class' match: className)
			and: [11 ~= aClass instSize])
		ifTrue: [headerCode write: '/*EXTRA CLASS VAR NAMES: ' , aClass instVarNames asString , '*/'].
	""
	clsObjName := 'C_' , className , '_ClsObj'.
	typeObjName := 'C_' , className , '_TypeObj'.
	headerCode write: 'extern C_Class ' , clsObjName , ';'.
	headerCode write: 'extern Type ' , typeObjName , ';'.
	"
	*** instance object ***
	"
	instanceCode write: 'C_Class ' , clsObjName , ';'.
	instanceCode write: 'Type ' , typeObjName , ';'.
	"
	*** initialization code ***
	"
	initCode write: 'TypeTable[' , n , ']= & ' , typeObjName , ';'.
	initCode write: ''.
	"following is WRONG -- TODO make a TypeIndex for Type"
	initCode write: typeObjName , '.setType( Type_TypeIndex );'.
	initCode write: typeObjName , '.setFlags( Header::ETERNAL | Header::SHARED );'.
	initCode write: typeObjName , '.setHash( ' , n , ' );'.
	initCode write: typeObjName , '.typeTableIndex = ' , n , ';'.
	initCode write: typeObjName , '.name = "' , className , '";'.
	initCode write: typeObjName , '.superType = & ' , superClassName , '_TypeObj ;'.
	initCode write: typeObjName , '.thisClass = & ' , clsObjName , ';'.
	aClass isBits
		ifTrue: [initCode write: typeObjName , '.instanceFlags  |=  Header::BITS ;'].
	aClass isBytes
		ifTrue: [initCode write: typeObjName , '.instanceFlags  |=  Header::BYTES ;'].
	aClass isVariable
		ifTrue: [initCode write: typeObjName , '.instanceFlags  |=  Header::INDEXED ;'.
			self assert: aClass instSize < 8.
			aClass instSize > 0
				ifTrue: [initCode write: typeObjName , '.instanceFlags  |=  Header::FIXED_8 ;']].
	initCode write: typeObjName , '.fixedSize = ' , aClass instSize asString , ';'.
	"initCode write: '// ' , aClass allInstVarNames asString."
	initCode write: ''.
	initCode write: clsObjName , '.setType( C_Class_TypeIndex );'.
	initCode write: clsObjName , '.setFlags( Header::ETERNAL | Header::SHARED );'.
	initCode write: clsObjName , '.setHash( ' , n , ' );'.
	"we use the unused 'category' field to point back to the Type."
	initCode write: clsObjName , '.f_category = OopFromHeader( & ' , typeObjName , ');'.
	initCode write: ''.
	initCode write: ''.
	initCode write: ''.
	"
	*** recurse for aClass's class ***
	"
	self addClass: aClass class! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/18/2005 09:52'!
contents
	^ headerCode contents, '

', instanceCode contents, '

', initCode contents.! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/25/2005 20:12'!
initialize
	done := Set new.
	done add: #num.
	done add: #type.
	done add: #func.
	done add: #symbol.
	headerCode := CinnabarCodeStream new.
	instanceCode := CinnabarCodeStream new.
	initCode := CinnabarCodeStream new! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 1/21/2006 01:04'!
run
	"
	CinnabarGenClasses new run.
	"
	self addCategoryPattern: 'Kernel-*';
		 addCategoryPattern: 'Collections-*';
		 addCategoryPattern: 'Multilingual-Encodings';
		 addCategoryPattern: 'Multilingual-Languages';
		 saveGeneratedFiles.
	CinnabarGenMethods new generateCbar: Apple toFileName: 'Apple.cc'.
	CinnabarGenMethods new generateCbar: Fib toFileName: 'Fib.cc'! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/21/2005 01:42'!
saveGeneratedFiles
	initCode write: 'TypeTableNext=' , (done size + 1) asString, ';'.
	headerCode saveToUnixFile: '_gen_header.h'.
	instanceCode saveToUnixFile: '_gen_objects.h'.
	initCode saveToUnixFile: '_gen_inits.h'! !

!CinnabarGenClasses methodsFor: 'as yet unclassified' stamp: 'strick 12/18/2005 17:57'!
translateSpacesToDollars: aString 
	"self new translateSpacesToDollars: 'Some class'"
	^ aString
		copyReplaceAll: ' '
		with: '$'
		asTokens: false! !


!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 18:32'!
enterScope: aScope 
	"aScope is a BlockNode or a MethodNode (at the top level)"
	"***get the name of the previous context from the contextStack. 000
	means none."
	| captures vars n argNames lastN |
	contextStack size > 0
		ifTrue: [lastN := contextStack last]
		ifFalse: [lastN := '000'].
	"***"
	body write: '// LastN=' , lastN , ' ... Entering Scope:'.
	self comment: aScope.
	"*** Look at args & temp vars"
	argNames := aScope arguments
				collect: [:a | a name].
	blockStack addLast: aScope.
	vars := aScope arguments union: aScope temporaries.
	captures := vars
				select: [:t | firstPass testCapturedVariable: t name inScope: aScope].
	captureStack
		addLast: (captures
				collect: [:t | t name]).
	self comment: 'captureStack: ' , captureStack asString.
	self comment: 'contextStack: ' , contextStack asString.
	self comment: 'blockStack: ' , blockStack size asString.
	"captures
	do: [:v | body write: '/* CAPTURED: ' , v asString , '*/']
	"
	"==="
	aScope temporaries
		do: [:t | (captures includes: t)
				ifFalse: [body write: 'oop v_' , t name , '= OopNil; /* define temp */']].
	"==="
	captures size > 0
		ifTrue: [n := self serial asString.
			declarations write: 'struct context_' , n , ' : public Object {'.
			contextStack size > 0
				ifTrue: [declarations write: 'oop octx_' , lastN , ';'].
			captures
				do: [:v | declarations write: 'oop v_' , v name , ';'].
			declarations write: '}'.
			declarations write: ';'.
			body write: 'oop octx_' , n , '= BasicNewColon(PASS_VAT  &C_Array_TypeObj, ' , (captures size + 1) asString , ' );'.
			body write: 'context_' , n , ' * ctx_' , n , '= (context_' , n , '*) OopToHeader( octx_' , n , ');'.
			contextStack size > 0
				ifTrue: [lastN := contextStack last.
					body write: 'ctx_' , n , '->octx_' , lastN , '= octx_' , lastN , ';'].
			captures
				do: [:v | (argNames includes: v name)
						ifTrue: [body write: 'ctx_' , n , '->v_' , v name , ' = v_' , v name , ';']
						ifFalse: [body write: 'ctx_' , n , '->v_' , v name , ' = ' , 'OopNil;']].
			contextStack addLast: n.
			body write: '// pushed to ' , contextStack asString]
		ifFalse: [body write: '// no captures, so dont push to ' , contextStack asString]! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/1/2006 09:52'!
exitScope: aScope 
	"aScope is a BlockNode or a MethodNode (at the top level)"
	| popped vars captures |
	0.
	0.
	vars := aScope arguments union: aScope temporaries.
	captures := vars
				select: [:t | firstPass testCapturedVariable: t name inScope: aScope].
	0.
	0.
	captures size > 0
		ifTrue: [body write: '// removeLast from ' , contextStack asString.
			contextStack removeLast]
		ifFalse: [body write: '// no captures, so dont removeLast from ' , contextStack asString].
	0.
	0.
	captureStack removeLast.
	popped := blockStack removeLast.
	"make sure we popped the right scope"
	self assert: popped == aScope.
	"==="
	body write: '// Exiting Scope:'.
	self comment: aScope! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 18:20'!
flattenBlockNode: aBlockNode 
	| collection n z i csize |
	(firstPass blockIsFlat: aBlockNode)
		ifTrue: [self enterScope: aBlockNode. self comment: 'ENTER(FLAT)' ]
		ifFalse: [self comment: 'ENTER(NOT)'].
	collection := aBlockNode statements.
	n := self serial asString.
	z := 'flat_' , n.
	body write: 'oop ' , z , '= OopNil;'.
	body write: '{'.
	i := 1.
	csize := collection size.
	collection
		do: [:aNode | 
			| nodeResult | 
			nodeResult := aNode acceptVisitor: self.
			i = csize
				ifTrue: [body write: z , '= ' , nodeResult asString , ';'].
			i := i + 1].
	body write: '}'.
	self comment: 'EXIT'.
	(firstPass blockIsFlat: aBlockNode)
		ifTrue: [self exitScope: aBlockNode].
	^ z! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 16:50'!
literalArray: litArray 
	| n z |
	n := self serial asString.
	z := 'lit_' , n.
	declarations write: 'static oop ' , z , ';'.
	initializations write: z , '= BasicNewColon(PASS_VAT  & C_Array_TypeObj, ' , litArray size asString , ');'.
	initializations write: 'assert(' , z , ');'.
	1
		to: litArray size
		do: [:i | 
			| x y | 
			x := litArray at: i.
					y := self literal: x.
					initializations write: 'Func_BasicAtPut(PASS_VAT  ' , z , ',  NULL, OopFromNum(' , i asString , '), ' , y , ');'].
	^ z! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 12/23/2005 21:52'!
literalByteString: lit 
	| n z |
	n := self serial asString.
	z := 'str_' , n.
	declarations write: 'static oop ' , z , ';'.
	initializations write: z , '= OopLiteralByteString(PASS_VAT  "'
			, (self escapeStringForC: lit asString) , '");'.
	initializations write: 'assert(' , z , ');'.
	^ z! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 15:57'!
literalByteSymbol: lit 
	| n z |
	n := self serial asString.
	z := 'sym_' , n.
	declarations write: 'static oop ' , z , ';'.
	initializations write: z , '= OopFromHeader( InternString( "'
			, (self escapeStringForC: lit) , '") );'.
	initializations write: 'assert(' , z , ');'.
	^ z! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 15:37'!
literal: x 
	x class == SmallInteger
		ifTrue: [^ 'OopFromNum(' , x asString , ')'].
	x class == Array
		ifTrue: [^ self literalArray: x].
	x class == ByteString
		ifTrue: [^ self literalByteString: x].
	x class == ByteSymbol
		ifTrue: [^ self literalByteSymbol: x].
	body write: 'SetVatErrorString(PASS_VAT  "Literal Type Not Implemented: ' , self class asString , ' : '
			, (self escapeStringForC: x asString) , '");'.
	body write: 'goto ERROR;'.
	^ 'OopNOTREACHED'! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 12/31/2005 21:09'!
popFunction

	declarations write: body contents.
	body := saveStack removeLast! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 12/31/2005 21:10'!
pushFunction
	saveStack addLast: body.
	body := CinnabarCodeStream new.! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/1/2006 17:14'!
resetFunction
	body := CinnabarCodeStream new.


	captureStack := OrderedCollection new.
	saveStack := OrderedCollection new.
	blockStack := OrderedCollection new.
	contextStack := OrderedCollection new.
	
! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/1/2006 18:08'!
visitAssignmentNode: anAssignmentNode 
	| var val |
	self comment: anAssignmentNode.
	var := anAssignmentNode variable acceptVisitor: self.
	val := anAssignmentNode value acceptVisitor: self.
	body write: var , ' = ' , val , ';'.
	^ var! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 18:34'!
visitBlockNode: aBlockNode 
	"push the blockNode & recurse"
	"=================== try enterScope ========================"
	| lastN n z funcName argVars result summary prev |
	n := self serial asString.
	z := 'closure_' , n.
	lastN := contextStack size > 0
				ifTrue: [contextStack last]
				ifFalse: ['000'].
	funcName := 'block_' , n.
	argVars := aBlockNode arguments
				collect: [:v | 'v_' , v name].
	"========================================================"
	self pushFunction.
	"=============================="
	summary := self
				escapeStringForC: (self cleanString: aBlockNode asString max: 80).
	body write: ''.
	body write: 'char Name_' , funcName , '[] = "[] in ' , theClass name , '>>' , method selector , '  /*' , funcName , '*/  ' , summary , '";'.
	body write: 'Function Obj_' , funcName , ';'.
	body write: ''.
	initializations write: 'Obj_' , funcName , ' . entry = (FUNC*) ' , funcName , ';'.
	initializations write: 'Obj_' , funcName , ' . name = Name_' , funcName , ';'.
	initializations write: 'Obj_' , funcName , ' . numArgs = ' , argVars size asString , ';'.
	initializations write: 'Obj_' , funcName , ' . setType( Func_TypeIndex );'.
	"=============== generate block function ================="
	body write: 'oop ' , funcName , '(PARM_VAT'.
	body write: '   Closure* closure '.
	body
		write: (self declareParameters: argVars).
	body write: ') {'.
	body write: 'oop v_self= closure->self;'.
	body write: 'oop octx_' , lastN , '= closure->context;'.
	body write: '///===contextStack=== ' , contextStack asString.
	contextStack size > 0
		ifTrue: [body write: 'context_' , lastN , ' * ctx_' , lastN , ' = (context_' , lastN , '*) OopToHeader( octx_' , lastN , ' );'.
			prev := 'ctx_' , lastN].
	"this will be wrong for methods on num/SmallInteger"
	theClass == SmallInteger
		ifFalse: [body write: 'C_' , theClass name , '* self= (C_' , theClass name , '*) OopToHeader(v_self);'].
	contextStack size - 1
		to: 1
		by: -1
		do: [:i | 
			| nn | 
			nn := (contextStack at: i) asString.
			body write: 'context_' , nn , ' * ctx_' , nn , ' = (context_' , nn , '*) OopToHeader( ' , prev , '->octx_' , nn , ' );'.
			prev := 'ctx_' , nn].

	self enterScope: aBlockNode.
	result := self flattenBlockNode: aBlockNode.
	self exitScope: aBlockNode.
	body write: '/*END*/ return ' , result , ';'.
	body write: 'ERROR: AddVatErrorString(PASS_VAT  Name_' , funcName , ' );'.
	body write: 'return OopGOTO;'.
	body write: '}'.
	"=============================="
	self popFunction.
	"=============================================================="
	body write: 'oop o' , z , '= BasicNew(PASS_VAT  &ClosureType);'.
	body write: 'Closure* ' , z , '= (Closure*) OopToHeader( o' , z , ');'.
	body write: z , '->function= OopFromHeader( & Obj_' , funcName , ' );'.
	contextStack size > 0
		ifTrue: [body write: z , '->context= octx_' , contextStack last , ';']
		ifFalse: [body write: z , '->context= 0;'].
	body write: z , '->self= v_self;'.
	^ 'o' , z! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 16:58'!
visitBraceNode: aBraceNode 
	| n z e |
	e := aBraceNode elements.
	n := self serial asString.
	z := 'brace_' , n.
	body write: 'oop ' , z , '= BasicNewColon(PASS_VAT  & C_Array_TypeObj, ' , e size asString , ');'.
	body write: 'assert(' , z , ');'.
	1
		to: e size
		do: [:i | 
			| y |
			y := (e at: i) acceptVisitor: self.
			body write: 'Func_BasicAtPut(PASS_VAT  ' , z , ',  NULL, OopFromNum(' , i asString , '), ' , y , ');'].
	^ z! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 12/23/2005 06:41'!
visitByteSymbol: aByteSymbol 
	^ aByteSymbol! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 12/23/2005 07:17'!
visitCascadeNode: aCascadeNode 
	| result |
	result := 'OopNil'.
	aCascadeNode messages
		do: [:m | "
			--- Create a temporary MessageNode, so we can set its receiver
			correctly. Necessary because the receiver in the Cascade's
			MessageNodes is nil.
			The result of the last message in the cascade is our result. ---
			"
			result := self visitMessageNode: (MessageNode new receiver: aCascadeNode receiver;
							 selector: m selector;
							 arguments: m arguments)].
	^ result! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 15:38'!
visitLiteralNode: aLiteralNode 
	| lit lc |

	lit := aLiteralNode eval.

	true ifTrue: [ ^ self literal: lit ].
"******************************************************"
	lc := lit class.
	lc == SmallInteger
		ifTrue: [^ 'OopFromNum(' , lit asString , ')'].
	"lc == ByteSymbol
	ifTrue: [^ self literalByteSymbol: lit]
	"
	lc == ByteString
		ifTrue: [^ self literalByteString: lit].
	"lc == Array
	ifTrue: [^ self literalArray: lit]
	"
	"--default--"
	body write: ' SetVatErrorString(PASS_VAT  "LiteralNode not implemented: '
			, (self escapeStringForC: aLiteralNode asString) , '");'.
	body write: ' goto ERROR;'.
	^ 'OopNOTREACHED'! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 12/28/2005 21:42'!
visitLiteralVariableNode: aNode 
	"assume all LiteralVariables are classes -- until we get a
	counterexample."
	| obj |
	obj := aNode key value.
	obj
		ifKindOf: Class
		thenDo: [:cls | ^ 'OopFromHeader(&C_' , cls name , '_ClsObj)'].

	(aNode key key = #Smalltalk) ifTrue: [ ^ 'OopSmalltalk' ].
	(aNode key key = #Transcript) ifTrue: [ 	^ 'OopTranscript' ].

	self error: 'Unimplemented kind of LiteralVariableNode'! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/1/2006 16:05'!
visitMessageNode: aMessageNode 
	| n z msgSelector msgReceiver argList funcType |
	self comment: aMessageNode.
	msgSelector := aMessageNode selector acceptVisitor: self.
	"*** Check to see if the message is a special case before you go any
	further "
	(specialCases includesKey: msgSelector)
		ifTrue: [^ self
				perform: (specialCases at: msgSelector)
				with: aMessageNode].
	"*** If special messages not handled yet, it is an error."
	aMessageNode special
		ifNotNil: [aMessageNode special > 0
				ifTrue: [body write: '// ' , msgSelector asString , ' ::SQUEAK SPECIAL CASE:: ' , aMessageNode special asString.
					self comment: '$RCVR: ' , aMessageNode receiver asString.
					aMessageNode arguments
						do: [:x | self comment: '$ARG ' , x asString].
					body write: 'SetVatErrorString(VAT_PASS  "// ' , msgSelector asString , ' ::SQUEAK SPECIAL CASE:: ' , aMessageNode special asString , '" );'.
					body write: 'goto ERROR;'.
					^ 'OopNOTREACHED']].
	"*** Normal messages continue here."
	n := self serial asString.
	z := 'send_' , n.
	declarations write: 'static SenderCache cache' , n , ';'.
	declarations write: 'static Symbol* selector' , n , ';'.
	initializations write: 'InsertSenderCache( &cache' , n , ' );';
		 write: 'selector' , n , ' = InternString("' , msgSelector , '"); '.
	body write: 'oop ' , z , '= OopNil;'.
	body write: '{'.
	msgReceiver := aMessageNode receiver acceptVisitor: self.
	""
	"body write: '// ***SEND*** ', z, ' := ',msgReceiver, ' ', msgSelector, ' ...'."
	""
	argList := self passArgumentVariables: aMessageNode arguments.
	body write: 'word typeIndex= OopToTypeIndex(' , msgReceiver , ');'.
	body write: 'BIND_CACHE( cache' , n , ', typeIndex, selector' , n , ' );   /* ' , msgSelector , ' */'.
	funcType := 'FUNC' , aMessageNode arguments size asString , '*'.
	body write: funcType , ' f= (' , funcType , ')cache' , n , '.func;'.
	body write: z , '=  f(PASS_VAT  ' , msgReceiver , ', selector' , n , argList , ');'.
	body write: 'if (!!' , z , ') goto ERROR;'.
	body write: '}'.
	^ z! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 11/28/2005 00:53'!
visitParseNode: aParseNode

	self error: 'Visiting unimplemented node type ', aParseNode asString
! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 12/17/2005 00:34'!
visitReturnNode: aReturnNode

	body write: 'return ', (aReturnNode expr acceptVisitor: self) , ';'.

	^ 'OopNOTREACHED'.! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 11/28/2005 01:54'!
visitSelectorNode: aSelectorNode

	| cCode |

	cCode := aSelectorNode key asString.

	^ cCode.! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/2/2006 10:06'!
visitTempVariableNode: aTempVariableNode 
	| var j |
	var := aTempVariableNode name.
	j := contextStack size.
	captureStack size
		to: 1
		by: -1
		do: [:i | (captureStack at: i) size > 0
				ifTrue: [((captureStack at: i)
							includes: var)
						ifTrue: [^ 'ctx_' , (contextStack at: j) asString , '->v_' , var , '/*level' , i asString , '*/'].
					j := j - 1]].
	^ 'v_' , var , '/*tempVar*/'! !

!CinnabarGenMethods methodsFor: 'visitors' stamp: 'strick 1/1/2006 17:12'!
visitVariableNode: aVariableNode 
	| var |
	var := aVariableNode name.
	"-- check first for reserved names --"
	var = 'true'
		ifTrue: [^ 'OopTrue'].
	var = 'false'
		ifTrue: [^ 'OopFalse'].
	var = 'nil'
		ifTrue: [^ 'OopNil'].
	var = 'self'
		ifTrue: [^ 'v_self'].

	^ 'self->f_' , var , '/*var*/'! !

!CinnabarGenMethods methodsFor: 'as yet unclassified' stamp: 'strick 12/24/2005 16:52'!
cloneSlave
	" methodNum stMethodsToCbar nextSerialNumber declarations
	initializations body specialCases varMap"
	| z |
	z := self class new! !

!CinnabarGenMethods methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 15:50'!
genCbarClassDefinition: aClass 
	"
	self new genCbarClassDefinition: LiteralNode 
	"
	| cCode superC superClassNameForCxx instVars |
	cCode := ''.
	superC := aClass superclass.
	superC
		ifNil: [superClassNameForCxx := 'Header']
		ifNotNil: [superClassNameForCxx := 'C_' , superC name.
			cCode := cCode , ' '
			"(self genCbarClassDefinition: superC)"].
	instVars := ''.
	(aClass instanceVariablesString findTokens: ' ')
		do: [:var | instVars := instVars , '   oop  f_' , var , '; '].
	cCode := cCode , '
#ifndef C_' , aClass name , '_TypeIndex
struct C_' , aClass name , ' : public ' , superClassNameForCxx , ' { // ' , aClass kindOfSubclass , '
' , instVars , '
};
#endif
'.
	^ cCode! !

!CinnabarGenMethods methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 22:05'!
genCbarFooter: aSmallTalkClass 
	| cCode cCode2 |
	cCode2 := ''.
	cCode := '

extern "C"

void Init_' , aSmallTalkClass name , '()
{
	DECLARE_VAT_FROM_EXPR(NULL); // TODO: should we pass "shared vat" to Init?
 	const char* TypeSupers[] = { "ProtoObject", "Object", "' , aSmallTalkClass name , '", NULL };
	Type* type = FindOrDefineType( TypeSupers );
	assert(type);

'.
	aSmallTalkClass methodDict keys
		do: [:methodKey | cCode2 := ' 
	{
		Symbol* sym = InternString("' , methodKey , '"); 
		type->insertFunction(sym, (FUNC*)'
						, (stMethodsToCbar at: methodKey) , '); 
	}
' , cCode2].
	cCode := cCode , cCode2.
	cCode := cCode , initializations contents , '
}
'.
	^ cCode! !

!CinnabarGenMethods methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2005 01:31'!
genCbarFromClass: aClass
	
	| cCode |

	cCode := ''.

	aClass methodDict keys do: [:methodKey | methodNum_methodNum+1. stMethodsToCbar add: ((Association new) key:methodKey value:'Func_',(aClass name),'_',(self convertSelectorToCbar: methodKey),'_',methodNum asString)].


	aClass methodDict keys do: [:methodKey | cCode:= cCode,'
',(self genCbarFromString: (aClass sourceMethodAt: methodKey) class: aClass )].



	^ declarations contents, cCode.

! !

!CinnabarGenMethods methodsFor: 'as yet unclassified' stamp: 'strick 12/24/2005 16:51'!
genCbarFromString: smallTalkMethodString class: aClass

	^ self generateMethod: (Parser new parse: smallTalkMethodString class: aClass)
	forClass: aClass! !

!CinnabarGenMethods methodsFor: 'as yet unclassified' stamp: 'Ryan 12/8/2005 12:47'!
genCbarHeader: aClass 

	^ '#include "cinnabar.h"

' , (self genCbarClassDefinition: aClass). 
! !

!CinnabarGenMethods methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 08:41'!
identifier: aString 
	"
	self new identifier: 'foo bar'
	
	Optimize: just return the string if all AlphaNumeric.
	Otherwise rebuild the string.
	"
	(aString
			inject: true
			into: [:z :c | z
					and: [c isAlphaNumeric]])
		ifTrue: [^ aString].
	^ aString
		inject: ''
		into: [:b :c | c isAlphaNumeric
				ifTrue: [b := b
								, (ByteString with: c)]
				ifFalse: [b := b , '$' , c codePoint asString , '$']]! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 1/1/2006 10:10'!
cleanString: aString max: max
	|z| z := aString
		collect: [:c | $  <= c
				ifTrue: [c]
				ifFalse: [$ ]]
.
	z size > max ifTrue: [ z := (z copyFrom: 1 to: max), '...' ].
^z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 1/1/2006 10:11'!
comment: aNode 
	body write: '// '
			, (self cleanString: aNode asString max: 999) , ' '! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:32'!
messageAdd: aMessageNode

	^self message: aMessageNode binOp: 'OopAdd'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 1/2/2006 14:23'!
messageBasicAtPut: aMessageNode 
	| n z rcvr arg1 arg2 |
	n := self serial asString.
	z := 'at_' , n.
	rcvr := aMessageNode receiver acceptVisitor: self.
	arg1 := (aMessageNode arguments at: 1)
				acceptVisitor: self.
	arg2 := (aMessageNode arguments at: 2)
				acceptVisitor: self.
	body write: 'oop ' , z , '= OopBasicAtPut(PASS_VAT  ' , rcvr , ' , ' , arg1 , ' , ' , arg2 , ' );'.
	body write: 'if ( !! ' , z , ' ) goto ERROR;'.
	^ z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 1/2/2006 14:13'!
messageBasicAt: aMessageNode 
	| n z rcvr arg1 |
	n := self serial asString.
	z := 'at_' , n.
	rcvr := aMessageNode receiver acceptVisitor: self.
	arg1 := (aMessageNode arguments at: 1)
				acceptVisitor: self.
	body write: 'oop ' , z , '= OopBasicAt(PASS_VAT  ' , rcvr , ' , ' , arg1 , ' );'.
	body write: 'if ( !! ' , z , ' ) goto ERROR;'.
	^ z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 18:16'!
messageBasicNewColon: aMessageNode 
	| n z rcvr arg1 |
	n := self serial asString.
	z := 'new_' , n.
	rcvr := aMessageNode receiver acceptVisitor: self.
	arg1 := (aMessageNode arguments at:1) acceptVisitor: self.
	body write: 'oop ' , z , '= OopBasicNewColon(PASS_VAT  ' , rcvr ,' , ', arg1, ' );'.
	body write: 'if ( !! ' , z , ' ) goto ERROR;'.
	^ z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 18:17'!
messageBasicNew: aMessageNode 
	| n z rcvr |

	n := self serial asString.
	z := 'new_' , n.

	rcvr := aMessageNode receiver acceptVisitor: self.

	body write: 'oop ' , z , '= OopBasicNew(PASS_VAT  ' , rcvr , ' );'.
	body write: 'if ( !! ' , z , ' ) goto ERROR;'.
	^ z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 18:17'!
messageBasicSize: aMessageNode 
	| n z rcvr |
	n := self serial asString.
	z := 'size_' , n.
	rcvr := aMessageNode receiver acceptVisitor: self.
	body write: 'oop ' , z , '= OopBasicSize(PASS_VAT  ' , rcvr , ' );'.
	body write: 'if ( !! ' , z , ' ) goto ERROR;'.
	^ z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/12/2005 17:37'!
messageBitAnd: aMessageNode

	^self message: aMessageNode binOp: 'OopBitAnd'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/12/2005 17:37'!
messageBitOr: aMessageNode

	^self message: aMessageNode binOp: 'OopBitOr'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/12/2005 19:35'!
messageBitShift: aMessageNode

	^self message: aMessageNode binOp: 'OopBitShift'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/12/2005 17:38'!
messageBitXor: aMessageNode

	^self message: aMessageNode binOp: 'OopBitXor'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/12/2005 17:17'!
messageEQEQ: aMessageNode

	^self message: aMessageNode binOp: 'OopEQEQ'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:35'!
messageEQ: aMessageNode

	^self message: aMessageNode binOp: 'OopEQ'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 18:11'!
messageErrorColon: aMessageNode 
	| rcvr arg1 |
	rcvr := aMessageNode receiver acceptVisitor: self.
	arg1 := aMessageNode arguments first acceptVisitor: self.
	body write: 'SetVatErrorString(PASS_VAT  ' , arg1 , ' );'.
	body write: 'AddVatErrorString(PASS_VAT  "receiver object is:" );'.
	body write: 'AddVatErrorString(PASS_VAT  ' , rcvr , ' );'.
	body write: 'goto ERROR;'.
	^ 'OopNOTREACHED'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:36'!
messageGE: aMessageNode

	^self message: aMessageNode binOp: 'OopGE'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:35'!
messageGT: aMessageNode

	^self message: aMessageNode binOp: 'OopGT'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 16:16'!
messageIfElse: aMessageNode receiverIs: predicate 
	| n rcvr arg1 arg2 z |
	self assert: aMessageNode arguments size == 2.
	n := self serial asString.
	z := 'if_' , n.
	rcvr := aMessageNode receiver acceptVisitor: self.
	body write: 'oop ' , z , '= OopNil; // ' , aMessageNode selector asString , '//'.
	body write: 'if ( '
			, (predicate value: rcvr) , ' ) {'.
	arg1 := self flattenBlockNode: aMessageNode arguments first.
	body write: z , '=' , arg1 , ';'.
	body write: '}'.
	body write: 'else {'.
	arg2 := self flattenBlockNode: aMessageNode arguments second.
	body write: z , '=' , arg2 , ';'.
	body write: '}'.
	^ z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 16:14'!
messageIfFalseIfTrue: aMessageNode 
	^ self
		messageIfElse: aMessageNode
		receiverIs: [:rcvr | '!! OopToBool(PASS_VAT ' , rcvr , ')']! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 15:55'!
messageIfFalse: aMessageNode 
	^ self
		messageIf: aMessageNode
		receiverIs: [:rcvr | '!! OopToBool(PASS_VAT ' , rcvr , ')']! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 16:14'!
messageIfNilIfNotNil: aMessageNode 
	^ self
		messageIfElse: aMessageNode
		receiverIs: [:rcvr | 'OopNil == ' , rcvr]! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 15:57'!
messageIfNil: aMessageNode 
	^ self
		messageIf: aMessageNode
		receiverIs: [:rcvr | 'OopNil == ' , rcvr ]! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 16:15'!
messageIfNotNilIfNil: aMessageNode 
	^ self
		messageIfElse: aMessageNode
		receiverIs: [:rcvr | 'OopNil !!= ' , rcvr]! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 15:57'!
messageIfNotNil: aMessageNode 
	^ self
		messageIf: aMessageNode
		receiverIs: [:rcvr | 'OopNil !!= ' , rcvr]! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 16:03'!
messageIfTrueIfFalse: aMessageNode 
	^ self
		messageIfElse: aMessageNode
		receiverIs: [:rcvr | 'OopToBool(PASS_VAT ' , rcvr , ')']! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 15:45'!
messageIfTrue: aMessageNode 
	^ self
		messageIf: aMessageNode
		receiverIs: [:rcvr | 'OopToBool(PASS_VAT ' , rcvr , ')']! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 16:18'!
messageIf: aMessageNode receiverIs: predicate 
	| n rcvr arg1 z |
	n := self serial asString.
	z := 'if_' , n.
	rcvr := aMessageNode receiver acceptVisitor: self.
	body write: 'oop ' , z , '= OopNil; // ifFalse:'.
	body write: 'if ( '
			, (predicate value: rcvr) , ' ) {'.
	arg1 := self flattenBlockNode: aMessageNode arguments first.
	body write: z , '=' , arg1 , ';'.
	body write: '}'.
	^ z! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:36'!
messageLE: aMessageNode

	^self message: aMessageNode binOp: 'OopLE'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:33'!
messageLT: aMessageNode

	^self message: aMessageNode binOp: 'OopLT'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 1/2/2006 10:19'!
messageMul: aMessageNode 
	^ self message: aMessageNode binOp: 'OopMul'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/12/2005 17:17'!
messageNENE: aMessageNode

	^self message: aMessageNode binOp: 'OopNENE'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:36'!
messageNE: aMessageNode

	^self message: aMessageNode binOp: 'OopNE'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 16:46'!
messageSay: aMessageNode 
	| rcvr |
	rcvr := aMessageNode receiver acceptVisitor: self.
	body write: 'OopSay(PASS_VAT  ' , rcvr , ' );'.
	^ rcvr.! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'Ryan 12/11/2005 09:33'!
messageSub: aMessageNode

	^self message: aMessageNode binOp: 'OopSub'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/24/2005 21:27'!
messageToByDo: aMessageNode 
	| n rcvr argTo argBy block |
	n := self serial asString.
	"---"
	rcvr := aMessageNode receiver acceptVisitor: self.
	argTo := aMessageNode arguments first acceptVisitor: self.
	argBy := aMessageNode arguments second acceptVisitor: self.
	"--- if these are known constants, this will vanish by -O:"
	body write: 'if (!!(1&(word)(' , rcvr , ')&(word)(' , argTo , ')&(word)(' , argBy , '))) {'.
	body write: 'SetVatErrorString(PASS_VAT  "to:by:do: requires SmallIntegers");'.
	body write: 'goto ERROR;'.
	body write: '}'.
	"---"
	body write: 'num i_' , n , ' = OopToNum(' , rcvr , ');'.
	body write: 'num to_' , n , ' = OopToNum(' , argTo , ');'.
	body write: 'num by_' , n , ' = OopToNum(' , argBy , ');'.
	"--- if by: is known constant, this will simplify by -O:"
	body write: 'for ( ; (by_' , n , '>0) ? (i_' , n , '<=to_' , n , ') : (i_' , n , '>=to_' , n , ') ; i_' , n , '+=by_' , n , ') {'.
	"--- expand the do: block"
	block := aMessageNode arguments third.
	body write: 'oop v_' , block arguments first name , ' = OopFromNum(i_' , n , ');'.
	self flattenBlockNode: block.
	"---"
	body write: '}'.
	^ 'OopNil'! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/24/2005 21:01'!
messageToDo: aMessageNode 
	^ self
		messageToByDo: (MessageNode new
				receiver: aMessageNode receiver
				arguments: {aMessageNode arguments first. LiteralNode new key: 1. aMessageNode arguments second}
				precedence: 3)! !

!CinnabarGenMethods methodsFor: 'specialCases' stamp: 'strick 12/23/2005 18:17'!
message: aMessageNode binOp: aFuncName

	| n z rcvr arg1 |

	"self comment: aMessageNode."

	n := self serial asString.
	z := 'binop_',n.

	rcvr := aMessageNode receiver acceptVisitor: self.
	arg1 := (aMessageNode arguments at:1) acceptVisitor: self.

	body write: 'oop ',z,'= ',aFuncName,'(PASS_VAT  ',rcvr,', ',arg1,' );'.
	body write: 'if ( !! ',z,' ) goto ERROR;'.

	^ z
! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'strick 12/23/2005 08:43'!
convertSelectorToCbar: aSelector 
	^ self identifier: aSelector! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'Ryan 12/11/2005 06:37'!
convertToUnixNewlines: aString

" CinnabarGen new convertToUnixNewlines: 'blah
two
three' 
"

	^aString copyReplaceAll: Character cr asString with: Character lf asString asTokens: false.! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'Ryan 12/10/2005 19:14'!
declareParameters: aParameterArray

	| decs |

	decs _ ''.

	aParameterArray do: [:parm |

		decs _ decs, ', oop ', parm.
].

	^ decs! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'Ryan 12/10/2005 19:08'!
declareTempVars: aTempVarArray
! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'Ryan 12/10/2005 17:13'!
defineArgumentVariables: anArgArray

	| definitions num |

	definitions _ ''.
	num _ 1.

	anArgArray do: [:arg |

		definitions _ definitions, 'oop arg', (num asString),' = ', (arg acceptVisitor: self),';
'.		num _ num + 1.
].

	^ definitions! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'strick 12/23/2005 10:28'!
escapeStringForC: aString 
	^ aString
		inject: ''
		into: [:b :c | 
		('\''"' includes: c ) ifTrue: [b,'\', (ByteString with: c)]
		ifFalse: [b,(ByteString with: c)] ]! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'strick 1/2/2006 18:33'!
generateMethod: aMethodNode forClass: aClass 
	| cCode selector bNode argVars funcName |
	theClass := aClass.
	method := aMethodNode.
	firstPass := CinnabarFirstPass new
				visitMethodNode: aMethodNode
				forClass: aClass
				for: self.
	"*** firstPass inspect. ***"
	cCode := ''.
	bNode := aMethodNode block.
	selector := aMethodNode selector asString.
	funcName := stMethodsToCbar at: selector.
	argVars := aMethodNode arguments
				collect: [:var | var acceptVisitor: self].
	cCode := 'oop ' , funcName , '(PARM_VAT   oop v_self, Symbol* selector'
				, (self declareParameters: argVars) , ') {
'.
	"============ trying enterScope ===================="
	
	self enterScope: aMethodNode.
	"======================================================="
	"this will be wrong for methods on num/SmallInteger"
	aClass == SmallInteger
		ifFalse: [cCode := cCode , '
   C_' , aClass name , '* self= (C_' , aClass name , '*) OopToHeader(v_self);
'].
	self flattenBlockNode: bNode.
	cCode := cCode , '
/*BODY*/' , body contents , '
/*END*/ return v_self;
ERROR:
	AddVatErrorString(PASS_VAT  "in ' , aClass name , '>>' , selector , ' ...");
	return (oop)0;
}
Function F_' , funcName , ';
'.
	"==============================="
	self exitScope: aMethodNode.
	"======================================================="
	initializations write: 'F_' , funcName , '.entry = (FUNC*)' , funcName , ';'.
	initializations write: 'F_' , funcName , '.name = "' , aClass name , '>>' , selector , '";'.
	self resetFunction.
	^ cCode! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'strick 1/2/2006 15:04'!
initialize
	captureStack := OrderedCollection new.
	saveStack := OrderedCollection new.
	blockStack := OrderedCollection new.
	contextStack := OrderedCollection new.
	methodNum := 0.
	stMethodsToCbar := Dictionary new.
	nextSerialNumber := 0.
	declarations := CinnabarCodeStream new.
	initializations := CinnabarCodeStream new.
	body := CinnabarCodeStream new.
	"Make a table for special message cases"
	specialCases := Dictionary new.
	"*** all 8 cases of ifTrue, ifFalse, ifNil, ifNotNil..... 
	go to the same #messageIfTrueIfFalse: handler ***"
	specialCases
		add: (Association new key: #ifTrue: value: #messageIfTrueIfFalse:);
		
		add: (Association new key: #ifFalse: value: #messageIfTrueIfFalse:);
		
		add: (Association new key: #ifNil: value: #messageIfTrueIfFalse:);
		
		add: (Association new key: #ifNotNil: value: #messageIfTrueIfFalse:);
		
		add: (Association new key: #ifTrue:ifFalse: value: #messageIfTrueIfFalse:);
		
		add: (Association new key: #ifFalse:ifTrue: value: #messageIfTrueIfFalse:);
		
		add: (Association new key: #ifNil:ifNotNil: value: #messageIfTrueIfFalse:);
		
		add: (Association new key: #ifNotNil:ifNil: value: #messageIfTrueIfFalse:).
	"*** and: & or: also use #messageIfTrueIfFalse: ***"
	specialCases at: #and: put: #messageIfTrueIfFalse:;
		 at: #or: put: #messageIfTrueIfFalse:.
	specialCases
		add: (Association new key: #'==' value: #messageEQEQ:);
		
		add: (Association new key: #'~~' value: #messageNENE:);
		
		add: (Association new key: #= value: #messageEQ:);
		
		add: (Association new key: #'~=' value: #messageNE:);
		
		add: (Association new key: #< value: #messageLT:);
		
		add: (Association new key: #> value: #messageGT:);
		
		add: (Association new key: #'<=' value: #messageLE:);
		
		add: (Association new key: #'>=' value: #messageGE:);
		 at: #+ put: #messageAdd:;
		 at: #- put: #messageSub:;
		 at: #* put: #messageMul:;
		
		add: (Association new key: #bitAnd value: #messageBitAnd:);
		
		add: (Association new key: #bitOr value: #messageBitOr:);
		
		add: (Association new key: #bitXor value: #messageBitXor:);
		
		add: (Association new key: #bitShift: value: #messageBitShift:).
	specialCases
		add: (Association new key: #basicNew value: #messageBasicNew:);
		
		add: (Association new key: #basicNew: value: #messageBasicNewColon:);
		
		add: (Association new key: #say value: #messageSay:);
		
		add: (Association new key: #error: value: #messageErrorColon:).

	"*** both to:by:do: and to:do: are handled by #messageToByDo: ***"
	specialCases
		add: (Association new key: #to:by:do: value: #messageToByDo:);
		
		add: (Association new key: #to:do: value: #messageToDo:)! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'strick 12/17/2005 20:32'!
passArgumentVariables: anArgArray

	| definitions |

	definitions _ ''.

	anArgArray do: [:arg |  | a |
		a := (arg acceptVisitor: self) asString.
		""" body write: '// **ARG** ', a. """
		definitions _ definitions, ', ', a.
	].

	^ definitions! !

!CinnabarGenMethods methodsFor: 'private' stamp: 'strick 11/28/2005 02:54'!
serial

	^ nextSerialNumber := nextSerialNumber + 1! !

!CinnabarGenMethods methodsFor: 'public interface' stamp: 'Ryan 12/11/2005 06:40'!
generateCbar: aClass

	" CinnabarGen new generateCbar: Apple "

	| cCode |

	cCode := (self genCbarHeader: aClass).

	cCode := cCode, (self genCbarFromClass: aClass).

	cCode := cCode, (self genCbarFooter: aClass).

	^ cCode.! !

!CinnabarGenMethods methodsFor: 'public interface' stamp: 'strick 12/29/2005 02:56'!
generateCbar: aClass toFileName: aFileName

	| fileStream |

	fileStream _ (StandardFileStream forceNewFileNamed: aFileName).

	fileStream nextPutAll: (self convertToUnixNewlines: (self generateCbar: aClass)).

	fileStream close.
! !


!CinnabarUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 17:45'!
blocks1
	| a b c |
	a := 1.
	b := 2.
	c := 3.
	Transcript show: a @ b @ c.
	Transcript
		show: [:i | 
			| j | 
			j := i * 2.
			a + i
				@ [:k | 
					| m | 
					m := k + j + i + a.
					m]].
	Transcript
		show: ([:i | b + i]
				value: 4).
	5 zork.
	1
		to: 10
		do: [:i | Transcript show: i asString].
	1
		to: 20
		do: [:i | Transcript show: i asFloat]! !

!CinnabarUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 17:43'!
blocks2: x with: y 
	"DONT CHANGE ME -- my structure is hardcoded into CinnabarUnitTests
	#testCapturedVariables"
	"a and b and y are captured"
	| a b c |
	a := 1.
	b := 2.
	c := 3.
	Transcript show: a @ x @ c.
	Transcript
		show: [:i | 
			| j | 
			"this j is captured!!"
			j := i * 2.
			a + i
				@ [:k | 
					| m | 
					"here j is used by inner block"
					m := k + j + a + y.
					m]].
	Transcript
		show: ([:i | b + i]
				value: 4).
	5 zork.
	1
		to: 10
		do: [:i | Transcript show: i asString].
	1
		to: 20
		do: [:i | Transcript show: i asFloat]! !

!CinnabarUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 1/21/2006 01:04'!
testCapturedVariables
	| firstPass methodSource methodNode cls gen |
	gen := CinnabarGenMethods new.
	cls := self class.
	methodSource := cls sourceMethodAt: #blocks2:with:.
	methodNode := Parser new parse: methodSource class: cls.
	firstPass := CinnabarFirstPass new visitMethodNode: methodNode forClass: cls for: gen.
	self
		assert: (firstPass testCapturedVariable: 'a' inScope: methodNode).
	self
		assert: (firstPass testCapturedVariable: 'b' inScope: methodNode).
	self
		assert: (firstPass testCapturedVariable: 'y' inScope: methodNode).
	self assert: (firstPass testCapturedVariable: 'c' inScope: methodNode) not.
	self assert: (firstPass testCapturedVariable: 'x' inScope: methodNode) not.
	self assert: (firstPass
			testCapturedVariable: 'i'
			inScope: ((methodNode block statements at: 5) arguments at: 1)) not.
	self
		assert: (firstPass
				testCapturedVariable: 'j'
				inScope: ((methodNode block statements at: 5) arguments at: 1))! !

!CinnabarUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 17:29'!
testHowManyArgsForSelector
	| fp |
	fp := CinnabarFirstPass new.
	self assert: 0
			= (fp howManyArgsForSelector: #value).
	self assert: 1
			= (fp howManyArgsForSelector: #value:).
	self assert: 1
			= (fp howManyArgsForSelector: #@).
	self assert: 2
			= (fp howManyArgsForSelector: #at:put:).
	self assert: 3
			= (fp howManyArgsForSelector: #to:by:do:)
! !

!CinnabarUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 12/31/2005 17:29'!
testRememberCapturedVariable
	| fp a b c |
	fp := CinnabarFirstPass new.
	a := BlockNode new.
	b := BlockNode new.
	c := BlockNode new.
	fp rememberCapturedVariable: #aaa inScope: a.
	fp rememberCapturedVariable: 'bbb' inScope: b.
	fp rememberCapturedVariable: 'bbb' inScope: c.
	fp rememberCapturedVariable: 'ccc' inScope: c.
	self
		assert: (fp testCapturedVariable: 'aaa' inScope: a).
	self
		assert: (fp testCapturedVariable: 'bbb' inScope: b).
	self
		assert: (fp testCapturedVariable: 'ccc' inScope: c).
	self assert: (fp testCapturedVariable: 'ccc' inScope: a) not.
	self assert: (fp testCapturedVariable: 'aaa' inScope: b) not.
	self
		assert: (fp testCapturedVariable: 'bbb' inScope: c).
	self assert: (fp testCapturedVariable: 'bbb' inScope: BlockNode new) not! !


!ClassHacks methodsFor: 'as yet unclassified' stamp: 'strick 12/4/2005 10:27'!
countGrope: aClass

	| subClasses numSubs |
	subClasses _ aClass subclasses.

	numSubs _ subClasses size.
	subClasses do: [:class | numSubs _ numSubs + self countGrope: class ].

	^numSubs! !

!ClassHacks methodsFor: 'as yet unclassified' stamp: 'strick 12/3/2005 17:34'!
grope: aClass

  | s z |

	s := Set new.
	
	s addAll: aClass subclasses.

     z _ s collect: [ :c |  self grope: c ] . 
     z add: aClass.

    ^z! !

!ClassHacks methodsFor: 'as yet unclassified' stamp: 'strick 12/4/2005 10:02'!
transGrope: aClass

	| setOfClasses |

	setOfClasses := (Set new).

	setOfClasses addAll: aClass subclasses.

	setOfClasses do: [:class | Transcript show: class name, ' '].

	Transcript show: '
'.
	setOfClasses do: [:class | self transGrope: class].! !


!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 03:54'!
blocks1

	| a b c  |
	a := 1. b := 2. c := 3.
	Transcript show: a @ b @ c.

	Transcript show: [ :i | | j | j := i*2.  a + i @ [ :k  | | m | m := k + j + i + a. m ] ].
	Transcript show: ([ :i | b + i ] value: 4).

	5 zork.

	1 to: 10 do: [ :i | Transcript show: i asString ].
	1 to: 20 do: [ :i | Transcript show: i asFloat ].
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/20/2006 19:23'!
blocks2: x with: y 
	| a b c |
	a := 1.
	b := 2.
	c := 3.
	Transcript show: a @ x @ c.
	Transcript
		show: [:i | 
			| j | 
			j := i * 2.
			a + i
				@ [:k | 
					| m | 
					m := k + j + a + y.
					m]].
	Transcript
		show: ([:i | b + i]
				value: 4).
	5 zork.
	1
		to: 10
		do: [:i | Transcript show: i asString].
	1
		to: 20
		do: [:i | Transcript show: i asFloat]! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 09:22'!
factorialFactoryForY: f 
	^ [:n | n == 0
		ifTrue: [1]
		ifFalse: [n
				* (f value: n - 1)]] ! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 09:42'!
factorial: anInt 
	"
	self new factorial: 5
	"
	| bigY bigF factorial |
	bigY := [:g | "Y Combinator: traditional fixed-point operator from functional programming"
			| a | 
			a := [:f | f value: f].
			a
				value: [:f | g
						value: [:x | 
							| c | 
							c := f value: f.
							c value: x]]].
	bigF := [ :f | "factorial without recursion" 
		[:n | n == 0
			ifTrue: [1]
			ifFalse: [n
				* (f value: n - 1)]]].

	"factorial is the fixed point of F"
	factorial := bigY value: bigF.

	^ factorial value: anInt
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2005 18:38'!
fibRV: n
	" Fib new fibRV: 30 "

	^ (n<2) 
		ifTrue: [ 1 ]
		ifFalse: [ (self fibRV: n-1) + (self fibRV: n-2) ]
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2005 17:53'!
fib: n
	" Fib new fib: 30 "

	(n<2) ifTrue: [ ^ 1. ].
	^ (self fib: n-1) + (self fib: n-2).
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/22/2005 16:59'!
helloWorld
	^'hello world'! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/24/2005 21:49'!
iterativeTriangeNegatively: n

"
	self new iterativeTriangeNegatively: 10
"

	| sum |
	sum := 0.
	n to: 1 by: -1 do: [ :i | sum := sum + i ].
	^sum! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/26/2005 08:30'!
iterativeTriange: n

"
	self new iterativeTriange: 5000000
"

	| sum |
	sum := 0.
	1 to: n do: [ :i | sum := sum + i ].
	^sum! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/17/2005 17:50'!
makeCounter

	| count incr |

	count := 0.
	incr := 1.
"""
	^ [ :incrIncr |

		incr := incr + incrIncr.
		count := incr.
		^ count.
	]
"""! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/20/2006 19:23'!
mumble: a1 
	| t1 |
	t1 := 100.
	^ [:a2 | 
	| t2 | 
	t2 := a1 + t1 + a2.
	t1 := t1 + t2.
	[:a3 | t1 := t1 + a1 + t2 + a2 + a3]]! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/21/2005 01:23'!
newByteString
	^ByteString basicNew: 42.
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/19/2005 23:59'!
newDateAndTime
	^DateAndTime basicNew.
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/20/2006 19:21'!
returnABlock: a 
	| b |
	b := a.
	^ [:i :j | 
	b := b + i.
	b + j]! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/23/2005 10:02'!
returnC

	| a b c |

	a := 14. b := 56. 
	^c := a+b.
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/25/2005 20:38'!
ttest0
	| fib1 fib3 fib5 fib30 |

	( self iterativeTriange: 10 ) ~~ 55 ifTrue: [ self error: 'not55err'. ^ 'not55' ].
	( self iterativeTriangeNegatively: 10 ) ~~ 55 ifTrue: [ self error: 'neg/not55err'. ^ 'neg/not55' ].

	fib1 _ self fib:1.
	fib3 _ self fib:3.
	fib5 _ self fib:5.
	fib30_ self fib:30.

	 (fib3) < 3  ifTrue: [^false].
	 3 < (fib3)  ifTrue: [^false].

	(fib5) < 8  ifTrue: [^false].
	 8 < (fib5)  ifTrue: [^false].

	(fib30) < 1346269  ifTrue: [^false].
	 1346269 < (fib30)  ifTrue: [^false].

	(fib5) ~= 8  ifTrue: [^false].
	 8 ~= (fib5)  ifTrue: [^false].

	 8 ~= (self fibRV: 5)  ifTrue: [^false].

	self newDateAndTime.
	"2<3 ifTrue: [^true]."
	self newByteString basicSize == 42 ifFalse: [^false].
	self helloWorld basicSize == 11 ifFalse: [^false].

	(self newByteString ~~ self newByteString) ifFalse: [^false].

	1 = (fib1) ifTrue: [^true].

	^ false! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/25/2005 20:38'!
ttest1

	( self iterativeTriange: 10 ) ~~ 55 ifTrue: [ self error: 'not55err'. ^ 'not55' ].
	( self iterativeTriangeNegatively: 10 ) ~~ 55 ifTrue: [ self error: 'neg/not55err'. ^ 'neg/not55' ].
	^ true.
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/26/2005 08:59'!
ttest5m

	"
	self new ttest5m
	"
	1 to: 5000 do: [ :i |
		self iterativeTriange: 5000.
	].
	^true
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 12/29/2005 04:27'!
ttestB1
	"self blocks1."
	^ true! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 13:57'!
ttestBasicArray
	| a b c |
	a := Array basicNew: 0.
	b := Array basicNew: 10.
	c := Array basicNew: 100.
	c say.
	0 = a basicSize
		ifFalse: [^ false].
	10 = b basicSize
		ifFalse: [^ false].
	100 = c basicSize
		ifFalse: [^ false].
	^true! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/20/2006 19:24'!
ttestBitShift

	^ (42 bitShift: 1)
		= 84! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 16:53'!
ttestBraceArray
	| a b c n |
	n := 100.
	b := {1 + n. 5 + n. 9 + n}.
	c := {#value. #(2 4 6 ). {n + n. n + n + n}. nil}.
	a := {}.
	c say.
	0 = a basicSize
		ifFalse: [^ false].
	3 = b basicSize
		ifFalse: [^ false].
	4 = c basicSize
		ifFalse: [^ false].
	109
			== (b basicAt: 3)
		ifFalse: [^ false].
	101
			== (b basicAt: 1)
		ifFalse: [^ false].
	nil
			== (c basicAt: 4)
		ifFalse: [^ false].
	Array == (c basicAt: 2) class
		ifFalse: [^ false].
	#value
			== (c basicAt: 1)
		ifFalse: [^ false].
	^ true
! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 17:38'!
ttestFactorial
	"^ 120 = (self new factorial: 5)"
	| expected |
	expected := 1.
	1
		to: 8
		do: [:i | 
			| got |
			'i=' say.
			i say.
			"#(1 2 3 4 5 6 7 8) collect: [:x | x factorial]"
			"#(1 2 6 24 120 720 5040 40320)"
			"expected := i factorial."
			expected := expected * i.
			'expected' say.
			expected say.
			got := self factorial: i.
			'got' say.
			got say.
			expected == got
				ifFalse: [^ false]].
	^ true! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 15:09'!
ttestLiteralArray
	| a b c |
	a := #().
	b := #(2 4 6 8 10 12 14 16 18 20 ).
	c := #(42 ).
	c say.
	0 = a basicSize
		ifFalse: [^ false].
	10 = b basicSize
		ifFalse: [^ false].
	1 = c basicSize
		ifFalse: [^ false].
	b basicAt: 3 put: 9.
	b basicAt: 10 put: 100.
	9
			== (b basicAt: 3)
		ifFalse: [^ false].
	100
			== (b basicAt: 10)
		ifFalse: [^ false].
	2
			== (b basicAt: 1)
		ifFalse: [^ false].
	18
			== (b basicAt: 9)
		ifFalse: [^ false].
	42
			== (c basicAt: 1)
		ifFalse: [^ false].
	^ true! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/2/2006 17:33'!
ttestLiterals
	5 class == 8 class
		ifFalse: [^ false].
	5 class ~~ 8
		ifFalse: [^ false].
	5 class ~~ #(8 ) class
		ifFalse: [^ false].
	{5} class == #(8 ) class
		ifFalse: [^ false].
	'hello' ~~ 'hello'
		ifFalse: [^ false].
	#value: == #value:
		ifFalse: [^ false].
	#value ~~ #value:
		ifFalse: [^ false].
	#(#value ) ~~ #(#value: )
		ifFalse: [^ false].
	^ true! !

!Fib methodsFor: 'as yet unclassified' stamp: 'strick 1/20/2006 19:21'!
ttestReturnedBlock
	| f |
	f := self returnABlock: 10.
	^ 23
		= (f value: 4 value: 9)! !


!ParseNode methodsFor: '*Cinnabar' stamp: 'strick 11/28/2005 01:57'!
acceptVisitor: aVisitor

	^aVisitor visitParseNode: self! !


!AssignmentNode methodsFor: '*Cinnabar' stamp: 'strick 12/9/2005 17:34'!
acceptVisitor: aVisitor
	^aVisitor visitAssignmentNode: self! !


!BlockNode methodsFor: 'accessing' stamp: 'strick 12/24/2005 21:25'!
arguments
	^ arguments! !

!BlockNode methodsFor: 'accessing' stamp: 'strick 12/29/2005 03:44'!
temporaries
	^ temporaries ! !

!BlockNode methodsFor: '*Cinnabar' stamp: 'strick 11/28/2005 01:08'!
acceptVisitor: aVisitor

	^aVisitor visitBlockNode: self! !


!BraceNode methodsFor: 'initialize-release' stamp: 'strick 1/2/2006 17:04'!
elements
	^ elements! !

!BraceNode methodsFor: '*Cinnabar' stamp: 'strick 1/2/2006 16:59'!
acceptVisitor: aVisitor 
	^ aVisitor visitBraceNode: self! !


!CascadeNode methodsFor: 'accessing' stamp: 'strick 12/23/2005 07:19'!
messages
	^messages! !

!CascadeNode methodsFor: '*Cinnabar' stamp: 'strick 12/23/2005 06:54'!
acceptVisitor: aVisitor

	^aVisitor visitCascadeNode: self! !


!LiteralNode methodsFor: '*Cinnabar' stamp: 'strick 11/28/2005 01:05'!
acceptVisitor: aVisitor

	^aVisitor visitLiteralNode: self! !

!LiteralNode methodsFor: '*Cinnabar' stamp: 'strick 11/25/2005 03:09'!
cBarExprGen

	| lit |

	lit := self eval.

	^( 'SWordToOop(',lit asString, ')' ).! !


!MessageNode methodsFor: '*Cinnabar' stamp: 'strick 11/28/2005 01:56'!
acceptVisitor: aVisitor

	^aVisitor visitMessageNode: self! !

!MessageNode methodsFor: '*Cinnabar' stamp: 'strick 1/1/2006 12:21'!
special

	^ special! !


!MethodNode methodsFor: '*Cinnabar' stamp: 'Ryan 12/8/2005 13:31'!
arguments
	^arguments! !

!MethodNode methodsFor: '*Cinnabar' stamp: 'Ryan 12/10/2005 19:22'!
temporaries
	^temporaries! !


!ReturnNode methodsFor: '*Cinnabar' stamp: 'strick 11/28/2005 01:05'!
acceptVisitor: aVisitor

	^aVisitor visitReturnNode: self! !


!SelectorNode methodsFor: '*Cinnabar' stamp: 'strick 11/28/2005 01:57'!
acceptVisitor: aVisitor

	^aVisitor visitSelectorNode: self! !

!SelectorNode methodsFor: '*Cinnabar' stamp: 'strick 11/27/2005 12:36'!
cBarExprGen

	| cCode |

	cCode := self key asString.

	^ cCode.! !


!VariableNode methodsFor: '*Cinnabar' stamp: 'strick 11/28/2005 01:59'!
acceptVisitor: aVisitor

	^aVisitor visitVariableNode: self! !

!VariableNode methodsFor: '*Cinnabar' stamp: 'strick 11/27/2005 02:40'!
cBarExprGen
	^'',name.! !


!LiteralVariableNode methodsFor: 'code generation' stamp: 'strick 12/19/2005 23:46'!
acceptVisitor: aVisitor

	^aVisitor visitLiteralVariableNode: self! !


!TempVariableNode methodsFor: '*Cinnabar' stamp: 'strick 12/9/2005 17:02'!
acceptVisitor: aVisitor
	^aVisitor visitTempVariableNode: self.! !


!SelectorNode reorganize!
('code generation' emit:args:on: emit:args:on:super: size:args:super:)
('printing' printOn:indent:)
('inappropriate' emitForEffect:on: emitForValue:on: sizeForEffect: sizeForValue:)
('*Cinnabar' acceptVisitor: cBarExprGen)
('testing' isPvtSelector)
!


!AssignmentNode reorganize!
('initialize-release' toDoIncrement: value variable:value: variable:value:from: variable:value:from:sourceRange:)
('code generation' emitForEffect:on: emitForValue:on: sizeForEffect: sizeForValue:)
('printing' printOn:indent: printOn:indent:precedence:)
('equation translation' variable)
('tiles' asMorphicSyntaxIn: explanation)
('*Cinnabar' acceptVisitor:)
('*VMMaker-C translation' asTranslatorNode)
!

CinnabarGenMethods removeSelector: #defineTempVars:!
CinnabarFirstPass removeSelector: #blockIsFlat!
CinnabarFirstPass removeSelector: #capturedVars!
CinnabarFirstPass removeSelector: #capturedVars:!
CinnabarFirstPass removeSelector: #countColons:!
CinnabarFirstPass removeSelector: #visitMethodNode:forClass:!