fixes to adapt it to new UFFI

src/ObjectiveC/ObjCCalloutMethodBuilder.class.st

@@ -4,14 +4,18 @@ I'm a callout builder for Objective-C methods.
 Class {
 	#name : #ObjCCalloutMethodBuilder,
 	#superclass : #FFICalloutMethodBuilder,
+	#instVars : [
+		'message'
+	],
 	#category : #'ObjectiveC-Builder'
 }
 
 { #category : #'builder api' }
-ObjCCalloutMethodBuilder class >> buildMethod: objCMethod sender: aContext [
+ObjCCalloutMethodBuilder class >> buildMethod: objCMethod message: aMessage sender: aContext [
 
 	^ self new 
 		sender: aContext;
+		message: aMessage;
 		requestor: (FFICallout new
 			requestor: ObjCLibrary;
 			yourself);
@@ -20,33 +24,54 @@ ObjCCalloutMethodBuilder class >> buildMethod: objCMethod sender: aContext [
 
 { #category : #private }
 ObjCCalloutMethodBuilder >> adaptSpecToReturnType: aSpec [
+
 	aSpec functionName: (self msgSendFunctionForReturnType: aSpec returnType)
 ]
 
+{ #category : #accessing }
+ObjCCalloutMethodBuilder >> argumentNames [
+
+	^ self message arguments 
+		withIndexCollect: [ :each :index | 'arg', index printString ]
+]
+
 { #category : #'builder api' }
 ObjCCalloutMethodBuilder >> buildMethod: objCMethod [
-	| spec |
+	| spec argumentNames |
 
 	spec := ObjCSpecParser new parseMethod: objCMethod.
 	spec resolveUsing: self requestor.
+	"loader for self"
+	spec arguments first loader: (FFISelfArgument new).
+	"loader for SEL"
+	spec arguments second loader: (FFILiteralArgument value: self message selector asObjCSelector).
+	"loader for arguments"
+	argumentNames := self argumentNames.
+	(spec arguments allButFirst: 2) withIndexDo: [ :each :index |
+		each loader: (FFIMethodArgument new
+			argName: (argumentNames at: index);
+			index: index;
+			yourself) ].
+
 	self adaptSpecToReturnType: spec.
 	^ self generateMethodFromSpec: spec
 ]
 
 { #category : #accessing }
 ObjCCalloutMethodBuilder >> callType [
+
 	^ 0 "cdecl"
 ]
 
 { #category : #'private factory' }
 ObjCCalloutMethodBuilder >> createFFICalloutLiteralFromSpec: spec [
 	| externalFunction return arguments |
 
-	return := spec returnType externalTypeWithArity.
+	return := spec returnType tfExternalTypeWithArity.
 	arguments := spec arguments collect: [ :each | each tfExternalTypeWithArity ].
 	spec returnType isTypeStructure ifTrue: [ 
 		arguments := arguments copyWithFirst: spec returnType tfExternalType asPointerType.
-		return := FFIVoid externalType ].
+		return := FFIVoid new tfExternalType ].
 
 	externalFunction := TFExternalFunction
 		name: spec functionName
@@ -121,11 +146,25 @@ ObjCCalloutMethodBuilder >> generateMethodFromSpec: spec [
 
 { #category : #accessing }
 ObjCCalloutMethodBuilder >> libraryName [
+
 	^ ObjCLibrary uniqueInstance libraryName
 ]
 
+{ #category : #accessing }
+ObjCCalloutMethodBuilder >> message [
+
+	^ message
+]
+
+{ #category : #accessing }
+ObjCCalloutMethodBuilder >> message: aMessage [
+
+	message := aMessage
+]
+
 { #category : #private }
 ObjCCalloutMethodBuilder >> msgSendFunctionForReturnType: aType [
+
 	aType isTypeStructure ifTrue: [ ^ 'objc_msgSend_stret' ].
 	aType isTypeFloat ifTrue: [ ^ 'objc_msgSend_fpret' ].
 	^ 'objc_msgSend'

src/ObjectiveC/ObjCObject.class.st

@@ -46,7 +46,7 @@ ObjCObject >> doesNotUnderstand: aMessage [
 
 	shadowMethod := self installedMethodForMessage: aMessage sender: thisContext sender.
 	shadowMethod ifNil: [ ^ super doesNotUnderstand: aMessage ].
-	arguments := ({ self. aMessage selector asObjCSelector }, (aMessage arguments collect: #adaptToObjC)).
+	arguments := aMessage arguments collect: [ :each | each adaptToObjC ].
 	^ shadowMethod 
 		valueWithReceiver: self
 		arguments: arguments
@@ -82,15 +82,16 @@ ObjCObject >> installedMethodForMessage: aMessage sender: aContext [
 	objCMethod := self objCMethodForSelector: aMessage selector.
 	(objCMethod isNil or: [ objCMethod isNull ]) 
 		ifTrue: [ ^ nil ].
+
 	^ self 
 		installMethodAt: aMessage selector
-		implementation: ((ObjCCalloutMethodBuilder buildMethod: objCMethod sender: aContext)
-				selector: ((aMessage numArgs = 0
-					ifTrue: [ aMessage selector, #_rec:_sel: ]
-					ifFalse: [ #_rec:_sel:, aMessage selector ])
-					asSymbol);
-				methodClass: self class;
-				yourself)
+		implementation: ((ObjCCalloutMethodBuilder 
+				buildMethod: objCMethod 
+				message: aMessage 
+				sender: aContext)
+			selector: aMessage selector;
+			methodClass: self class;
+			yourself)
 ]
 
 { #category : #accessing }

src/ObjectiveC/ObjCProxyCallback.class.st

@@ -15,10 +15,9 @@ ObjCProxyCallback >> parseSignature: signature [
 { #category : #evaluation }
 ObjCProxyCallback >> valueWithArguments: args [
 
-	^ [ block 
-			value: args first "self"
-			value: args second "SEL"
-			value: (args allButFirst: 2) "arguments" ]
+	^ [ 
+			"skip self, SEL and keep just the arguments"
+			block value: (args allButFirst: 2) ]
 		on: Error 
 		fork: [ :e | e debug ]
 		return: [ self returnOnError ]

src/ObjectiveC/ObjCSpecParser.class.st

@@ -125,26 +125,30 @@ ObjCSpecParser >> newFunctionParser [
 
 { #category : #'private parsing' }
 ObjCSpecParser >> nextStructure: aStream [
-	^ FFICallout new 
+
+	^ ObjCTypeDeclaration newType: (FFICallout new 
 		requestor: self;
-		resolveType: (aStream upTo: $=)
+		resolveType: (aStream upTo: $=))
 ]
 
 { #category : #'private parsing' }
 ObjCSpecParser >> nextType: aStream [
 	| ch |
+
 	[ TypeQualifiers includes: (ch := aStream next) ] whileTrue.
  	(self isStructure: ch) ifTrue: [ ^ self nextStructure: aStream ].
 	((self isObject: ch) and: [ aStream peek = $? ]) ifTrue: [ 
 		aStream skip: 1.
 		ch := $? ].
-	^ FFICallout new 
+
+	^ ObjCTypeDeclaration newType: (FFICallout new 
 		requestor: ObjCLibrary;
-		resolveType: (MethodTypeMap at: ch)
+		resolveType: (MethodTypeMap at: ch))
 ]
 
 { #category : #parsing }
 ObjCSpecParser >> parseMethod: anObjCMethod [
+
 	^ FFIFunctionSpec new
 		returnType: (self parseType: anObjCMethod returnType);
 		arguments: (anObjCMethod argumentTypes 

src/ObjectiveC/ObjCTypeDeclaration.class.st

@@ -0,0 +1,56 @@
+Class {
+	#name : #ObjCTypeDeclaration,
+	#superclass : #FFITypeDeclaration,
+	#category : #'ObjectiveC-Builder'
+}
+
+{ #category : #'instance creation' }
+ObjCTypeDeclaration class >> newType: aResolvedType [
+
+	^ self new 
+		resolvedType: aResolvedType;
+		yourself
+]
+
+{ #category : #'emitting code' }
+ObjCTypeDeclaration >> emitArgument: anIRBuilder context: aContext inCallout: aCallout [
+
+	self resolvedType emitArgument: anIRBuilder context: aContext inCallout: aCallout
+]
+
+{ #category : #'emitting code' }
+ObjCTypeDeclaration >> emitReturnArgument: anIRBuilder context: aContext [
+
+	self resolvedType
+		emitReturnArgument: anIRBuilder
+		context: aContext
+]
+
+{ #category : #testing }
+ObjCTypeDeclaration >> isTypeFloat [
+
+	^ self resolvedType isTypeFloat
+]
+
+{ #category : #testing }
+ObjCTypeDeclaration >> isTypeStructure [
+
+	^ self resolvedType isTypeStructure
+]
+
+{ #category : #accessing }
+ObjCTypeDeclaration >> loader: aLoader [
+
+	self resolvedType loader: aLoader
+]
+
+{ #category : #resolution }
+ObjCTypeDeclaration >> resolveUsing: aRequestor [
+	"not used, I already solved it"
+]
+
+{ #category : #accessing }
+ObjCTypeDeclaration >> resolvedType: aResolvedType [
+
+	resolvedType := aResolvedType
+]