Changeset 5760

Timestamp:

Jan 20, 2007, 11:05:54 PM (18 years ago)

Author:

Gary Byers

Message:

Use argument/result coercion functions in os::expand-ff-call.

Location:

trunk/ccl/lib

Files:

• ffi-linuxppc32.lisp (modified) (3 diffs)
• ffi-linuxppc64.lisp (modified) (2 diffs)

trunk/ccl/lib/ffi-linuxppc32.lisp

@@ -37 +37 @@
 
 
-(defun linux32::expand-ff-call (callform args)
+(defun linux32::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result))
   (let* ((result-type-spec (or (car (last args)) :void))
          (enclosing-form nil)
@@ -62 +62 @@
         (unless (evenp (length args))
           (error "~s should be an even-length list of alternating foreign types and values" args))        
-                (do* ((args args (cddr args)))
+        (do* ((args args (cddr args)))
              ((null args))
           (let* ((arg-type-spec (car args))
@@ -79 +79 @@
                   (progn
                     (argforms (foreign-type-to-representation-type ftype))
-                    (argforms arg-value-form)))))))
+                    (argforms (funcall arg-coerce arg-type-spec arg-value-form))))))))
         (argforms (foreign-type-to-representation-type result-type))
-        (let* ((call `(,@callform ,@(argforms))))
+        (let* ((call (funcall result-coerce result-type-spec `(,@callform ,@(argforms)))))
           (if enclosing-form
             `(,@enclosing-form ,call)

trunk/ccl/lib/ffi-linuxppc64.lisp

@@ -36 +36 @@
       (typep ftype 'foreign-record-type))))
 
-(defun linux64::expand-ff-call (callform args)
+(defun linux64::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result))
   (let* ((result-type-spec (or (car (last args)) :void)))
     (multiple-value-bind (result-type error)
@@ -75 +75 @@
                   (progn
                     (argforms (foreign-type-to-representation-type ftype))
-                    (argforms arg-value-form)))))))
+                    (argforms (funcall arg-coerce arg-type-spec arg-value-form))))))))
         (argforms (foreign-type-to-representation-type result-type))
-        `(,@callform ,@(argforms))))))
+        (funcall result-coerce result-type-spec `(,@callform ,@(argforms)))))))