This set is a later version of the updates that were placed in the stream
some time ago. Like before, beware that these fixes are based on my
reckoning of how FFI was intended to work, which may be wrong.

Henrik

-------------- next part --------------
'From Squeak2.8alpha of 7 February 2000 [latest update: #1974] on 16 April 2000 at 1:11:24 pm'!
Inspector subclass: #ExternalStructureInspector
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Tools-Inspector'!

!ByteArray methodsFor: 'external access' stamp: 'hg 2/28/2000 15:34'!
pointerAt: byteOffset put: value
	"Store a pointer object at the given byte address"
	value isExternalAddress ifFalse:[^self error:'Only external addresses can be stored'].
	1 to: 4 do:[:i|
		self unsignedByteAt: byteOffset+i-1 put: (value basicAt: i)].
	^value! !

!ByteArray methodsFor: 'external access' stamp: 'hg 2/28/2000 13:56'!
structAt: byteOffset length: length
	"Return a structure of the given length starting at the indicated byte offset."
	| value |
	value _ ByteArray new: length.
	1 to: length do:[:i|
		value unsignedByteAt: i put: (self unsignedByteAt: byteOffset+i-1)].
	^value! !


!ChangeSet methodsFor: 'fileIn/Out' stamp: 'hg 3/8/2000 19:57'!
fileOutInitializeFor: class on: stream 
	"Write out initialize for this class if it responds to it."

	(class respondsTo: #initialize) ifTrue: [
		stream nextChunkPut: class name, ' initialize'; cr]! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'sw 9/17/97 21:01'!
fileOutOn: stream 
	"Write out all the changes the receiver knows about"

	| classList |
	self isEmpty ifTrue: [self notify: 'Warning: no changes to file out'].
	classList _ ChangeSet superclassOrder: self changedClasses asOrderedCollection.
	classList do:
		[:aClass |  "if class defn changed, put it onto the file now"
			self fileOutClassDefinition: aClass on: stream].
	classList do:
		[:aClass |  "nb: he following no longer puts out class headers"
			self fileOutChangesFor: aClass on: stream].
	stream cr.
	classList do:
		[:aClass |
		self fileOutPSFor: aClass on: stream].
	classRemoves do:
		[:aClassName | stream nextChunkPut: 'Smalltalk removeClassNamed: #', aClassName; cr].! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'sw 5/20/1998 02:59'!
fileOutPSFor: class on: stream 
	"Write out removals and initialization for this class."

	(methodChanges at: class name ifAbsent: [^ self]) associationsDo: [:mAssoc | 
		(#(remove addedThenRemoved) includes: mAssoc value)
			ifTrue:
				[stream nextChunkPut: class name,
					' removeSelector: ', mAssoc key storeString; cr]
			ifFalse:
				[(mAssoc key = #initialize and: [class isMeta]) ifTrue:
					[stream nextChunkPut: class soleInstance name, ' initialize'; cr]]]! !


!ExternalAddress methodsFor: 'converting' stamp: 'hg 3/1/2000 22:27'!
asInteger
	"convert address to integer"
	^self inject: 0 into: [:total :byte | total * 256 + byte]! !

!ExternalAddress methodsFor: 'converting' stamp: 'hg 3/1/2000 23:00'!
fromInteger: address
	"set my handle to point at address"

	(4 to: 1 by: -1) inject: address into: [:remainder :index | 
		self at: index put: (remainder bitAnd: 255).
		remainder // 256]! !

!ExternalAddress methodsFor: 'printing' stamp: 'hg 3/1/2000 22:28'!
printOn: aStream
	"print this as a hex address ('@ 16rFFFFFFFF') to distinguish it from ByteArrays"

	aStream nextPutAll: '@ ', self asInteger hex8! !


!ExternalStructure methodsFor: 'inspecting' stamp: 'hg 2/28/2000 15:00'!
inspect
	"Open an ExternalStructureInspector on the receiver.  Use basicInspect to get a normal (less useful) type of inspector."

	self class fields size > 0 
		ifTrue: [ExternalStructureInspector openOn: self withEvalPane: true]
		ifFalse: [super inspect]! !

!ExternalStructure methodsFor: 'printing' stamp: 'hg 4/11/2000 13:11'!
longPrintOn: aStream 
	"Append to the argument, aStream, the names and values of all the record's variables."
	| fields |
	fields _ self class fields.
	(fields isEmpty or: [fields first isNil]) ifTrue: [fields _ #()]
		ifFalse: [(fields first isKindOf: Array) ifFalse: [fields _ Array with: fields]].
	fields do: [ :field | 
		aStream nextPutAll: field first; nextPut: $:; space; tab.
		field first == #nil ifFalse: [(self perform: field first) printOn: aStream].
		aStream cr].! !


!ExternalData methodsFor: 'conversion' stamp: 'hg 2/25/2000 14:51'!
fromCString
	"Assume that the receiver represents a C string and convert it to a Smalltalk string. hg 2/25/2000 14:18"

	| stream index char |
	type isPointerType ifFalse: [self error: 'External object is not a pointer type.'].
	stream _ WriteStream on: String new.
	index _ 1.
	[(char _ handle unsignedCharAt: index) = 0 asCharacter] whileFalse: [
		stream nextPut: char.
		index _ index + 1].
	^stream contents! !


!ExternalStructure class methodsFor: 'class initialization' stamp: 'hg 3/7/2000 21:31'!
initialize
	"fix for change set problem. Eg. FTLibrary needs to run defineFields on fileIn to work right. "

	self defineFields! !

!ExternalStructure class methodsFor: 'field definition' stamp: 'hg 2/29/2000 10:54'!
compileFields: specArray withAccessors: aBool
	"Define all the fields in the receiver.
	Return the newly compiled spec."
	| fieldName fieldType isPointerField externalType byteOffset typeSize typeSpec |
	(specArray size > 0 and:[specArray first class ~~ Array])
		ifTrue:[^self compileAlias: specArray withAccessors: aBool].
	byteOffset _ 1.
	typeSpec _ WriteStream on: (WordArray new: 10).
	typeSpec nextPut: (FFIFlagStructure). "dummy for size"
	specArray do:[:spec|
		fieldName _ spec first.
		fieldType _ spec second.
		isPointerField _ fieldType last = $*.
		fieldType _ (fieldType findTokens: ' *') first.
		externalType _ ExternalType atomicTypeNamed: fieldType.
		externalType == nil ifTrue:["non-atomic"
			Symbol hasInterned: fieldType ifTrue:[:sym|
				externalType _ ExternalType structTypeNamed: sym]].
		externalType == nil ifTrue:[
			Transcript show:'(', fieldType,' is void)'.
			externalType _ ExternalType void].
		isPointerField ifTrue:[externalType _ externalType asPointerType].
		typeSize _ externalType byteSize.
		spec size > 2 ifTrue:["extra size"
			spec third < typeSize ifTrue:[^self error:'Explicit type size is less than expected'].
			typeSize _ spec third].
		(fieldName ~~ #nil and:[aBool]) ifTrue:[
			self defineFieldAccessorsFor: fieldName 
				startingAt: byteOffset 
				type: externalType].
		typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
		byteOffset _ byteOffset + typeSize.
	].
	compiledSpec _ typeSpec contents.
	compiledSpec at: 1 put: (byteOffset - 1 bitOr: FFIFlagStructure).
	ExternalType noticeModificationOf: self.
	^compiledSpec! !


!ExternalStructureInspector methodsFor: 'selecting' stamp: 'hg 2/28/2000 14:12'!
replaceSelectionValue: anObject 
	"Add colon to fieldname to get setter selector, and send it to object with the argument.
	 Refer to the comment in Inspector|replaceSelectionValue:."

	selectionIndex = 1
		ifTrue: [^object]
		ifFalse: [^object perform: ((self fieldList at: selectionIndex), ':') asSymbol with: anObject]! !

!ExternalStructureInspector methodsFor: 'selecting' stamp: 'hg 2/28/2000 14:22'!
selection 
	"Refer to the comment in Inspector|selection."
	selectionIndex = 0 ifTrue:[^object printString].
	selectionIndex = 1 ifTrue: [^object].
	selectionIndex = 2 ifTrue:[^object longPrintString].
	selectionIndex > 2
		ifTrue: [^object perform: (self fieldList at: selectionIndex)]! !

!ExternalStructureInspector methodsFor: 'accessing' stamp: 'hg 2/28/2000 14:20'!
fieldList
	^  (Array with: 'self: ', object defaultLabelForInspector with: 'all inst vars'), self recordFieldList! !

!ExternalStructureInspector methodsFor: 'accessing' stamp: 'hg 2/28/2000 14:44'!
recordFieldList
	| fields |
	fields _ object class fields.
	(fields first isKindOf: Array) ifFalse: [^Array with: fields first].
	^fields collect: [ :field | field first ]! !


!Parser methodsFor: 'primitives' stamp: 'hg 2/29/2000 10:41'!
externalFunctionDeclaration
	"Parse the function declaration for a call to an external library."
	| descriptorClass callType retType externalName args argType module fn |
	descriptorClass _ Smalltalk at: #ExternalFunction ifAbsent:[nil].
	descriptorClass == nil ifTrue:[^0].
	callType _ descriptorClass callingConventionFor: here.
	callType == nil ifTrue:[^0].
	"Parse return type"
	self advance.
	retType _ self externalType: descriptorClass.
	retType == nil ifTrue:[^self expected:'return type'].
	"Parse function name or index"
	externalName _ here.
	(self match: #string) 
		ifTrue:[externalName _ externalName asSymbol]
		ifFalse:[(self match:#number) ifFalse:[^self expected:'function name or index']].
	(self matchToken:'(' asSymbol) ifFalse:[^self expected:'argument list'].
	args _ WriteStream on: Array new.
	[here == #)] whileFalse:[
		argType _ self externalType: descriptorClass.
		argType == nil ifTrue:[^self expected:'argument'].
		argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType].
	].
	(self matchToken:')' asSymbol) ifFalse:[^self expected:')'].
	(self matchToken: 'module:') ifTrue:[
		module _ here.
		(self match: #string) ifFalse:[^self expected: 'String'].
		module _ module asSymbol].
	Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn|
		fn _ xfn name: externalName 
				module: module 
				callType: callType
				returnType: retType
				argumentTypes: args contents.
		self allocateLiteral: fn.
	].
	^120! !


ExternalData removeSelector: #asCString!
ExternalStructure initialize!
ExternalStructureInspector removeSelector: #longPrintOn:!