From 8ef5eaeca252ce5f6c00842dee10f7e9d110dd12 Mon Sep 17 00:00:00 2001
From: Abdulaziz Ghuloum <aghuloum@cs.indiana.edu>
Date: Wed, 20 May 2009 09:58:03 +0300
Subject: [PATCH] - better error message for using make-c-callout and
 make-c-callback   when ffi support is not enabled.

---
 scheme/ikarus.pointers.ss | 20 ++++++++++++++------
 scheme/last-revision      |  2 +-
 src/ikarus-ffi.c          | 10 ++++++++--
 3 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/scheme/ikarus.pointers.ss b/scheme/ikarus.pointers.ss
index 793cf5b..3027272 100644
--- a/scheme/ikarus.pointers.ss
+++ b/scheme/ikarus.pointers.ss
@@ -232,8 +232,7 @@
  
 
 
-  (define (ffi-prep-cif rtype argtypes)
-    (define who 'ffi-prep-cif)
+  (define (ffi-prep-cif who rtype argtypes)
     (define (convert x)
       (cond
         [(vector? x) (vector-map convert x)]
@@ -259,14 +258,20 @@
     (let ([argtypes-n (vector-map convert (list->vector argtypes))]
           [rtype-n (convert rtype)])
       (values (or (foreign-call "ikrt_ffi_prep_cif" rtype-n argtypes-n)
-                  (die who "failed to initialize" rtype argtypes))
+                  (if (ffi-enabled?)
+                      (die who "failed to initialize" rtype argtypes)
+                      (die who "FFI support is not enabled.  \
+                                You need to recompile ikarus with \
+                                --enable-ffi option set in order to \
+                                make use of the (ikarus foreign) \
+                                library.")))
               argtypes-n
               rtype-n)))
 
   (define (make-c-callout rtype argtypes)
     (define who 'make-c-callout)
     (let-values ([(cif argtypes-n rtype-n)
-                  (ffi-prep-cif rtype argtypes)])
+                  (ffi-prep-cif who rtype argtypes)])
       (let* ([argtypes-vec (list->vector argtypes)]
              [checkers (vector-map (checker who) argtypes-vec)])
         (lambda (cfun)
@@ -290,10 +295,10 @@
               (foreign-call "ikrt_ffi_call" data argsvec)))))))
 
   (define (make-c-callback rtype argtypes)
+    (define who 'make-c-callback)
     (let-values ([(cif argtypes-n rtype-n)
-                  (ffi-prep-cif rtype argtypes)])
+                  (ffi-prep-cif who rtype argtypes)])
       (lambda (proc)
-        (define who 'make-c-callback)
         (unless (procedure? proc)
           (die who "not a procedure"))
         (let ([proc 
@@ -312,6 +317,9 @@
           (let ([data (vector cif proc argtypes-n rtype-n)])
             (or (foreign-call "ikrt_prepare_callback" data)
                 (die who "cannot prepare foreign callback")))))))
+  
+  (define (ffi-enabled?) 
+    (foreign-call "ikrt_has_ffi"))
 
   (define (errno)
     (foreign-call "ikrt_last_errno"))
diff --git a/scheme/last-revision b/scheme/last-revision
index 7e8e818..9c514f9 100644
--- a/scheme/last-revision
+++ b/scheme/last-revision
@@ -1 +1 @@
-1783
+1784
diff --git a/src/ikarus-ffi.c b/src/ikarus-ffi.c
index b32ecfc..ffa94bc 100644
--- a/src/ikarus-ffi.c
+++ b/src/ikarus-ffi.c
@@ -369,6 +369,9 @@ ikrt_ffi_call(ikptr data, ikptr argsvec, ikpcb* pcb)  {
 }
 
 
+ikptr ikrt_has_ffi(/*ikpcb* pcb*/){
+  return true_object;
+}
 
 /*
 
@@ -557,9 +560,12 @@ void hello_world(int n) {
 }
 
 #else
-ikptr ikrt_ffi_prep_cif()    { return false_object; }
-ikptr ikrt_ffi_call()              { return false_object; }
+ikptr ikrt_ffi_prep_cif()     { return false_object; }
+ikptr ikrt_ffi_call()         { return false_object; }
 ikptr ikrt_prepare_callback() { return false_object; }
+ikptr ikrt_has_ffi()         { return false_object; }
+
+
 #endif