FFIPragma experiment

Andreas Raab andreas.raab at gmx.de
Sat Aug 19 07:43:34 UTC 2006


Heh. Here is yet another interesting data point in this discussion. I 
just went ahead and implemented an FFIPragma just like I mentioned 
before (I'm attaching the changes because they are so hillariously 
simple). It does everything I promised (printing, decompile, browsing 
etc) BUT there is this interesting issue that because of the way the 
compiler got changed, an FFI method now prints like here:

apiDeleteDC: aHDC
	<apicall: bool 'DeleteDC' (Win32HDC) module: 'gdi32.dll'>
	<primitive: 120>
	^ self externalCallFailed

How come? Because the parser currently only picks up primitives if they 
are registered as pragmas (see pragmaPrimitives). And so, although an 
FFI call *implies* a primitive this primitive should really never be 
exposed via pragmas. This is equivalent to "quick" primitives which 
don't (and shouldn't) show up either.

Which illustrates once more that a primitive isn't a pragma and cannot 
be treated as one.

Cheers,
   - Andreas
-------------- next part --------------
'From Squeak3.9gamma of ''23 July 2006'' [latest update: #7051] on 19 August 2006 at 12:38:28 am'!
Pragma subclass: #FFIPragma
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'FFI-Parser'!

!FFIPragma commentStamp: 'ar 8/19/2006 00:17' prior: 0!
A pseudo pragma representing an FFI specification.!


!FFIPragma methodsFor: 'printing' stamp: 'ar 8/19/2006 00:22'!
printOn: aStream
	"Print just the argument"
	^arguments first printOn: aStream.! !


!Parser methodsFor: 'primitives' stamp: 'ar 8/19/2006 00:18'!
externalFunctionDeclaration
	"Parse the function declaration for a call to an external library."
	| descriptorClass callType retType externalName args argType module fn key |
	descriptorClass := Smalltalk at: #ExternalFunction ifAbsent:[nil].
	descriptorClass == nil ifTrue:[^false].
	key := here asSymbol. "remember for FFIPragma later"
	callType := descriptorClass callingConventionFor: here.
	callType == nil ifTrue:[^false].
	"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 == ')' asSymbol] 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.
	].
	self addPragma: (FFIPragma keyword: key arguments: {fn}).
	self addPragma: (Pragma keyword: #primitive: arguments: #(120)).
	^true! !



More information about the Squeak-dev mailing list