'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 4 March 2006 at 11:04:41 pm'!

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





! !


!CinnabarxGenInitializations methodsFor: 'as yet unclassified' stamp: 'strick 3/3/2006 12:14'!
doSymbols

	symDict keys asArray sort do: [ :s |

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

	].
 
	self write: 'NextClassySymbol =  ', nextClassyNum asString, ' ;'.
	self write: 'NextTackySymbol =  ', nextTackyNum asString, ' ;'.
! !


!CinnabarxTranslateClass methodsFor: 'as yet unclassified' stamp: 'strick 3/4/2006 20:45'!
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.

	specialCases 
		at: #'==' put: #messageEQEQ: ;
		at: #'~~' put: #messageNENE: ;
"<<
		at: #= put: #messageEQ: ;
		at: #'~=' put: #messageNE: ;
		at: #< put: #messageLT: ;
		at: #> put: #messageGT: ;
		at: #'<=' put: #messageLE: ;	
		at: #'>=' put: #messageGE: ;

		 at: #+ put: #messageAdd: ;
		 at: #- put: #messageSub: ;
		 at: #* put: #messageMul: ;
>>"		
		at: #bitAnd put: #messageBitAnd: ;
		
		at: #bitOr put: #messageBitOr: ;
		
		at: #bitXor put: #messageBitXor: ;
		
		at: #bitShift: put: #messageBitShift: ;
"<<
		at: #basicNew put: #messageBasicNew: ;
		
		at: #basicNew: put: #messageBasicNewColon: ;
>>"
		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/4/2006 21:35'!
translateMethod

|  selector bNode argVars funcName cc mm |

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

	firstPass := CinnabarFirstPass 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: [
	  (256 <= method primitive & (method primitive <= 519)) ifTrue: [
		"range 256..519 (really to 519????) are optional and of no benefit to cinnabar" 
		body comment: 'Ignoring Optional Primitive ', method primitive asString.
	  ] ifFalse: [
		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: 'fprintf(stderr, "******  Primitive Failed  --  ',
				method primitive asString, ' -- ', funcName, '\n" );'.
		body write: '#else'.
		body write: 'fprintf(stderr, "** Primitive Missing -- ',
				method primitive asString, ' -- ', funcName, '\n" );'.
		body write: '#endif'.
	  ].
	].
	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: '}'.
	( body fileStream contents findString: 'ERROR') > 0 ifTrue: [ "if the test slows things down, always generate:"
		body write: ' ERROR:'.
		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.

! !