'From Squeak3.8gamma of ''24 November 2004'' [latest update: #6548] on 31 March 2005 at 3:46:37 pm'!
"Change Set:		VMM38b4-64bit-vm2-ikp
Date:			2005-03-31
Author:			ian.piumarta@squeakland.org

Changes relative to VMM38b4-64bit-vm1 that add 64-bit support to SmartSyntaxInterpreterPlugins.  Needed to correctly translate the SocketPlugin."!


!Object class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:20'!
ccgDeclareCForVar: aSymbolOrString

	^'sqInt ', aSymbolOrString! !


!Array class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:20'!
ccgDeclareCForVar: aSymbolOrString

	^'sqInt *', aSymbolOrString! !


!Oop class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:20'!
ccgDeclareCForVar: aSymbolOrString

	^'sqInt ', aSymbolOrString! !


!SmartSyntaxPluginCodeGenerator methodsFor: 'translating builtins' stamp: 'ikp 3/31/2005 15:46'!
generateCPtrAsOop: aNode on: aStream indent: anInteger

	aStream nextPutAll: '((sqInt)(long)('.
	self emitCExpression: aNode receiver on: aStream.
	aStream nextPutAll: ') - sizeof(sqInt))'.! !


!SmartSyntaxPluginTMethod methodsFor: 'private' stamp: 'ikp 3/31/2005 14:23'!
oopVariable: aString

	(locals includes: aString) ifFalse:
		[locals add: aString.
		 declarations
			at: aString 
			put: 'sqInt ', aString].
	^TVariableNode new setName: aString! !

!SmartSyntaxPluginTMethod methodsFor: 'generating C code' stamp: 'ikp 3/31/2005 14:23'!
emitCHeaderOn: aStream generator: aCodeGen
	"Emit a C function header for this method onto the given stream."

	aStream cr.
	self emitCFunctionPrototype: aStream generator: aCodeGen.
	aStream nextPutAll: ' {'; cr.
	locals do: [ :var |
		aStream 
			tab; 
			nextPutAll: (declarations 
				at: var 
				ifAbsent: [ 'sqInt ', var]);
			nextPut: $;; 
			cr].
	locals isEmpty ifFalse: [ aStream cr ].! !

!SmartSyntaxPluginTMethod methodsFor: 'initializing' stamp: 'ikp 3/31/2005 14:01'!
setSelector: sel args: argList locals: localList block: aBlockNode primitive: aNumber
	"Initialize this method using the given information."

	selector _ sel.
	returnType _ 'sqInt'. 	 "assume return type is sqInt for now"
	args _ argList asOrderedCollection collect: [:arg | arg key].
	locals _ localList asOrderedCollection collect: [:arg | arg key].
	declarations _ Dictionary new.
	primitive _ aNumber.
	parseTree _ aBlockNode asTranslatorNode.
	labels _ OrderedCollection new.
	complete _ false.  "set to true when all possible inlining has been done"
	export _ self extractExportDirective.
	static _ self extractStaticDirective.
	self extractSharedCase.
	isPrimitive _ false.  "set to true only if you find a primtive direction."
	suppressingFailureGuards _ self extractSuppressFailureGuardDirective.
	self recordDeclarations.
	self extractPrimitiveDirectives.
! !


!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:12'!
intToNetAddress: addr
	"Convert the given 32-bit integer into an internet network address represented as a four-byte ByteArray."

	| netAddressOop naPtr |
	self var: #naPtr declareC: 'char * naPtr'.

	netAddressOop _
		interpreterProxy instantiateClass: interpreterProxy classByteArray
			indexableSize: 4.
	naPtr _ netAddressOop asCharPtr.
	naPtr at: 0 put: (self cCoerce: ((addr >> 24) bitAnd: 16rFF) to: 'char').
	naPtr at: 1 put: (self cCoerce: ((addr >> 16) bitAnd: 16rFF) to: 'char').
	naPtr at: 2 put: (self cCoerce: ((addr >> 8) bitAnd: 16rFF) to: 'char').
	naPtr at: 3 put: (self cCoerce: (addr bitAnd: 16rFF) to: 'char').
	^ netAddressOop! !

!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:03'!
primitiveSocket: socket getOptions: optionName

	| s optionNameStart optionNameSize returnedValue errorCode results |
	self var: #s declareC: 'SocketPtr s'.
	self var: #optionNameStart declareC: 'char *optionNameStart'.
	self primitive: 'primitiveSocketGetOptions'
		parameters: #(Oop Oop).

	s _ self socketValueOf: socket.
	interpreterProxy success: (interpreterProxy isBytes: optionName).
	optionNameStart _ self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'.
	optionNameSize _ interpreterProxy slotSizeOf: optionName.

	interpreterProxy failed ifTrue: [^nil].
	returnedValue _ 0.

	errorCode _ self sqSocketGetOptions: s 
			optionNameStart: optionNameStart 
			optionNameSize: optionNameSize
			returnedValue: (self cCode: '&returnedValue').

	interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj.
	interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj.
	interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2).
	results _ interpreterProxy popRemappableOop.
	interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
	interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
	^ results! !

!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:08'!
primitiveSocket: socket receiveDataBuf: array start: startIndex count: count 
	| s byteSize arrayBase bufStart bytesReceived |
	self var: #s declareC: 'SocketPtr s'.
	self var: #arrayBase declareC: 'char *arrayBase'.
	self var: #bufStart declareC: 'char *bufStart'.
	self primitive: 'primitiveSocketReceiveDataBufCount'
		parameters: #(Oop Oop SmallInteger SmallInteger ).
	s _ self socketValueOf: socket.

	"buffer can be any indexable words or bytes object"
	interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
	(interpreterProxy isWords: array)
		ifTrue: [byteSize _ 4]
		ifFalse: [byteSize _ 1].
	interpreterProxy success: (startIndex >= 1
			and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
	interpreterProxy failed
		ifFalse: ["Note: adjust bufStart for zero-origin indexing"
			arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
			bufStart _ arrayBase + (startIndex - 1 * byteSize).
			bytesReceived _ self
						sqSocket: s
						ReceiveDataBuf: bufStart
						Count: count * byteSize].
	^ (bytesReceived // byteSize) asSmallIntegerObj! !

!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:09'!
primitiveSocket: socket receiveUDPDataBuf: array start: startIndex count: count 
	| s byteSize arrayBase bufStart bytesReceived results address port moreFlag |
	self var: #s declareC: 'SocketPtr s'.
	self var: #arrayBase declareC: 'char *arrayBase'.
	self var: #bufStart declareC: 'char *bufStart'.
	self primitive: 'primitiveSocketReceiveUDPDataBufCount'
		parameters: #(Oop Oop SmallInteger SmallInteger ).
	s _ self socketValueOf: socket.

	"buffer can be any indexable words or bytes object"
	interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
	(interpreterProxy isWords: array)
		ifTrue: [byteSize _ 4]
		ifFalse: [byteSize _ 1].
	interpreterProxy success: (startIndex >= 1
			and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
	interpreterProxy failed
		ifFalse: ["Note: adjust bufStart for zero-origin indexing"
			arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
			bufStart _ arrayBase + (startIndex - 1 * byteSize).
			"allocate storage for results, remapping newly allocated
			 oops in case GC happens during allocation"
			address		  _ 0.
			port			  _ 0.
			moreFlag	  _ 0.
			bytesReceived _ self
						sqSocket: s
						ReceiveUDPDataBuf: bufStart
						Count: count * byteSize
						address: (self cCode: '&address')
						port: (self cCode: '&port')
						moreFlag: (self cCode: '&moreFlag').
				
			interpreterProxy pushRemappableOop: port asSmallIntegerObj.
			interpreterProxy pushRemappableOop: (self intToNetAddress: address).
			interpreterProxy pushRemappableOop: (bytesReceived // byteSize) asSmallIntegerObj.
			interpreterProxy pushRemappableOop:
				(interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 4).
			results         _ interpreterProxy popRemappableOop.
			interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
			interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
			interpreterProxy storePointer: 2 ofObject: results withValue: interpreterProxy popRemappableOop.
			moreFlag
				ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
				ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
			].
	^ results! !

!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:05'!
primitiveSocket: socket sendData: array start: startIndex count: count 
	| s byteSize arrayBase bufStart bytesSent |
	self var: #s declareC: 'SocketPtr s'.
	self var: #arrayBase declareC: 'char *arrayBase'.
	self var: #bufStart declareC: 'char *bufStart'.
	self primitive: 'primitiveSocketSendDataBufCount'
		parameters: #(Oop Oop SmallInteger SmallInteger ).
	s _ self socketValueOf: socket.

	"buffer can be any indexable words or bytes object except CompiledMethod "
	interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
	(interpreterProxy isWords: array)
		ifTrue: [byteSize _ 4]
		ifFalse: [byteSize _ 1].
	interpreterProxy success: (startIndex >= 1
			and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
	interpreterProxy failed
		ifFalse: ["Note: adjust bufStart for zero-origin indexing"
			arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
			bufStart _ arrayBase + (startIndex - 1 * byteSize).
			bytesSent _ self
						sqSocket: s
						SendDataBuf: bufStart
						Count: count * byteSize].
	^ (bytesSent // byteSize) asSmallIntegerObj! !

!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:06'!
primitiveSocket: socket sendUDPData: array toHost: hostAddress  port: portNumber start: startIndex count: count 
	| s byteSize arrayBase bufStart bytesSent address |
	self var: #s declareC: 'SocketPtr s'.
	self var: #arrayBase declareC: 'char *arrayBase'.
	self var: #bufStart declareC: 'char *bufStart'.
	self primitive: 'primitiveSocketSendUDPDataBufCount'
		parameters: #(Oop Oop ByteArray SmallInteger SmallInteger SmallInteger ).
	s _ self socketValueOf: socket.

	"buffer can be any indexable words or bytes object except CompiledMethod "
	interpreterProxy success: (interpreterProxy isWordsOrBytes: array).
	(interpreterProxy isWords: array)
		ifTrue: [byteSize _ 4]
		ifFalse: [byteSize _ 1].
	interpreterProxy success: (startIndex >= 1
			and: [count >= 0 and: [startIndex + count - 1 <= (interpreterProxy slotSizeOf: array)]]).
	interpreterProxy failed
		ifFalse: ["Note: adjust bufStart for zero-origin indexing"
			arrayBase _ self cCoerce: (interpreterProxy firstIndexableField: array) to: 'char *'.
			bufStart _ arrayBase + (startIndex - 1 * byteSize).
			address _ self netAddressToInt: (self cCoerce: hostAddress to: 'unsigned char *').
			bytesSent _ self
						sqSocket: s
						toHost: address
						port: portNumber
						SendDataBuf: bufStart
						Count: count * byteSize].
	^ (bytesSent // byteSize) asSmallIntegerObj! !

!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:06'!
primitiveSocket: socket setOptions: optionName value: optionValue

	| s optionNameStart optionNameSize optionValueStart optionValueSize returnedValue errorCode results |
	self var: #s declareC: 'SocketPtr s'.
	self var: #optionNameStart declareC: 'char *optionNameStart'.
	self var: #optionValueStart declareC: 'char *optionValueStart'.
	self primitive: 'primitiveSocketSetOptions'
		parameters: #(Oop Oop Oop).

	s _ self socketValueOf: socket.
	interpreterProxy success: (interpreterProxy isBytes: optionName).
	optionNameStart _ self cCoerce: (interpreterProxy firstIndexableField: optionName) to: 'char *'.
	optionNameSize _ interpreterProxy slotSizeOf: optionName.
	interpreterProxy success: (interpreterProxy isBytes: optionValue).
	optionValueStart_ self cCoerce: (interpreterProxy firstIndexableField: optionValue) to: 'char *'.
	optionValueSize _ interpreterProxy slotSizeOf: optionValue.

	interpreterProxy failed ifTrue: [^nil].
	returnedValue _ 0.

	errorCode _ self sqSocketSetOptions: s 
			optionNameStart: optionNameStart 
			optionNameSize: optionNameSize
			optionValueStart: optionValueStart
			optionValueSize: optionValueSize
			returnedValue: (self cCode: '&returnedValue').

	interpreterProxy pushRemappableOop: returnedValue asSmallIntegerObj.
	interpreterProxy pushRemappableOop: errorCode asSmallIntegerObj.
	interpreterProxy pushRemappableOop: (interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 2).
	results _ interpreterProxy popRemappableOop.
	interpreterProxy storePointer: 0 ofObject: results withValue: interpreterProxy popRemappableOop.
	interpreterProxy storePointer: 1 ofObject: results withValue: interpreterProxy popRemappableOop.
	^ results! !

!SocketPlugin methodsFor: 'primitives' stamp: 'ikp 3/31/2005 14:08'!
socketValueOf: socketOop 
	"Return a pointer to the first byte of of the socket record within the  
	given Smalltalk object, or nil if socketOop is not a socket record."
	| socketIndex |
	self returnTypeC: 'SQSocket *'.
	self var: #socketIndex type: 'void *'.
	interpreterProxy success: ((interpreterProxy isBytes: socketOop)
			and: [(interpreterProxy byteSizeOf: socketOop)
					= self socketRecordSize]).
	interpreterProxy failed
		ifTrue: [^ nil]
		ifFalse: [socketIndex _ self cCoerce: (interpreterProxy firstIndexableField: socketOop) to: 'void *'.
			^ self cCode: '(SQSocket *) socketIndex']! !


!SocketPlugin class methodsFor: 'translation' stamp: 'ikp 3/31/2005 13:43'!
declareCVarsIn: aCCodeGenerator

	aCCodeGenerator var: 'sDSAfn'	type: 'void *'.
	aCCodeGenerator var: 'sHSAfn'	type: 'void *'.
	aCCodeGenerator var: 'sCCTPfn'	type: 'void *'.
	aCCodeGenerator var: 'sCCLOPfn'	type: 'void *'.
	aCCodeGenerator var: 'sCCSOTfn'	type: 'void *'.
	aCCodeGenerator addHeaderFile: '"SocketPlugin.h"'! !


!Unsigned methodsFor: 'as yet unclassified' stamp: 'ikp 3/31/2005 14:19'!
ccgDeclareCForVar: aSymbolOrString

	^'unsigned int ', aSymbolOrString! !


!WordArray class methodsFor: 'plugin generation' stamp: 'ikp 3/31/2005 14:19'!
ccgDeclareCForVar: aSymbolOrString

	^'usqInt *', aSymbolOrString! !