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

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 18:41'!
ttest00000NonLocalReturn

	| b |

	b := [ ^ true ].

	b value.  "-- this should cause return of true --"

	^ false.   "-- should not be reached --"! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/15/2006 21:28'!
ttest100factorial

	| z |
	z := 1.
	1 to: 20 do: [ :i | z := z * i ].

	2432902008176640000 = z  ifFalse: [^false].

	^  2432902008176640000 = ( 20 factorial )
! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/15/2006 08:36'!
ttest60000000

	^  16r60000000 = (16r30000000 + 16r30000000) 
! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 20:08'!
ttestBag

	| b |

	b := Bag new.
	#( 1 2 3 4 5 a b c d e a b c d e 1234567890123 1234567890124 ) do: [:x| b add: x].

	
	#( 1 2 3 4 5 1234567890123 1234567890124 ) do: [:x|
		[ 1 = ( b occurrencesOf: x) ] assert.
	].

	#( a b c d e ) do: [:x|
		[ 2 = ( b occurrencesOf: x) ] assert.
	].

	#( 10 100 1000 w x y z ) do: [:x|
		[ 0 = ( b occurrencesOf: x) ] assert.
	].

	^ true! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/24/2006 15:09'!
ttestDelimiter

	| d |
	d := FileDirectory primPathNameDelimiter.

	^ ( d == $/ "unix" ) | ( d == $\ "win" ) | ( d == $: "old mac" ).
! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/13/2006 08:02'!
ttestIdentityDictionary

	| d |

	d := IdentityDictionary new.
	d at: 10 put: 100.
	d at: 20 put: 400.
	d at: 'pie' put: 'round'.
	^ 400 == (d at: 20) and: [100 == (d at: 10)] and: [ 42 == (d at: 23 ifAbsent: [39 + d size])]
! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 09:57'!
ttestKindOf

	[ 333333 isKindOf: SmallInteger ] assert.
	[ 333333333333 isKindOf: SmallInteger ] refute.


	^ true! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 18:35'!
ttestNonLocalReturn

	| b |

	b := [ ^ true ].

	b value.  "-- this should cause return of true --"

	^ false.   "-- should not be reached --"! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/12/2006 22:14'!
ttestNonSmallSum

	^  LargePositiveInteger == (16r30000000 + 16r30000000) class
! !

!CinnabarTestCollections methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 18:35'!
xxxxxtestFraction	

	[ ( 123456789012345 / 9876543210987654321 ) numerator = 41152263004115 ] assert.

	[ ( 123456789012345 / 9876543210987654321 ) denominator = 3292181070329218107 ] assert.

	[ ( 12358024580135802457890 / 12345678901234567890 ) = 1001 ] assert.

	^ true! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

CinnabarTestCollections class
	instanceVariableNames: ''!

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

!CinnabarTestFib 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 ].
! !

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

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

!CinnabarTestFib 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
! !

!CinnabarTestFib 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) ]
! !

!CinnabarTestFib 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).
! !

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

!CinnabarTestFib 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! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 3/20/2006 09:02'!
iterativeTriange: n

"
	self new iterativeTriange: 5000
"

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

!CinnabarTestFib 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.
	]
"""! !

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

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

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

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:28'!
returnABlock: a 
	| b |

	b := a.

	^ [:i :j | 
			b := b + i.
			b + j
	]
! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:29'!
returnC

	| a b c |

	c := 0.
	a := 14 + c. 
	b := 56 + c.

	^ c := a + b.
! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 3/20/2006 09:05'!
ttest0
	| fib1 fib3 fib5 fib20 |

	( 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.
	fib20_ self fib:20.

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

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

	(fib20) <  10946  ifTrue: [^false].
	 10946 < (fib20)  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! !

!CinnabarTestFib 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.
! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:40'!
ttest42IfNil

	^ 42 == ( 42 ifNil: [13] )! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:43'!
ttest42IfNilIfNotNil

	^ 7 == ( 42 ifNil: [888] ifNotNil: [7] )! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:41'!
ttest42IfNotNil

	^ 13 == ( 42 ifNotNil: [13] )! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:44'!
ttest42IfNotNilIfNil

	^ 888 == ( 42 ifNotNil: [888] ifNil: [7] )! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 3/20/2006 09:03'!
ttest5m

	"
	self new ttest5m
	"
	1 to: 50 do: [ :i |
		[  12502500 = ( self iterativeTriange: 5000) ] assert
	].
	^true
! !

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

!CinnabarTestFib 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! !

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

	^ (42 bitShift: 1)
		= 84! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 17:36'!
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 := {}.

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

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/16/2006 03:11'!
ttestClassMethodFive


	^ 5 == self class five
! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 14:42'!
ttestClassMethodNine


	^ 9 == self class nine
! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/26/2006 17:03'!
ttestFactorial
	"^ 120 = (self new factorial: 5)"
	| expected |
	expected := 1.
	1
		to: 8
		do: [:i | 
			| got |
			i > 7 ifTrue: [
				'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.

			i > 7 ifTrue: [
			'expected' say.
			expected say.
			].
			got := self factorial: i.

			i > 7 ifTrue: [
			'got' say.
			got say.
			].
			expected == got
				ifFalse: [^ false]].
	^ true! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 3/2/2006 12:07'!
ttestIdentityDictionary

"
	| d |


	d := IdentityDictionary new.
	d at: 10 put: 100.
	d at: 20 put: 400.
	d at: 'pie' put: 'round'.
	^ 400 == (d at: 20)
"

	^ true! !

!CinnabarTestFib 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! !

!CinnabarTestFib 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! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:39'!
ttestNilIfNil

	^ 42 == ( nil ifNil: [42] )! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:43'!
ttestNilIfNilIfNotNil

	^ 888 == ( nil ifNil: [888] ifNotNil: [42] )! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:41'!
ttestNilIfNotNil

	^ nil == ( nil ifNotNil: [42] )! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:44'!
ttestNilIfNotNilIfNil

	^ 7 == ( nil ifNotNil: [888] ifNil: [7] )! !

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

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:36'!
ttestWhileFalse

	| i z |

	i := z := 0.

	[ z := z + i.   i := i + 1.  i>10 ] 
		whileFalse. 

	^ z == 55! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:35'!
ttestWhileFalseColon

	| i z |

	i := z := 0.

	[ i > 10 ] whileFalse: [ z := z + i.   i := i + 1.  ]. 

	^ z == 55! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:35'!
ttestWhileTrue

	| i z |

	i := z := 0.

	[ z := z + i.   i := i + 1.  i<=10 ] 
		whileTrue. 

	^ z == 55! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:34'!
ttestWhileTrueColon

	| i z |

	i := z := 0.

	[ i <= 10 ] whileTrue: [ z := z + i.   i := i + 1.  ]. 

	^ z == 55! !

!CinnabarTestFib methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 13:31'!
ttestWhileTrueColonUnflat

	| i z a b |

	i := z := 0.

	a := [ i <= 10 ].

	b := [ z := z + i.   i := i + 1.  ]. 

	a whileTrue: b.

	^ z == 55! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

CinnabarTestFib class
	instanceVariableNames: ''!

!CinnabarTestFib class methodsFor: 'as yet unclassified' stamp: 'strick 2/16/2006 03:10'!
five

	^ 5! !

!CinnabarTestFib class methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 14:44'!
nine

	^ (self five) + (CinnabarTestFib five) - 1! !

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

!CinnabarTestFloat methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 21:11'!
ttest12

	[ 12.0 = ( 3.0 + 9.0 ) ] assert.
	[ 12.1 ~= ( 3.0 + 9.0 ) ] assert.
	[ 12.0 >= ( 3.0 + 9.0 ) ] assert.
	[ 12.1 >= ( 3.0 + 9.0 ) ] assert.
	[ 12.1 > ( 3.0 + 9.0 ) ] assert.
	[ 12.0 <= ( 3.0 + 9.0 ) ] assert.
	[ 12.0 <= ( 3.1 + 9.0 ) ] assert.
	[ 12.0 < ( 3.1 + 9.0 ) ] assert.

	[ 12.0 = 12 ] assert.

	^ true! !


Object subclass: #CinnabarTestFruit
	instanceVariableNames: 'aaa bbb ccc'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarTestFruit methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:00'!
ones

	^ 1! !

!CinnabarTestFruit methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:03'!
ttest1

	^ 1 == self ones! !

!CinnabarTestFruit methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:20'!
ttest2

	^ 2 == self twos! !

!CinnabarTestFruit methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:02'!
twos

	^ 2! !


CinnabarTestFruit subclass: #CinnabarTestApple
	instanceVariableNames: 'one two three'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarTestApple 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! !

!CinnabarTestApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:01'!
ones

	^ 10 + super ones! !

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

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

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

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

!CinnabarTestApple 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! !

!CinnabarTestApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:04'!
ttest1

	^ 1 == super ones! !

!CinnabarTestApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:04'!
ttest11

	^ 11 == self ones! !

!CinnabarTestApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:05'!
ttest2

	^ 2 == self twos! !

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

	someVar _ 42.
	^someVar.! !


CinnabarTestApple subclass: #CinnabarTestGreenApple
	instanceVariableNames: 'xray yankee zulu'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarTestGreenApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:02'!
ones

	^ 100 + super ones! !

!CinnabarTestGreenApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:06'!
ttest11

	^ 11 == super ones! !

!CinnabarTestGreenApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:06'!
ttest111

	^ 111 == self ones! !

!CinnabarTestGreenApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:05'!
ttest2

	^ 2 == super twos! !

!CinnabarTestGreenApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:05'!
ttest202

	^ 202 == self twos! !

!CinnabarTestGreenApple methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:02'!
twos

	^ 200 + super twos! !


Object subclass: #CinnabarxBase
	instanceVariableNames: 'set list fileStream depth howManyDone'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!
!CinnabarxBase commentStamp: '<historical>' prior: 0!
This base contains both a Set of Classes and a Write Stream for output.

Automatically adds superclasses and metaclasses.

Generates things in order of dependancies, based on superclassses.
!


!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:29'!
addClassSupersAndMetas: aClass

	(set includes: aClass) ifFalse: [

		" do the supers before adding to 'list' "
		aClass superclass ifNotNil: [ self addClassSupersAndMetas: aClass superclass ].

		" supers have metas, so we might have already been done, so check again. "
		(set includes: aClass) ifFalse: [
			set add: aClass.
			list add: aClass.
		].

		" add metaclass last "
		self addClassSupersAndMetas: aClass class.

	].
! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 3/5/2006 20:08'!
addImportantClasses

	self addClassSupersAndMetas: Object.
	self addClassSupersAndMetas: CinnabarxCFunction.
	self addClassSupersAndMetas: CinnabarxClosure.
	self addClassSupersAndMetas: CinnabarxContextBase.

	self addClassSupersAndMetas: True.
	self addClassSupersAndMetas: False.
	self addClassSupersAndMetas: Character.
	self addClassSupersAndMetas: UndefinedObject.
	self addClassSupersAndMetas: IdentityDictionary.
	self addClassSupersAndMetas: TranscriptStream.
	self addClassSupersAndMetas: SmallInteger.
	self addClassSupersAndMetas: Float.
	self addClassSupersAndMetas: ByteString.
	self addClassSupersAndMetas: ByteSymbol.
	self addClassSupersAndMetas: Array.
! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:57'!
cleanString: aString max: max
	^ self 
		string: (

			aString collect: [:c | $  <= c
							ifTrue: [c]
							ifFalse: [$ ]
				]

		) max: max! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 22:47'!
close

	fileStream close.

	" prevent any further work by nilling out fields "
	set := list := fileStream := nil.! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 22:53'!
comment: something 

	" trailing space prevents trailing ${ or $} which indicate nesting "

	self write: '// ' , (self cleanString: something asString max: 999) , ' '! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 11:34'!
doAll

	howManyDone := 0.

	list do: [ :aClass | self doOneClass: aClass ].! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 11:32'!
doOneClass: aClass

	howManyDone := howManyDone + 1
! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:49'!
escapeStringForC: aString 
	^ aString
		inject: ''
		into: [:b :c | 
			| x | 
			x := c codePoint.
			x < 32 | (x > 126)
				ifTrue: [b, '\' , (x // 64) asString , (x // 8 \\ 8) asString , (x \\ 8) asString]
				ifFalse: [('\''"' includes: c)
						ifTrue: [b , '\'
								, (ByteString with: c)]
						ifFalse: [b
								, (ByteString with: c)]]]! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:03'!
fileName: aFilename

	fileStream := (StandardFileStream forceNewFileNamed: aFilename)! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:04'!
fileStream

	^ fileStream! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 00:09'!
fileStreamInMemory

	" use an in-memory buffer for the file stream "

	fileStream := (WriteStream with: String new) initialize.! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:04'!
fileStream: aFileStream

	fileStream := aFileStream! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 3/9/2006 08:56'!
generateClassDefinition: aClass useIfdef: useIfdef

	| className superClassName clsObjName superC fdn metatype |


	self write: ''.
	self comment: aClass name.
	self write: ''.

	className := self tr: aClass name.
	clsObjName := 'C_' , className , '_ClsObj'.	

	(className endsWith: '$32$class') ifTrue: [
		metatype := 'struct C_Metaclass'.
	] ifFalse: [
		metatype := 'struct C_', className, '$32$class'.
	].

	superC := aClass superclass.
	superC
		ifNil: [ superClassName := 'Header' ]
		ifNotNil: [ superClassName := 'C_' , (self tr: superC name). ].

	useIfdef ifTrue: [
		self write: '#ifndef  C_' , className , '_TypeNumber'.
		self write: 'static word  C_' , className , '_TypeNumber;'.

		self myInits write: '#ifndef  C_' , className , '_TypeNumber'.
		self myInits write: 'C_' , className , '_TypeNumber = InternSymbol("', (self escapeStringForC: aClass name), '")->hash();'.
		self myInits write: clsObjName,'Ptr = (',metatype,'*) RuntimeCreateClass(PASS_VAT  C_',className,'_TypeNumber, sizeof(C_',className,'), &C_',(self tr: superC name),'_ClsObj, &C_',(self tr: aClass class name),'_ClsObj );'.
		self myInits write: '#endif'.

		fdn := nil.
	] ifFalse: [
		fdn := self foundation.
		self write: '#define   C_' , className , '_TypeNumber    ', (fdn intern: aClass name).
	].

	self write: 'struct C_' , className , ' : public ' , superClassName , ' /*' , aClass kindOfSubclass , '*/ {'.

		(aClass instanceVariablesString findTokens: ' ')
			do: [:var | self write: 'oop f_' , var , ';'].

		fdn ifNotNil: [
			(fdn extraFields at: aClass ifAbsent: [#()]) 
					do: [ :x | self write: 'oop ', x, ';' ].
		].

	self write: '/*' , aClass instSize asString , '*/ }'.
	self write: ';'.


	"--- be curious about big class objects ---"
	(('*$32$class' match: className)
			and: [11 ~= aClass instSize])
		ifTrue: [self write: '/*EXTRA CLASS VAR NAMES: ' , aClass instVarNames asString , '*/'].

	useIfdef ifTrue: [
		self write: 'static ',metatype,'* ' , clsObjName , 'Ptr;'.

		self write: '#define   ',clsObjName, '   (*',clsObjName,'Ptr)'.

		self write: '#endif'.
	] ifFalse: [

		self write: 'extern  ',metatype,'  ',clsObjName,';'.

	].
! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 22:52'!
initialize

	super initialize.

	set := IdentitySet new.
	list := OrderedCollection new.

	fileStream := nil.    "use #toFile: to assign"
	depth := 0.! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:27'!
list

	^ list! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 22:59'!
newline

	fileStream nextPut: Character lf.! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 17:28'!
nocomment: something 

	"-- don't write comment --"! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 00:14'!
split: aString on: separatorString

	^ aString findTokens: separatorString! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:55'!
string: aString max: max

	aString size > max 

		ifTrue: [ ^ (aString copyFrom: 1 to: max), '...' ]

		ifFalse: [ ^ aString ]! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 20:52'!
tr: aString 
	"
	self new tr: 'foo-bar class'
	
	Optimize: just return the string if all AlphaNumeric.
	Otherwise rebuild the string.
	"
	(aString
			inject: true
			into: [:z :c | z and: [c codePoint < 128] and: [c isAlphaNumeric]]
	)
		ifTrue: [^ aString].


	^ aString
		inject: ''
		into: [:b :c | (c codePoint < 128 & c isAlphaNumeric)
				ifTrue: [b := b , (ByteString with: c)]
				ifFalse: [b := b , '$' , c codePoint asString , '$']
			]! !

!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 00:11'!
write: aString 

	"
	  A Pretty-Writer for generating C code -- writes one line. 
	  The last character in the string can be ${ or $} to guide nesting.
	"

	| n tail |
	n := aString size.

	"set tail to last char, or to something bogus like $$ if empty"
	n > 0
		ifTrue: [tail := aString at: n]
		ifFalse: [tail := $$].
	$} = tail
		ifTrue: [depth := depth - 1].

	self assert: depth >= 0.

	" write indentation based on depth "
	1 to: depth do: [:i | fileStream nextPutAll: '    '].

	fileStream nextPutAll: aString.
	self newline.

	${ = tail
		ifTrue: [depth := depth + 1]! !


TestCase subclass: #CinnabarxBigTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxBigTests methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 22:23'!
closureOfSupers: aCollection 
"
self new closureOfSupers: #( IdentityDictionary )

(self new closureOfSupers: #( CinnabarTestFib CinnabarTestFruit CinnabarTestApple CinnabarTestGreenApple	Object True False Character 	UndefinedObject IdentityDictionary TranscriptStream SmallInteger ByteString ByteSymbol Array ) ) asArray sort
"

	^ self closureOfSupers: aCollection into: Set new
! !

!CinnabarxBigTests methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 22:23'!
closureOfSupers: aCollection into: aSet

	aCollection do: [ :x | | c |
		(aSet includes: x) ifFalse: [
			aSet add: x.
			c := Smalltalk at: x.
			c superclass ifNotNil: [ self closureOfSupers: { c superclass name } into: aSet. ].
		].
	].

	^ aSet.

! !

!CinnabarxBigTests methodsFor: 'as yet unclassified' stamp: 'strick 3/4/2006 22:58'!
testBig
"
self new testBig
"

	| d v i t list |

	d := CinnabarxGenDeclaratons new fileName: '_gen_header.h'.
	v := CinnabarxGenVariables new fileName: '_gen_objects.h'.
	i :=  CinnabarxGenInitializations new fileName: '_gen_inits.h'.

	d addImportantClasses.
	v addImportantClasses.
	i addImportantClasses.

	list := #( Integer ).

	list := (self closureOfSupers: #( 
		CinnabarTestFib CinnabarTestFruit CinnabarTestApple CinnabarTestGreenApple
		Object True False Character DateAndTime
		Class Metaclass
		UndefinedObject IdentityDictionary TranscriptStream
		SmallInteger ByteString ByteSymbol Array
	)) asArray sort.


     list do: [ :clsName |
		Utilities informUser: (' Cinnabarx Translating Class:  ', clsName, '  ') during: [

			t := CinnabarxTranslateClass new fileName: '_', clsName, '.cc'.
			t masterDecls: d masterVars: v masterInits: i.

			t translateClass: (Smalltalk at: clsName).

			t fileStream close.
		]
	].

	d doAll fileStream close.
	v doAll fileStream close.
	i doAll fileStream close.





! !


Object subclass: #CinnabarxCFunction
	instanceVariableNames: 'numArgs name'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!
!CinnabarxCFunction commentStamp: '<historical>' prior: 0!
The runtime objects representing compiled C Functions for Smalltalk Blocks.  

An extra field 'x_entry' (not directly usable from Smalltalk) holds the memory address of the function (as a raw pointer with the low tag bit added so the garbage collector will ignore it).
  !



Object subclass: #CinnabarxClosure
	instanceVariableNames: 'function context myself id'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!
!CinnabarxClosure commentStamp: '<historical>' prior: 0!
The runtime closure objects representing Smalltalk Block Closures that can be sent #value...!



Object subclass: #CinnabarxContextBase
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!
!CinnabarxContextBase commentStamp: '<historical>' prior: 0!
A base class for runtime context objects for holding captured variables that might be used my multple blocks and scopes!



Object subclass: #CinnabarxFirstPass
	instanceVariableNames: 'blockParents blockStack method class blockIsFlat specialFlatCases captures generator selfIsCaptured'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

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

!CinnabarxFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 21:35'!
initialize
	blockParents := Dictionary new.
	blockStack := OrderedCollection new.
	blockIsFlat := Dictionary new.
	"captures : aScope -> aDictionary : aString -> true"
	captures := IdentityDictionary new.
	specialFlatCases := IdentitySet 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: ;
	 	 add: #whileFalse ;
		 add: #whileTrue .
! !

!CinnabarxFirstPass 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! !

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

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

!CinnabarxFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 2/16/2006 02:18'!
visitBlockNode: aBlockNode 


	| shouldBeTheBlockNode |

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

" (blockIsFlat at: aBlockNode ifAbsent: [false]) ifTrue: [ self break ]."
	(blockIsFlat at: aBlockNode ifAbsent: [false]) ifTrue: [
		"self break" "----------- will need to push our args & temps up higher"
	].

	"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) .
	]

! !

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

!CinnabarxFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 2/16/2006 01:45'!
visitCascadeNode: aCascadeNode 

	aCascadeNode receiver acceptVisitor: self.

	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)].! !

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

	nil.! !

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

	nil.! !

!CinnabarxFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 21:37'!
visitMessageNode: aMessageNode 
	| selector n |
	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 receiver class == BlockNode
						ifTrue: [ blockIsFlat at: aMessageNode receiver put: true ].
				aMessageNode arguments
					do: [:arg | arg class == BlockNode
						ifTrue: [ blockIsFlat at: arg put: true]
					]
		].
	aMessageNode receiver acceptVisitor: self.

	n := (self howManyArgsForSelector: selector).
	aMessageNode special ifNotNil: [
		(0 < aMessageNode special) & (aMessageNode special < 11) ifTrue: [ n := 2 ].
	].
	n > aMessageNode arguments size ifTrue: [ n := aMessageNode arguments size ].

	1 to: n
		do: [:i | 
			| node | 
			node := aMessageNode arguments at: i.
			node
				ifNotNil: [node acceptVisitor: self]]
! !

!CinnabarxFirstPass 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! !

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

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

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

	aReturnNode expr acceptVisitor: self
! !

!CinnabarxFirstPass methodsFor: 'as yet unclassified' stamp: 'strick 2/16/2006 02:19'!
visitTempVariableNode: v 
	v name = 's' & false " & (method selector = #primitiveError:)"
		ifTrue: [self break].
	blockStack size
		to: 1
		by: -1
		do: [:i | 
			| b | 
			b := blockStack at: i.
			b arguments
				do: [:arg | "arg name = v name" arg == v
						ifTrue: [^ self]].
			b temporaries
				ifNotNil: [b temporaries
						do: [:arg | "arg name = v name" arg == v
								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" arg == v
										ifTrue: [self rememberCapturedVariable: v name inScope: bb.
											^ self]].
							bb temporaries
								ifNotNil: [bb temporaries
										do: [:arg | "arg name = v name" arg == v
												ifTrue: [self rememberCapturedVariable: v name inScope: bb.
													^ self]]].
							blockIsFlat keys includes: bb].
					"special case for weird loop termination *LimiT vars"
					(v name endsWith: 'LimiT')
						ifTrue: [^ nil].
					self assert: nil == 'Should not be reached']]! !

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

	nil.! !


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

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

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

	^ blockParents! !

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

	blockParents _ anObject! !

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

	^ blockStack! !

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

	blockStack _ anObject! !

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

	class _ anObject! !

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

	^ method! !

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

	method _ anObject! !

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

	^ specialFlatCases! !

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

	specialFlatCases _ anObject! !


Object subclass: #CinnabarxFoundation
	instanceVariableNames: 'version decls vars inits model extraFields'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 20:40'!
addClassToFoundation: aClass

	#incr == model ifFalse: [
		decls addClassSupersAndMetas: aClass.
		vars addClassSupersAndMetas: aClass.
		inits addClassSupersAndMetas: aClass.
	].! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 20:59'!
closureOfSubs: aCollection 
"
self new closureOfSubs: #( Set )
"

	^ self closureOfSubs: aCollection into: Set new
! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 21:21'!
closureOfSubs: aCollection into: aSet

	aCollection do: [ :x | | c |
		(aSet includes: x) ifFalse: [
			c := Smalltalk at: x ifAbsent: [ nil ].
			c ifNotNil: [
				c class == Metaclass ifFalse: [
					aSet add: x.
					c subclasses do: [ :sub | self closureOfSubs: { sub name } into: aSet. ].
				].
			].
		].
	].

	^ aSet.

! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:05'!
closureOfSupers: aCollection 
"
self new closureOfSupers: #( IdentityDictionary )

(self new closureOfSupers: #( CinnabarTestFib CinnabarTestFruit CinnabarTestApple CinnabarTestGreenApple	Object True False Character 	UndefinedObject IdentityDictionary TranscriptStream SmallInteger ByteString ByteSymbol Array ) ) asArray sort
"

	^ self closureOfSupers: aCollection into: Set new
! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 21:13'!
closureOfSupers: aCollection into: aSet

	aCollection do: [ :x | | c |
		(aSet includes: x) ifFalse: [
			aSet add: x.
			c := Smalltalk at: x ifAbsent: [nil].
			c ifNotNil: [
				c superclass ifNotNil: [ self closureOfSupers: { c superclass name } into: aSet. ].
			].
		].
	].

	^ aSet.

! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 13:02'!
extraFields

	^ extraFields! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 19:10'!
generateDefinesForSymbolsTo: aDcls


	inits generateDefinesForSymbolsTo: aDcls
! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/7/2006 23:40'!
initialize

	super initialize.

	version := DateAndTime now asSeconds.

	extraFields := IdentityDictionary new.

	extraFields at: Behavior put: #( 
		#'x_name'				"--temporary--"
		#'x_typeNumber'		"index in the phone book"
		#'x_numFixedOops'		"how many fixed oop fields are in instances"
		#'x_funcMap'			"pointer to cinnabarx-specific structure (WRAPPED)"
		#'x_arrayShape'		"array shape of instances"
		#'x_senderCacheChain'	"SenderCaches to be invalidated when behavior is updated (WRAPPED)"
		#'x_debugName'			"easy way to print what class/metaclass it is"
	).

	extraFields at: CinnabarxCFunction put: #(
		#'x_entry'				"address of C function (WRAPPED)"
	).


! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 15:32'!
intern: aSymbol

	^ inits ifNotNil: [inits intern: aSymbol]! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 4/8/2006 16:11'!
largeArrayOfClasses

"
  self new largeArrayOfClasses
"


	^ (self closureOfSupers: 
		( self closureOfSubs: 
			#( 
				UndefinedObject True False Integer Character DateAndTime
				Behavior Set Array SequenceableCollection Magnitude Collection ParseNode
				CinnabarxCFunction CinnabarxClosure CinnabarxContextBase
	))) asArray sort.

! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/13/2006 08:05'!
mediumArrayOfClasses

"
	self new mediumArrayOfClasses
"

	^ (self closureOfSupers: #( 
		CinnabarTestFib CinnabarTestFruit CinnabarTestApple CinnabarTestGreenApple
		Object True False Character DateAndTime
		Class Metaclass
		UndefinedObject IdentityDictionary TranscriptStream
		SmallInteger ByteString ByteSymbol Array
	)) asArray sort.

! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:17'!
model

	^model! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:15'!
model: aModelSymbol

	model := aModelSymbol! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 13:26'!
smallArrayOfClasses

	^ #( 
		CinnabarTestFib CinnabarTestFruit CinnabarTestApple CinnabarTestGreenApple
	) asArray sort.

! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/9/2006 07:34'!
translateClassesIncr: list

	self model: #incr.

	decls := nil.
	vars := nil.
	inits := nil.

     list do: [ :clsName |
		Utilities informUser: ('Cinnabarx Translating Class:  ', clsName, '  (incr)') during: [
			| t |

			t := CinnabarxTranslateClass new. 
			t fileName: '__', clsName, '.cc'.
			t foundation: self.

			t translateClass: (Smalltalk at: clsName).

			t fileStream close.
		]
	].






! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:56'!
translateClasses: list

	decls := CinnabarxGenDeclaratons new fileName: '_gen_header.h'.
	vars := CinnabarxGenVariables new fileName: '_gen_objects.h'.
	inits :=  CinnabarxGenInitializations new fileName: '_gen_inits.h'.

	decls foundation: self.
	vars foundation: self.
	inits foundation: self.

	decls addImportantClasses.
	vars addImportantClasses.
	inits addImportantClasses.

     list do: [ :clsName |
		Utilities informUser: (' Cinnabarx Translating Class:  ', clsName, '  ') during: [
			| t |

			t := CinnabarxTranslateClass new. 
			t fileName: '_', clsName, '.cc'.
			t foundation: self.

			t translateClass: (Smalltalk at: clsName).

			t fileStream close.
		]
	].

	decls doAll fileStream close.
	vars doAll fileStream close.
	inits doAll fileStream close.





! !

!CinnabarxFoundation methodsFor: 'as yet unclassified' stamp: 'strick 3/7/2006 23:40'!
version

	^ version! !


CinnabarxBase subclass: #CinnabarxGenDeclaratons
	instanceVariableNames: 'foundation'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxGenDeclaratons methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 19:10'!
doAll

	self write: '#define CIN_FOUNDATION_VERSION ', foundation version asString.

	super doAll.

	foundation generateDefinesForSymbolsTo: self.


	! !

!CinnabarxGenDeclaratons methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 21:44'!
doOneClass: aClass

	super doOneClass: aClass.

	self generateClassDefinition: aClass useIfdef: false.
! !

!CinnabarxGenDeclaratons methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 21:46'!
foundation

	^ foundation! !

!CinnabarxGenDeclaratons methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:31'!
foundation: f

	foundation := f! !


CinnabarxBase subclass: #CinnabarxGenInitializations
	instanceVariableNames: 'symDict nextClassyNum nextTackyNum foundation symTable tBits tRange sBits sRange'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 11:41'!
doAll

	self doSymbols.

	list do: [ :aClass | self doInitializeClassBeforeDoingClasses: aClass ].

	super doAll.! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 11:37'!
doInitializeClassBeforeDoingClasses: aClass

	| className clsObjName |

	"we need to define class object and install in TypeTable before the #doOneClass: are called." 

	className := self tr: aClass name.

	clsObjName := 'C_' , className , '_ClsObj'.


	self write: 'TypeTable[ C_' , className , '_TypeNumber ]= & ' , clsObjName , ';'.
	self write: ''.
! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/13/2006 08:23'!
doOneClass: aClass

	| className clsObjName |
	super doOneClass: aClass.


	className := self tr: aClass name.

	clsObjName := 'C_' , className , '_ClsObj'.

	self write: ''.
	self write: 'ResetObject( & ',clsObjName,' );'.
	self write: clsObjName , '.setTypeNumber( C_', (self tr: aClass class name), '_TypeNumber );'.

	self write: clsObjName , '.setAge( AGE_IMMORTAL );'.
	self write: clsObjName , '.setHash( C_' , className , '_TypeNumber );'.
	self write: clsObjName , '.x_typeNumber = OopFromNum( C_' , className , '_TypeNumber );'.
	self write: clsObjName , '.f_format = OopFromNum( ',aClass format asString,' );'.
	self write: clsObjName , '.x_name = OopFromHeader( SymbolTable[', (self intern: aClass name), '] );'.
	aClass superclass ifNil: [		
		self write: clsObjName , '.f_superclass = OopNil;'.
	] ifNotNil: [
		self write: clsObjName , '.f_superclass = OopFromHeader(& C_' ,(self tr: aClass superclass name) , '_ClsObj);'.
	].

	aClass isVariable
		ifFalse: [ self write: clsObjName , '.x_arrayShape = OopFromNum(ARRAY_NONE);' ]
		ifTrue: [
			aClass isBits
				ifTrue: [
					aClass isBytes
						ifTrue: [ self write: clsObjName , '.x_arrayShape = OopFromNum(ARRAY_BYTES);']
			 			ifFalse: [ self write: clsObjName , '.x_arrayShape = OopFromNum(ARRAY_WORDS);'].
				]
			 	ifFalse: [ self write: clsObjName , '.x_arrayShape = OopFromNum(ARRAY_OOPS);'].
		].

	self write: clsObjName , '.x_numFixedOops = OopFromNum((sizeof(C_',className,')-sizeof(Header))/sizeof(word));'.

	"<<self write: '// ' , aClass allInstVarNames asString.>>"

	self write: ''.
! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 20:48'!
doSymbols

	symDict keys asArray sort do: [ :s |

		self write: 'InternSymbolAt( "', (self escapeStringForC: s), '", ', (symDict at: s),' );'.

	].
 ! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:37'!
foundation: f

	foundation := f! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 19:21'!
generateDefinesForSymbolsTo: aDcls

	symDict keys asArray sort do: [ :s |

		aDcls write: '#define Sym_', (self tr: s), ' ', (symDict at: s) asString.

	].! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 21:17'!
initialize

	tBits :=  15.
	tRange := 1 bitShift: tBits.

	sBits :=  32 - tBits.
	sRange := 1 bitShift: sBits.

	symDict := Dictionary new.
	symTable := Array new: sRange.

	self intern: #SmallInteger.		"must be 0"
	self intern: #ByteSymbol.	

	super initialize.! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 19:13'!
insertSymbol: sym starting: start range: range

	"---add one to index of symTable, so it is 0-based---"

	| h |

	h := (self stringHash: sym) \\ range.

	start+h to: start+range-1 do: [ :i |
		(symTable at: i+1) ifNil: [
			symTable at: i+1 put: sym.
			symDict at: sym put: i.
			^ i asString
		]
	].
 
	start to: start+h-1 do: [ :i |
		(symTable at: i+1) ifNil: [
			symTable at: i+1 put: sym.
			symDict at: sym put: i.
			^ i asString
		]
	].
 
	self error: 'Symbol table is full'
! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 19:12'!
intern: sym

	"-- returns the SymbolTable index of the sym, inserting it if absent --"


	^ symDict at: sym ifAbsentPut: [

		(self stringIsClassy: sym) ifTrue: [

			self insertSymbol: sym starting: 0 range: tRange

		] ifFalse: [

			self insertSymbol: sym starting: tRange range: sRange - tRange

		]

	]! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 18:43'!
stringHash: s

"
	(self new stringHash: #SmallInteger)
"

	"--- 28bit hash of string -- The constant  171460249 is added to make SmallInteger have hash 0 ---"


	^ ( 
		s inject: 0 into: [:z :c | (z*7 + c codePoint) bitAnd: 16rFFFFFFF ]
       ) +  171460249 bitAnd: 16rFFFFFFF! !

!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 18:37'!
stringIsClassy: s

	"if it begins with a Capital Letter, it is Classy"

	^  (s size > 0) and: [$A <= s first] and: [s first <= $Z]
! !


CinnabarxBase subclass: #CinnabarxGenVariables
	instanceVariableNames: 'foundation'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxGenVariables methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 11:38'!
doOneClass: aClass

	| className clsObjName |
	super doOneClass: aClass.


	className := self tr: aClass name.
	clsObjName := 'C_' , className , '_ClsObj'.

	(className endsWith: '$32$class') ifTrue: [
		"cannot use ClassDescription of Metaclass yet (due to category abuse)"
		self write: 'struct C_Metaclass ' , clsObjName , ';'.
	] ifFalse: [
		self write: 'struct C_', className, '$32$class ' , clsObjName , ';'.
	].
! !

!CinnabarxGenVariables methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:38'!
foundation: f

	foundation := f! !


TestCase subclass: #CinnabarxTestLargeIncrModel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxTestLargeIncrModel methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 21:27'!
testDoTranslate

"
	self new testDoTranslate
"

	| f |

	f := CinnabarxFoundation new.

	f translateClassesIncr:  f smallArrayOfClasses.


! !


TestCase subclass: #CinnabarxTestLargeModel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxTestLargeModel methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 21:22'!
testDoTranslate

"
	self new testDoTranslate
"

	| f |

	f := CinnabarxFoundation new.
	f model: #large.
	f translateClasses: f largeArrayOfClasses.

! !


TestCase subclass: #CinnabarxTestMediumModel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxTestMediumModel methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:59'!
testDoTranslate

"
	self new testDoTranslate
"

	| f |

	f := CinnabarxFoundation new.
	f model: #medium.
	f translateClasses: f mediumArrayOfClasses.

! !


TestCase subclass: #CinnabarxTestNextIncrModel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxTestNextIncrModel methodsFor: 'as yet unclassified' stamp: 'strick 3/24/2006 10:47'!
testDoTranslate

"
	self new testDoTranslate
"

	| f |

	f := CinnabarxFoundation new.

	f translateClassesIncr:  #( CinnabarTestCollections CinnabarTestFloat EncodedCharSet FileDirectory FloatArray ).


! !


TestCase subclass: #CinnabarxTestSmallIncrModel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxTestSmallIncrModel methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 20:52'!
testDoTranslate

"
	self new testDoTranslate
"

	| f |

	f := CinnabarxFoundation new.

	f translateClassesIncr: #( CinnabarTestFib ).

! !


TestCase subclass: #CinnabarxTestSmallModel
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxTestSmallModel methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 20:38'!
testDoTranslate

"
	self new testDoTranslate
"

	| f |

	f := CinnabarxFoundation new.
	f model: #small.
	f translateClasses: f smallArrayOfClasses.
	f translateClassesIncr: #( CinnabarTestFib ).

! !


CinnabarxBase subclass: #CinnabarxTranslateClass
	instanceVariableNames: 'nextSerialNumber myDecls myInits body specialCases firstPass blockStack method contextStack saveStack theClass captureStack senderCacheArraySize specialOperations foundation nonLocalReturnUsed'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/26/2006 11:46'!
aboutUnknownISSUES

"<<

Object decompile: #caseOf:
  the printing of the decompile is WRONG:  (* 
   caseOf: t1 
	^ self caseOf: t1
*)
   The message-send (really to #caseOf:otherwise:) is special: 14.
DOES NOT SEEM TO BE ANY ACTUAL SENDERS OF #caseOf: NOR OF #caseOf:otherwise:

MessageNode class 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:).
... and more ... *)

--------------------------------------------------------

Smalltalk keys select: [ :k |  (Smalltalk at: k) isBehavior not ] 
   an IdentitySet(#Undeclared #Transcript #Smalltalk #ScheduledControllers #WonderlandConstants #Sensor #ActiveEvent #References #SourceFiles #ActiveHand #SystemOrganization #World #ScriptingSystem #Processor #ImageImports #ActiveWorld #Display #TextConstants #CustomEventsRegistry)
----------------------------------------------------------

>>"! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:24'!
addClassToFoundation: aClass

	foundation addClassToFoundation: aClass

! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 20:16'!
declareClassVariables

	[ theClass isMeta not ] assert.   "should be the real class"

	theClass allClassVarNames do: [:cv|  |cvar|

		cvar := 'ClsVar_', theClass name, '_', cv.

		self write: 'static oop ', cvar, ';'.

	].
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 10:02'!
declareParameters: aParameterArray

	^ aParameterArray inject: '' into: [ :z :x | z, ', oop ', x ] ! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 10:06'!
defineArgumentVariables: anArgArray

	| num |

	num _ 0.

	^ anArgArray inject: '' into: [ :z :arg |

		num := num + 1.

		z, '  oop arg', (num asString),' = ', (arg acceptVisitor: self),'  ;;;  '.
	].
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 17:30'!
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 nocomment: 'LastN=' , lastN , ' ... Entering Scope:'.
	body 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]).
	body nocomment: 'captureStack: ' , captureStack asString.
	body nocomment: 'contextStack: ' , contextStack asString.
	body nocomment: 'blockStack: ' , blockStack size asString.
	"-" 
		captures do: [:v | body comment: '!!!!!!!! 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.
			myDecls write: 'struct context_' , n , ' : public C_CinnabarxContextBase {'.
			contextStack size > 0
				ifTrue: [myDecls write: 'oop octx_' , lastN , ';'].
			captures
				do: [:v | myDecls write: 'oop v_' , v name , ';'].
			myDecls write: '}'.
			myDecls write: ';'.
			body write: 'oop octx_' , n , '= BasicNewColon(PASS_VAT  &C_Array_ClsObj, ' , (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 nocomment: 'pushed to ' , contextStack asString
		]
		ifFalse: [body nocomment: 'no captures, so dont push to ' , contextStack asString]! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 17:30'!
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 nocomment: 'exitScope: removeLast from ' , contextStack asString.
			contextStack removeLast]
		ifFalse: [body nocomment: 'exitScope: 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 nocomment: 'Exiting Scope: ', aScope asString.
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/26/2006 11:26'!
flattenBlockNode: aBlockNode 
	| n z i numStatements |

	aBlockNode class == BlockNode ifFalse: [ ^ self flattenNonBlockNode: aBlockNode ]. 


	n := self serial asString.

	(firstPass blockIsFlat: aBlockNode)
		ifTrue: [self enterScope: aBlockNode. z := 'flat_' , n.  ]
		ifFalse: [ z := 'unflat_' , n. ].

	body write: 'oop ' , z , '= OopNil;'.

	body write: '/*(',n, ')*/ {'.
	i := 1.
	numStatements := aBlockNode statements size.
	aBlockNode statements
		do: [:aStmt | 
			| stmtResult | 
			stmtResult := aStmt acceptVisitor: self.

			"only on the last statement do we assign z the stmtResult"
			i = numStatements
				ifTrue: [body write: z , '= ' , stmtResult asString , ';'].

			i := i + 1.
	].
	body write: '/*(',n, ')*/  }'.

	(firstPass blockIsFlat: aBlockNode)
		ifTrue: [self exitScope: aBlockNode].
	^ z! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 22:25'!
flattenNonBlockNode: aNode
	| msg |

	body comment: '(*flattenNonBlockNode:*) ', aNode asString. 

	"-- create a synthetic MessageNode to send #value to the node. --"

	msg := MessageNode new.

	msg receiver: aNode.
	msg selector: ( SelectorNode new key: #value; yourself ).
	msg arguments: #().

	^ msg acceptVisitor: self.	

! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 12:20'!
foundation

	^ foundation! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 13:10'!
foundation: aCinnabarxFoundation

	foundation := aCinnabarxFoundation.

	#small == foundation model   ifTrue: [

		specialCases
			at: #basicNew put: #messageBasicNew: ;
			at: #basicNew: put: #messageBasicNewColon: .
	].! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 21:55'!
generateClassDefinitionRecursively: aClass

	aClass superclass ifNotNil: [
		self generateClassDefinitionRecursively: aClass superclass
	].

	self generateClassDefinition: aClass useIfdef: true.


! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 20:42'!
generateMethodInstalls

	" --- install methods for theClass itself "

	theClass methodDict keys size = 0 ifTrue: [
		self write: 'InsertNoFunctions(cls);'
	] ifFalse: [
		theClass methodDict keys asArray sort do: [ :k |  | kk |  kk := self tr: k.

			self write: '{'.
			#incr == foundation model ifTrue: [
				self write: 'Symbol* s= InternSymbol( "', (self escapeStringForC: k), '" );'.
			] ifFalse: [
				self write: 'Symbol* s= SymbolTable[', (foundation intern: k), '];'.
			]. 

			self write: 'InsertFunction( cls, s, (FUNC*) Func_', theClass name, '_', kk, ');'.

			self write: '}'.
		].
	].

	" --- install methods for the metaclass "
	theClass class methodDict keys size = 0 ifTrue: [
		self write: 'InsertNoFunctions(superCls);'
	] ifFalse: [
		theClass class methodDict keys asArray sort do: [ :k |  | kk |  kk := self tr: k.

			self write: '{'.
			#incr == foundation model ifTrue: [
				self write: 'Symbol* s= InternSymbol( "', (self escapeStringForC: k), '" );'.
			] ifFalse: [
				self write: 'Symbol* s= SymbolTable[', (foundation intern: k), '];'.
			]. 


			self write: 'InsertFunction( superCls, s, (FUNC*) Func_', theClass name, '$32$class_', kk, ');'.

			self write: '}'.
		].
	].
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/5/2006 21:03'!
initialize

	super initialize.

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

	senderCacheArraySize := 0.
	nextSerialNumber := 0.
	myDecls := CinnabarxBase new fileStreamInMemory.
	myInits := CinnabarxBase new fileStreamInMemory.
	body := CinnabarxBase new fileStreamInMemory.

	"Make a table for special message cases"
	specialCases := Dictionary new.
	specialOperations := Dictionary new.

	specialOperations
		at: #'==' put: 'Prim_EQEQ' ;
		at: #'~~' put: 'Prim_NENE' .

	specialOperations
		at: #= put: 'Prim_7_Equal' ;
		at: #'~=' put: 'Prim_8_NotEqual' ;
		at: #< put: 'Prim_3_LessThan' ;
		at: #> put: 'Prim_4_GreaterThan' ;
		at: #'<=' put: 'Prim_5_LessOrEqual' ;	
		at: #'>=' put: 'Prim_6_GreaterOrEqual' ;

		 at: #+ put: 'Prim_1_Add' ;
		 at: #- put: 'Prim_2_Subtract' ;
		 at: #* put: 'Prim_9_Multiply' ;
		 at: #/ put: 'Prim_10_Divide' ;
		 at: #'//' put: 'Prim_12_Div' ;
		 at: #\\ put: 'Prim_11_Mod' ;
		 at: #quo: put: 'Prim_13_Quo' ;

		at: #bitAnd put: 'Prim_14_BitAnd' ;		
		at: #bitOr put: 'Prim_15_BitOr' ;
		at: #bitXor put: 'Prim_16_BitXor' ;
		at: #bitShift: put: 'Prim_17_BitShift' .

"<<
		at: #basicNew put: #messageBasicNew: ;
		at: #basicNew: put: #messageBasicNewColon: ;
>>"

	specialCases
		at: #say put: #messageSay: ;
		
		at: #error: put: #messageErrorColon: .

	"*** both to:by:do: and to:do: are handled by #specialForLoop:  ***"
	specialCases
		at: #to:by:do: put: #specialForLoop:  ;
		
		at: #to:do: put: #specialForLoop: .! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 20:26'!
initializeClassVariables

	[ theClass isMeta not ] assert.   "should be the real class"

	theClass allClassVarNames do: [:cv|  |cvar|

		cvar := 'ClsVar_', theClass name, '_', cv.

		myInits write: cvar, '= ', (self literal: (theClass classPool at: cv ifAbsent: [nil])), ';'.
	].
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 21:29'!
literalArray: litArray 

	"--- This has been made to work for any array type with no fixed slots, by using the litArray's class name.
	The main danger is circular pointers or pointers to everything getting in here.
	Hope that doesn't happen. ---"

	| n z |

	litArray class allInstVarNames size > 0 ifTrue: [ 
		^ self unimplemented: 'LiteralArray with instance vars: ', litArray class name.
	].

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

	myDecls write: 'static oop ' , z , ';'.

	"BUG: expecting the litArray class to be precompiled in the foundation"
	myInits write: z , '= BasicNewColon(PASS_VAT  & C_',litArray class name,'_ClsObj, ' , litArray basicSize asString , ');'.
	myInits write: 'assert(' , z , ');'.

	1 to: litArray basicSize do: [:i | 

			myInits write: 
					'Prim_BasicAtPut(PASS_VAT  ' , 
					z , 
					',  NULL, OopFromNum(' , i asString , '), ' , 
					(self literal: (litArray basicAt: i)) , 
					');'

		].

	^ z
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 10:44'!
literalByteString: lit 
	| n z |
	n := self serial asString.
	z := 'str_' , n.

	myDecls write: 'static oop ' , z , ';'.

	myInits write: z , '= OopLiteralByteString(PASS_VAT  "'
			, (self escapeStringForC: lit asString) , '");'.
	myInits write: 'assert(' , z , ');'.

	^ z! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/17/2006 15:54'!
literalByteSymbol: lit 
	| n z |

z := self foundation  intern: lit.

z  ifNotNil: [
	z := 'OopFromHeader(SymbolTable[', z asString, '/*',(self escapeStringForC: lit),'*/])'
] ifNil: [
	n := self serial asString.
	z := 'sym_' , n.

	" --- TODO --- collaps these into single instance of each symbol --- "

	myDecls write: 'static oop ' , z , ';'.

	myInits write: z , '= OopFromHeader( InternSymbol( "', (self escapeStringForC: lit) , '") );'.
	myInits write: 'assert(' , z , ');'.
].

^ z.! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 20:20'!
literal: x 

	x == nil
		ifTrue: [^ 'OopNil' ].
	x == false
		ifTrue: [^ 'OopFalse' ].
	x == true
		ifTrue: [^ 'OopTrue' ].
	x class == SmallInteger
		ifTrue: [^ 'OopFromNum(' , x asString , ')'].
	x class == Character
		ifTrue: [^ 'OopFromHeader(&CharInstances[' , x codePoint asString , '])'].
	x class == Array
		ifTrue: [^ self literalArray: x].
	x class == ByteString
		ifTrue: [^ self literalByteString: x].
	x class == ByteSymbol
		ifTrue: [^ self literalByteSymbol: x].

	"any array of bytes"
	(x class isVariable and: [ x class isBytes ] ) ifTrue: [^ self literalArray: x].
	"any array of words"
	(x class isVariable and: [ x class isWords ] ) ifTrue: [^ self literalArray: x].

	^ self unimplemented: 
		'Literal(* ',  x class asString, ' : ' , (self escapeStringForC: x asString), ' *)'.
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:42'!
messageAdd: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:45'!
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! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:46'!
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! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 13:25'!
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 , '= Prim_BasicNewColon(PASS_VAT  ' , rcvr ,' ,NULL, ', arg1, ' );'.
	body write: 'if ( !! ' , z , ' ) goto ERROR;'.

	^ z! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/6/2006 13:25'!
messageBasicNew: aMessageNode 

	| n z rcvr |

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

	rcvr := aMessageNode receiver acceptVisitor: self.

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

	^ z! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:46'!
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! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:47'!
messageBitAnd: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:47'!
messageBitOr: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:47'!
messageBitShift: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:47'!
messageBitXor: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 14:48'!
messageConditional: aMessageNode

	
	| n rcvr nargs arg1 arg2 z |

	nargs := aMessageNode arguments size.
	self assert: (nargs == 1) | (nargs == 2).

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

	rcvr := aMessageNode receiver acceptVisitor: self.

	body write: 'oop ' , z , '= OopNil;   /*' , aMessageNode selector asString , '*/'.

	body write: 'if ( ',  ('OopToBool(PASS_VAT ' , rcvr , ')')  , ' ) {'.

	arg1 := self flattenBlockNode: aMessageNode arguments first.
	body write: z , '=' , arg1 , ';'.

	body write: '}'.
	body write: 'else {'.

	( nargs > 1 ) ifTrue: [
		arg2 := self flattenBlockNode: aMessageNode arguments second.
		body write: z , '=' , arg2 , ';'.
	] ifFalse: [
		body write: z , '=' , rcvr , ';'.
	].

	body write: '}'.

	^ z


! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:47'!
messageEQEQ: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:48'!
messageEQ: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:48'!
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'! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:48'!
messageGE: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:48'!
messageGT: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:49'!
messageLE: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:49'!
messageLT: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:42'!
messageMul: aMessageNode 

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:49'!
messageNENE: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:49'!
messageNE: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:49'!
messageSay: aMessageNode 

	| rcvr |

	rcvr := aMessageNode receiver acceptVisitor: self.

	body write: 'OopSay(PASS_VAT  ' , rcvr , ' );'.

	^ rcvr.! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:42'!
messageSub: aMessageNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 14:03'!
messageToByDo: aMessageNode 
	| n rcvr argTo argBy block |
	n := self serial asString.
	"---"
	rcvr := aMessageNode receiver acceptVisitor: self.

	(aMessageNode arguments at: 7) ifNotNil: [
		"These have an AssignmentNode for the *LimiT temporary at 7"
		body comment: 
			'(*',aMessageNode arguments first asString,'*) ', 
					(aMessageNode arguments at: 7) asString.
		argTo := (aMessageNode arguments at: 7) "(AssignmentNode)" value acceptVisitor: self.
	] ifNil: [
		argTo := aMessageNode arguments first acceptVisitor: self.
	].
	argBy := aMessageNode arguments second acceptVisitor: self.

( argTo asString endsWith: 'LimiT' ) ifTrue: [ self break ].

	"--- if these are known constants, this will vanish by C++ optimizer:"
	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'! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/5/2006 13:00'!
message: aMessageNode binOp: aFuncName

	| n z rcvr arg1 |

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

	aMessageNode arguments size == 1 
	ifTrue: [

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

		body write: 'oop ',z,'= ',aFuncName,'(PASS_VAT  ',rcvr,', (Symbol*)NULL, ',arg1,' );'.

		"----DONT----body write: 'if ( !! ',z,' ) goto ERROR;'."

	] ifFalse: [ 

		self error: 'Not a binop'

	].

	^ z
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 22:01'!
myInits

	^ myInits! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 19:32'!
nonLocalReturn:  x

	nonLocalReturnUsed := true.

	body write: 'return StartNonLocalReturn(PASS_VAT  contextId, ',x,' );'.

	^ 'OopNOTREACHED'.
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:48'!
passArgumentVariables: anArgArray

	| definitions |

	definitions _ ''.

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

	^ definitions! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:43'!
popFunction

	myDecls fileStream nextPutAll: body fileStream contents.
	body := saveStack removeLast! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 10:20'!
pushFunction
	saveStack addLast: body.
	body := CinnabarxBase new fileStreamInMemory.! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 18:51'!
resetFunction


	self fileStream nextPutAll: myDecls fileStream contents. 
	self fileStream nextPutAll: body fileStream contents. 

	myDecls := CinnabarxBase new fileStreamInMemory.
	body := CinnabarxBase new fileStreamInMemory.

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:50'!
serial

	^ nextSerialNumber := nextSerialNumber + 1! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/26/2006 11:22'!
specialCaseOf: aMessageNode
	
	^ self unimplemented: 'Unsupported #caseOf:... Message Node (may not print correctly) :', aMessageNode asString
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:20'!
specialConditional: aMessageNode

	
	| n rcvr nargs arg1 arg2 z special |


	body comment: 'Special Conditional...'.

	special := aMessageNode special.
	nargs := aMessageNode arguments size.
	self assert: (nargs == 1) | (nargs == 2).

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

	rcvr := aMessageNode receiver acceptVisitor: self.

	body write: 'oop ' , z , '= OopNil;   /*' , aMessageNode selector asString , '*/'.

	( special == 15 ) | ( special == 16 ) ifTrue: [
		( special == 15 ) ifTrue: [
			body write: 'if ( OopNil == ',rcvr,'  ) {'.
		] ifFalse: [
			body write: 'if ( OopNil !!= ',rcvr,'  ) {'.
		].
	] ifFalse: [
		body write: 'if ( OopToBool(PASS_VAT ' , rcvr , ') ) {'.
	].

	arg1 := self flattenBlockNode: aMessageNode arguments first.
	body write: z , '=' , arg1 , ';'.

	body write: '}'.
	body write: 'else {'.

	( nargs > 1 ) ifTrue: [
		arg2 := self flattenBlockNode: aMessageNode arguments second.
		body write: z , '=' , arg2 , ';'.
	] ifFalse: [
		body write: z , '=' , rcvr , ';'.
	].

	body write: '}'.

	^ z


! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/24/2006 17:19'!
specialForLoop: aMessageNode 
	| n rcvr argTo argBy block |


	body comment: 'Special For Loop...'.

	n := self serial asString.
	"---"
	rcvr := aMessageNode receiver acceptVisitor: self.

	(aMessageNode arguments at: 7 ifAbsent: [nil] ) ifNotNil: [
		"These have an AssignmentNode for the *LimiT temporary at 7"
		body comment: 
			'(*',aMessageNode arguments first asString,'*) ', 
					(aMessageNode arguments at: 7) asString.
		argTo := (aMessageNode arguments at: 7) "(AssignmentNode)" value acceptVisitor: self.
	] ifNil: [
		argTo := aMessageNode arguments first acceptVisitor: self.
	].
	argBy := aMessageNode arguments second acceptVisitor: self.

( argTo asString endsWith: 'LimiT' ) ifTrue: [ self break ].

	"--- if these are known constants, this will vanish by C++ optimizer:"
	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'! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 23:37'!
specialWhileLoop: aMessageNode 
	| n rcvr |

	body comment: 'Special While Loop...'.
	self assert: aMessageNode arguments size < 2.
	
	n := self serial asString.

	body write: 'while /*',n,'*/ (1) {'.

	rcvr := self flattenBlockNode: aMessageNode receiver.

	( aMessageNode special == 7 ) | ( aMessageNode special == 9 ) ifTrue: [
		body comment: 'While False -- so Break If True'.
		body write: 'if (  OopToBool(PASS_VAT  ', rcvr, ') ) goto break',n,';'.
	] ifFalse: [
		body comment: 'While True -- so Break If False'.
		body write: 'if (  !!  OopToBool(PASS_VAT  ', rcvr, ') ) goto break',n,';'.
	].

	aMessageNode arguments size > 0 ifTrue: [
		self flattenBlockNode: aMessageNode arguments first.
	].

	body write: '/*endwhile*/ }'.
	body write: 'break',n,': ;'.

	^ 'OopNil'! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 20:30'!
translateClass: aClass

	theClass := aClass.

	self addClassToFoundation: aClass.

	self write: '#include "cinnabar.h" '.
	self write: ''.
	self write: 'static SenderCache *Cache;'.
	self write: ''.

	self declareClassVariables.

	"-- make metaclass first -- it will be needed for class, if created at Runtime --"
	self generateClassDefinitionRecursively: aClass class.
	self generateClassDefinitionRecursively: aClass.

	self translateMethodsOf: aClass.
	self translateMethodsOf: aClass class.

	self write: 'extern "C" void Init_', aClass name, ' (PARM_VAT_ONLY) {'.

	self write: 'Cache= (SenderCache*) malloc( ',senderCacheArraySize asString,' * sizeof(SenderCache) );'.
	self write: 'assert(Cache);'.
	self write: 'memset( Cache, 0, ',senderCacheArraySize asString,' * sizeof(SenderCache) );'.  

	myDecls := myInits.  "any decls now must go into the init stream"
	self initializeClassVariables.

	self fileStream nextPutAll: myInits fileStream contents.

	self write: 'Type* cls= & C_', aClass name, '_ClsObj;'.
	self write: 'Type* superCls= & C_', aClass name, '$32$class_ClsObj;'.

	self generateMethodInstalls.
	self write: '}'.! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 4/8/2006 16:38'!
translateMethod

|  selector bNode argVars funcName cc mm namedPrim lits |

	nonLocalReturnUsed := false.

	selector := method selector asString.
	cc := (self tr: theClass name).
	mm := (self tr: selector).
	funcName := 'Func_', cc, '_', mm.

	firstPass := CinnabarxFirstPass new
				visitMethodNode: method
				forClass: theClass
				for: self.
	"*** firstPass inspect. ***"

	bNode := method block.
	argVars := method arguments
				collect: [:var | var acceptVisitor: self].
	body write: 'oop ' , funcName , '(PARM_VAT   oop v_self, Symbol* selector'
				, (self declareParameters: argVars) , ') {'.


	( method primitive > 0 ) ifTrue: [

self comment: 'PRIMITIVE(',method primitive asString,')====> ',
"method primitiveNode spec asString"
(method encoder literals size > 0 
ifTrue: [method encoder literals first asString]
ifFalse: [ 'EMPTY' ]
), '  ...'.


	 (117 == method primitive) ifTrue: [
	  "NAMED"
		lits := method encoder literals.
		namedPrim := lits first.
		body write: 'static void* primf;'.
		body write: 'primf= primf? primf: FindNamedPrimitive(PASS_VAT  "', namedPrim first, '","', namedPrim second,'");'.
		body write: 'if (primf) {'.
		body write: 'oop primout= CallNamedPrimitive(PASS_VAT  primf, v_self, selector',
			(argVars inject: '' into: [ :aa :a | aa, ', ', a ]),
			');'.
		body write: 'if (primout) return primout;'.
		body write: '}'.

       ] ifFalse: [
	  "NOT NAMED.... Ignore or Not?"
	  (256 <= method primitive & (method primitive <= 519)) ifTrue: [
		"range 256..519 are optional and of no benefit to cinnabar because they are too trivial"
		"IGNORED"
		body comment: 'Ignoring Optional Primitive ', method primitive asString.
	  ] ifFalse: [
		"NOT INGORED"
		body write: '#ifdef Primitive', method primitive asString.
		body write: 'oop primout= Primitive', method primitive asString,
			'((PASS_VAT  v_self, selector',
			(argVars inject: '' into: [ :aa :a | aa, ', ', a ]),
			'));'.
		body write: 'if (primout) return primout;'.
		body write: 'ReportPrimitiveFailed(',
				method primitive asString, ' , "', funcName, '" );'.
		body write: '#else'.
		body write: 'ReportPrimitiveMissing(',
				method primitive asString, ' , "', funcName, '" );'.
		body write: '#endif'.
	  ].
	 ].
	].

	"-- TODO: eliminate this when you won't need it --"
	"-- TODO: get it from VAT if threaded --"
	body write: 'oop contextId= OopFromNum(++NextContextId);'.

	body write: '{'.

	"============ trying enterScope ===================="
	
		self enterScope: method.

	"======================================================="
	"this will be wrong for methods on num/SmallInteger"
	theClass == SmallInteger
		ifFalse: [ body write: ' C_' , cc , '* self= (C_' , cc , '*) OopToHeader(v_self);'].

	self flattenBlockNode: bNode.


	body write: '/*END*/ return v_self;'.
	body write: '}'.
	(nonLocalReturnUsed or: [( body fileStream contents findString: 'ERROR') > 0]) ifTrue: [ "--if the test slows things down, always generate:--"
		body write: ' ERROR:'.
		nonLocalReturnUsed ifTrue: [
			body write: '  if (contextId == vat->return_to) return FinishNonLocalReturn(PASS_VAT_ONLY);'.
		].
		body write: '  AddVatErrorString(PASS_VAT  "in ' , theClass name , '>>' , (self escapeStringForC: selector) , ' ...");'.
		body write: '   return (oop)0;'.
	].
	body write: '}'.

	body write: 'Function F_' , funcName , ';'.
	"==============================="
	self exitScope: method.
	"======================================================="
	myInits write: 'F_' , funcName , '.x_entry = OopWrapPointer( (void*)' , funcName , ');'.
	myInits write: 'F_' , funcName , '.f_name = Str(PASS_VAT "' , theClass name , '>>' , (self escapeStringForC: selector), '");'.
	self resetFunction.

! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/26/2006 12:03'!
translateMethodsOf: theClassOrItsClass

	| saveTheClass useDecompiler |

	useDecompiler := true.

	saveTheClass := theClass.  "--- only changes when doing metaclass. ---" 
	theClass := theClassOrItsClass.

	theClass methodDict keys asArray sort do: [ :selector | 

		method := useDecompiler ifTrue: [  
				theClass decompile: selector.
		] ifFalse: [
				Parser new parse: (theClass sourceMethodAt: selector) class: theClass.
		].
		
		self translateMethod.

	].

	theClass := saveTheClass.     "--- restore the class ---"
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/1/2006 22:31'!
unimplemented: x 

	body write: 'SetVatErrorString(PASS_VAT  "UNIMPLEMENTED: ' , (self escapeStringForC: x asString), '");'.
	body write: 'goto ERROR;'.
	^ 'OopNOTREACHED'! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 14:03'!
visitAssignmentNode: anAssignmentNode 
	| var val |
	body comment: anAssignmentNode.
	var := anAssignmentNode variable acceptVisitor: self.
	val := anAssignmentNode value acceptVisitor: self.
	body write: var , ' = ' , val , ';'.
	^ var! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 19:08'!
visitBlockNode: aBlockNode 
	"<< Push the blockNode & recurse.
	This is what is called when we do NOT flatten a Block, as we do for #ifTrue:ifFalse:
	and other frequent flattenable methods.  
	See #flattenBlockNode for the flattened version.
	>>"


	| lastN n z funcName argVars result summary prev |

	"=================== try enterScope ========================"
	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: 'static char Name_' , funcName , '[] = "[] in ' , theClass name , '>>' , method selector , '  /*' , funcName , '*/  ' , summary , '";'.
	body write: 'static Function Obj_' , funcName , ';'.
	body write: ''.
	myInits write: 'Obj_' , funcName , ' . x_entry = OopWrapPointer( (void*)' , funcName , ');'.
	myInits write: 'Obj_' , funcName , ' . f_name = Str(PASS_VAT  Name_' , funcName , ');'.
	myInits write: 'Obj_' , funcName , ' . f_numArgs = OopFromNum(' , argVars size asString , ');'.
	myInits write: 'Obj_' , funcName , ' . setTypeNumber( Func_TypeNumber );'.

	"=============== generate block function ================="
	body write: 'static oop ' , funcName , '(PARM_VAT'.
	body write: '   Closure* closure '.
	body
		write: (self declareParameters: argVars).
	body write: ') {'.
	body write: 'oop contextId= closure->f_id;'.
	body write: 'oop v_self= closure->f_myself;'.
	body write: 'oop octx_' , lastN , '= closure->f_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_' , (self tr: theClass name) , '* self= (C_' , (self tr: 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 , '->f_function= OopFromHeader( & Obj_' , funcName , ' );'.
	contextStack size > 0
		ifTrue: [body write: z , '->f_context= octx_' , contextStack last , ';']
		ifFalse: [body write: z , '->f_context= 0;'].
	body write: z , '->f_myself= v_self;'.
	body write: z , '->f_id= contextId;'.
	^ 'o' , z
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/27/2006 09:43'!
visitBraceNode: aBraceNode 
	| n z e |
	e := aBraceNode elements.
	n := self serial asString.
	z := 'brace_' , n.
	body write: 'oop ' , z , '= BasicNewColon(PASS_VAT  & C_Array_ClsObj, ' , e size asString , ');'.
	body write: 'assert(' , z , ');'.
	1
		to: e size
		do: [:i | 
			| y |
			y := (e at: i) acceptVisitor: self.
			body write: 'Prim_BasicAtPut(PASS_VAT  ' , z , ',  NULL, OopFromNum(' , i asString , '), ' , y , ');'].
	^ z! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:54'!
visitByteSymbol: aByteSymbol 
	^ aByteSymbol! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:54'!
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! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:53'!
visitLiteralNode: aLiteralNode 

	^ self literal: aLiteralNode eval.
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/18/2006 20:01'!
visitLiteralVariableNode: aNode 

	| obj myClass |
	obj := aNode key value.
	obj
		ifKindOf: Class
		thenDo: [:cls | 

				| n z |
				n := self serial asString.
				z := 'cls_' , n, '_', cls name.
	body write: '#ifdef C_',cls name,'_TypeNumber'.
	body write: 'oop ', z,'= OopFromHeader(&C_' , cls name , '_ClsObj);'.
	body write: '#else'.
	body write: 'Type* ', z,'_typePtr= TypeTable[ OopToHeader(', (self literalByteSymbol: cls name), ') ->hash() ];'.
	body write: 'if ( !! ', z, '_typePtr ) {'.
	self unimplemented: 'Missing From TypeTable: ', cls name.
	body write: '}'.
	body write: 'oop ', z,'= OopFromHeader( ',z,'_typePtr );'.
	body write: '#endif'.

			self addClassToFoundation: cls.
			^ z
		].

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

	"---perhaps it is a class variable---"
	myClass := theClass isMeta ifTrue: [ theClass soleInstance ] ifFalse: [ theClass ].
	( myClass allClassVarNames includes: aNode key key ) ifTrue: [

		^ 'ClsVar_', myClass name, '_', aNode key key.

		"<< ^ (self literal: (myClass classPool at: aNode key key)),'/*ClassVar ASSUMED READONLY: ',aNode key key,'*/'. >>" 
	].

	^self unimplemented: 'Some kind of LiteralVariableNode: ', aNode asString

! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/8/2006 20:36'!
visitMessageNode: aMessageNode 
	| n z msgSelector msgReceiver argList funcType cacheNum symtab |

"<< These are the values of 'special' -- MessageNode::MacroEmitters --
 #( 1 #emitIf:on:value: #emitIf:on:value: #emitIf:on:value: #emitIf:on:value: #emitIf:on:value: #emitIf:on:value: 7 #emitWhile:on:value: #emitWhile:on:value: #emitWhile:on:value: #emitWhile:on:value: 11 #emitToDo:on:value: #emitToDo:on:value: 13 #emitCase:on:value: #emitCase:on:value: 15 #emitIfNil:on:value: #emitIfNil:on:value: 17 #emitIf:on:value: #emitIf:on:value: 19)
>>"

	body comment: aMessageNode.
	msgSelector := aMessageNode selector acceptVisitor: self.
	"*** Check to see if the message is a special case before you go any
	further "


	(aMessageNode special ~~ nil and: [aMessageNode special > 0]) ifTrue: [
		body comment: 'SPECIAL TYPE ', aMessageNode special asString, ' #', msgSelector.
		(aMessageNode special < 7) ifTrue: [ ^ self specialConditional: aMessageNode ].
		(aMessageNode special < 11) ifTrue: [ ^ self specialWhileLoop: aMessageNode ].
		(aMessageNode special < 13) ifTrue: [ ^ self specialForLoop: aMessageNode ].
		(aMessageNode special < 15) ifTrue: [ ^ self specialCaseOf: aMessageNode ].
		(aMessageNode special < 19) ifTrue: [ ^ self specialConditional: aMessageNode ].
		^ self unimplemented: 'Special Message Type ', aMessageNode special asString.
	].

	(specialCases includesKey: msgSelector)
		ifTrue: [^ self
				perform: (specialCases at: msgSelector)
				with: aMessageNode].


	"*** Normal messages continue here."
	n := self serial asString.
	z := 'send_' , n.

	#incr == foundation model ifTrue: [
		myDecls write: 'static Symbol* sym_',n,';'.
		myInits write: 'sym_',n,'= InternSymbol( "', (self escapeStringForC: msgSelector), '" );'.
		symtab := 'sym_',n.
	] ifFalse: [
		symtab := 'SymbolTable[' , (foundation intern: msgSelector) , ']'.	
	].
	cacheNum := senderCacheArraySize asString.
	senderCacheArraySize := senderCacheArraySize + 1.



	(specialOperations includesKey: msgSelector)
		ifTrue: [ | tmp |
			"tmp := self	perform: (specialOperations at: msgSelector) with: aMessageNode."
			tmp := self message: aMessageNode binOp: (specialOperations at: msgSelector).
			body write: 'oop ', z, '= ', tmp, ';'.
			body write: 'if ( !! ', z, ' ) // slow'.
		] ifFalse: [
			body write: 'oop ' , z , '= OopNil;'.
		].


	body write: '{'.
	msgReceiver := aMessageNode receiver acceptVisitor: self.

	argList := self passArgumentVariables: aMessageNode arguments.
	( aMessageNode receiver class == VariableNode 
		and: [ aMessageNode receiver name = 'super' ]
	) ifTrue: [
		"--- send to super --- based on static superclass"
		body write: 'word typeNumber= C_', (self tr: theClass superclass name), '_TypeNumber;'.
		body comment: 'Sending To Super...'.
	] ifFalse: [
		"--- normal send --- based on runtime type"
		body write: 'word typeNumber= OopToTypeNumber(' , msgReceiver , ');'.
	].
	body write: 'BIND_CACHE( Cache[' , cacheNum, '], typeNumber, ', symtab,' );   /* ' , msgSelector , ' */'.
	funcType := 'FUNC' , aMessageNode arguments size asString , '*'.
	body write: funcType , ' f= (' , funcType , ') Cache[' , cacheNum, '].func;'.
	body write: z , '=  f(PASS_VAT  ' , msgReceiver , ', ', symtab , argList , ');'.
	body write: 'if (!!' , z , ') goto ERROR;'.
	body write: '}'.
	^ z! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:52'!
visitParseNode: aParseNode

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

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/19/2006 18:55'!
visitReturnNode: aReturnNode

	( 0 == saveStack size ) ifTrue: [

		"---- at toplevel, simply make the function return what you want ----"
	
		body write: 'return ', (aReturnNode expr acceptVisitor: self) , ';'.

	] ifFalse: [

		"---- if inside a Block, cause a non-local GOTO back to the home scope ----"

		self nonLocalReturn: (aReturnNode expr acceptVisitor: self).

	].

	^ 'OopNOTREACHED'.
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:53'!
visitSelectorNode: aSelectorNode

	^ aSelectorNode key asString.
! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 02:51'!
visitTempVariableNode: aTempVariableNode 
	| var j |
	var := aTempVariableNode name.

(var endsWith: 'LimiT') ifTrue: [self break].

	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*/'! !

!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 2/26/2006 11:58'!
visitVariableNode: aVariableNode 
	| var |
	var := aVariableNode name.

	"-- compiler uses LiteralVariableNode, but decompiler just uses VariableNode, for these: --"
	( $A <= var first and: [ var first <= $Z ] ) ifTrue: [
		^ self visitLiteralVariableNode: aVariableNode
	].
 
	"-- check first for reserved names --"
	var = 'true'
		ifTrue: [^ 'OopTrue'].
	var = 'false'
		ifTrue: [^ 'OopFalse'].
	var = 'nil'
		ifTrue: [^ 'OopNil'].
	var = 'self'
		ifTrue: [^ 'v_self'].
	var = 'super'
		ifTrue: [^ 'v_self'   "-- for super, the object is self -- but the dispatch is different --" ].
	var = 'thisContext'
		ifTrue: [^ self unimplemented: 'thisContext' ].
	var = 'Smalltalk'
		ifTrue: [^ self unimplemented: 'Smalltalk' ].

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


TestCase subclass: #CinnabarxUnitTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Cinnabar'!

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:39'!
assertEqualLists: x and: y

	self assert: x size = y size.

	1 to: x size do: [ :i | self assert: (x at: i) = (y at: i ) ].
! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/19/2006 00:08'!
testAppleAndFib

	| d v i t |

	d := CinnabarxGenDeclaratons new fileName: '_gen_header.h'.
	v := CinnabarxGenVariables new fileName: '_gen_objects.h'.
	i :=  CinnabarxGenInitializations new fileName: '_gen_inits.h'.

	d addImportantClasses.
	v addImportantClasses.
	i addImportantClasses.

	#( CinnabarTestFib CinnabarTestApple CinnabarTestFruit CinnabarTestGreenApple 
	) do: [ :clsName |

		t := CinnabarxTranslateClass new fileName: '_', clsName, '.cc'.
		t masterDecls: d masterVars: v masterInits: i.

		t translateClass: (Smalltalk at: clsName).

		t fileStream close.
	].

	d doAll fileStream close.
	v doAll fileStream close.
	i doAll fileStream close.

! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/20/2006 13:40'!
testBig

	| d v i t |

	d := CinnabarxGenDeclaratons new fileName: '_gen_header.h'.
	v := CinnabarxGenVariables new fileName: '_gen_objects.h'.
	i :=  CinnabarxGenInitializations new fileName: '_gen_inits.h'.

	d addImportantClasses.
	v addImportantClasses.
	i addImportantClasses.

	#( CinnabarTestFib CinnabarTestFruit CinnabarTestApple CinnabarTestGreenApple 
	) do: [ :clsName |

	t := CinnabarxTranslateClass new fileName: '_', clsName, '.cc'.
	t masterDecls: d masterVars: v masterInits: i.

	t translateClass: (Smalltalk at: clsName).

	t fileStream close.
	].

	d doAll fileStream close.
	v doAll fileStream close.
	i doAll fileStream close.





! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:41'!
testClassList


	| x y |

	x := { ProtoObject. Object. Behavior. ClassDescription. Class. ProtoObject class. Metaclass. Object class. Behavior class. ClassDescription class. Metaclass class. Class class }.

	y := (CinnabarxBase new addClassSupersAndMetas: Object) list.


	self assertEqualLists: x and: y.! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 00:01'!
testCleanStringMax

	| b |
	b := CinnabarxBase new.

	self assert: '' = (b cleanString: '' max: 3).

	self assert: 'abc' = (b cleanString: 'abc' max: 3).

	self assert: ' ' = (b cleanString: String cr max: 3).

	self assert: 'abc d...' = (b cleanString: 'abc', String lf, 'def' max: 5).
! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:47'!
testEscapeStringForC

	| b |
	b := CinnabarxBase new.

	self assert: '' = (b escapeStringForC: '').

	self assert: 'abc' = (b escapeStringForC: 'abc').

	self assert: 'foo bar' = (b escapeStringForC: 'foo bar').

	self assert: 'baz\015' = (b escapeStringForC: 'baz', String cr).

	self assert: 'baz\015\012' = (b escapeStringForC: 'baz', String cr, String lf).
! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 3/7/2006 23:42'!
testGenDeclarations

	| b result |
	b := CinnabarxGenDeclaratons new fileStreamInMemory.

	b addImportantClasses.

	b doAll.

	"result to complex to check in Unit Test -- so check size & make sure no exceptions"
	result := b fileStream contents.
	result size.

! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 3/7/2006 23:42'!
testGenDeclarationsToFile

	| b |
	b := CinnabarxGenDeclaratons new fileName: '_gen_header.tmp'.

	b addImportantClasses.

	b doAll.

	b close.

! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 01:21'!
testGenInitializations

	| b result |
	b := CinnabarxGenInitializations new fileStreamInMemory.

	b addImportantClasses.
	b doAll.

	"result to complex to check in Unit Test -- so check size & make sure no exceptions"
	result := b fileStream contents.
	result size.

! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:18'!
testGenInitializationsToFile

	| b |
	b := CinnabarxGenInitializations new fileName: '_gen_inits.tmp'.

	b addImportantClasses.

	b doAll.

	b close.
! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 01:21'!
testGenVariables

	| b result |
	b := CinnabarxGenVariables new fileStreamInMemory.

	b addImportantClasses.

	b doAll.

	"result to complex to check in Unit Test -- so check size & make sure no exceptions"
	result := b fileStream contents.
	result size.

! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 13:19'!
testGenVariablesToFile

	| b |
	b := CinnabarxGenVariables new fileName: '_gen_objects.tmp'.

	b addImportantClasses.

	b doAll.

	b close.
! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/17/2006 23:58'!
testStringMax

	| b |
	b := CinnabarxBase new.

	self assert: '' = (b string: '' max: 3).

	self assert: 'abc' = (b string: 'abc' max: 3).

	self assert: 'ab...' = (b string: 'abc' max: 2).
! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 00:05'!
testTr

	| b |
	b := CinnabarxBase new.

	self assert: '' = (b tr: '').

	self assert: 'abc' = (b tr: 'abc').

	self assert: '$13$' = (b tr: String cr).

	self assert: '$43$$45$$42$$47$' = (b tr: '+-*/' ).

	self assert: 'Object$32$class' = (b tr: Object class asString).
! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 01:37'!
testTranslateClass

	| b |
	b := CinnabarxTranslateClass new fileStreamInMemory.

! !

!CinnabarxUnitTests methodsFor: 'as yet unclassified' stamp: 'strick 2/18/2006 00:24'!
testWrite

	| b |
	b := CinnabarxBase new fileStreamInMemory.

	b write: 'abc'.
	b write: 'def{'.
	b write: 'ghi'.
	b write: 'jkl}'.
	b write: 'mno'.

	self assertEqualLists: (b split: b fileStream contents on: String lf) and: {
		'abc'.
		'def{'.
		'    ghi'.   " indented 4 spaces, due to 1 brace level "
		'jkl}'.
		'mno'.
	}.

! !


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.
!


!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 2/24/2006 17:09'!
questions

	( Metaclass allInstances collect: [ :m | m theNonMetaClass instVarNames ] )

	CinnabarTestFib decompile: #fib: .


	( Metaclass allInstances collect: [ :m | m soleInstance] ) select: [ :c | (c theNonMetaClass instVarNames size > 0) and: [c isVariable] ] . 

	#(PseudoContext BlockContext MethodContext WeakMessageSend SparseLargeTable B3DSimpleMesh B3DSimpleMeshFace)

! !

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