'From Squeak3.8 of ''5 May 2005'' [latest update: #6665] on 26 February 2006 at 4:52:45 pm'!

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


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


!CinnabarxBase methodsFor: 'as yet unclassified' stamp: 'strick 2/21/2006 12:30'!
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: ByteString.
	self addClassSupersAndMetas: ByteSymbol.
	self addClassSupersAndMetas: Array.
! !


!CinnabarxGenDeclaratons methodsFor: 'as yet unclassified' stamp: 'strick 2/21/2006 12:08'!
initialize

	super initialize.

	extraFields := IdentityDictionary new.

	extraFields at: Behavior put: #( 
		#'x_numFixedOops'		"how many fixed oop fields are in instances"
		#'x_funcMap'			"pointer to cinnabarx-specific structure (WRAPPED)"
		#'x_instanceFlags'		"what bits to set in instances created"
		#'x_senderCacheChain'	"SenderCaches to be invalidated when behavior is updated (WRAPPED)"
		#'x_debugName'			"easy way to print what class/metaclass it is"
	).

	extraFields at: Symbol put: #(
		#'x_arrayIndex'			"its index in SymbolTable"
		#'x_left'				"for binary tree (unused yet)"
		#'x_right'				"ibid"
	).

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


! !


!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 2/21/2006 12:29'!
enterScope: aScope 
	"aScope is a BlockNode or a MethodNode (at the top level)"
	"***get the name of the previous context from the contextStack. 000
	means none."
	| captures vars n argNames lastN |
	contextStack size > 0
		ifTrue: [lastN := contextStack last]
		ifFalse: [lastN := '000'].
	"***"
	body write: '// LastN=' , lastN , ' ... Entering Scope:'.
	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 comment: 'captureStack: ' , captureStack asString.
	body comment: 'contextStack: ' , contextStack asString.
	body comment: '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_TypeObj, ' , (captures size + 1) asString , ' );'.
			body write: 'context_' , n , ' * ctx_' , n , '= (context_' , n , '*) OopToHeader( octx_' , n , ');'.
			contextStack size > 0
				ifTrue: [lastN := contextStack last.
					body write: 'ctx_' , n , '->octx_' , lastN , '= octx_' , lastN , ';'].
			captures
				do: [:v | (argNames includes: v name)
						ifTrue: [body write: 'ctx_' , n , '->v_' , v name , ' = v_' , v name , ';']
						ifFalse: [body write: 'ctx_' , n , '->v_' , v name , ' = ' , 'OopNil;']
				].
			contextStack addLast: n.
			body write: '// pushed to ' , contextStack asString
		]
		ifFalse: [body write: '// no captures, so dont push to ' , contextStack asString]! !

!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 2/26/2006 11:33'!
flattenNonBlockNode: aNode
	| msg |

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

	"-- 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 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/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/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 2/26/2006 11:17'!
visitMessageNode: aMessageNode 
	| n z msgSelector msgReceiver argList funcType |

"<< 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) ifNotNil: [
	  (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.
	myDecls write: 'static SenderCache cache' , n , ';'.
	myDecls write: 'static Symbol* selector' , n , ';'.
	myInits write: 'InsertSenderCache( &cache' , n , ' );';
		 write: 'selector' , n , ' = InternString("' , msgSelector , '"); '.
	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 typeIndex= C_', (self tr: theClass superclass name), '_TypeIndex;'.
		body comment: 'Sending To Super...'.
	] ifFalse: [
		"--- normal send --- based on runtime type"
		body write: 'word typeIndex= OopToTypeIndex(' , msgReceiver , ');'.
	].
	body write: 'BIND_CACHE( cache' , n , ', typeIndex, selector' , n , ' );   /* ' , msgSelector , ' */'.
	funcType := 'FUNC' , aMessageNode arguments size asString , '*'.
	body write: funcType , ' f= (' , funcType , ')cache' , n , '.func;'.
	body write: z , '=  f(PASS_VAT  ' , msgReceiver , ', selector' , n , argList , ');'.
	body write: 'if (!!' , z , ') goto ERROR;'.
	body write: '}'.
	^ z! !

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


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

! !