[plt-scheme] FFI problems

From: Henk Boom (lunarc.lists at gmail.com)
Date: Tue Sep 25 18:35:55 EDT 2007

Hi, I'm having a problem with the (lib "foreign.ss") library.

The following C code works fine:
#include <gtk/gtk.h>

gboolean delete_event(GtkWidget *widget, GdkEvent *event, gpointer data )
{
    g_print("delete\n");
    return TRUE;
}

int main(int argc, char *argv[])
{
    gtk_init (NULL, NULL);
    GtkWidget *window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
    g_signal_connect_object(
        window,
        "delete_event",
        G_CALLBACK(delete_event),
        NULL,
        0);
    gtk_widget_show(window);
    gtk_main();

    return 0;
}

But the following scheme code gives me a segfault, which is strange
since AFAIK it should be doing operations identical to the above C
code.

(module gtk mzscheme
  (require (lib "foreign.ss"))

  (unsafe!)

  (define-syntax provide-fun
    (syntax-rules ()
      ((provide-fun lib name str . sig)
        (begin
          (provide name)
          (define name (get-ffi-obj str lib (_fun . sig)))))))
  (define-syntax provide-fun*
    (syntax-rules ()
      ((provide-fun* lib fun)
        (provide-fun lib . fun))
      ((provide-fun* lib fun . rest)
        (begin
          (provide-fun lib . fun)
          (provide-fun* lib . rest)))))

  (define-syntax provide-constant
    (syntax-rules ()
      ((provide-constant name value)
        (begin
          (provide name)
          (define name value)))))
  (define-syntax provide-constant*
    (syntax-rules ()
      ((provide-constant* const)
        (provide-constant . const))
      ((provide-constant* const . rest)
        (begin
          (provide-constant . conts)
          (provide-constant* . rest)))))

  (define gobject-lib (ffi-lib "libgobject-2.0"))
  (define gtk-lib (ffi-lib "libgtk"))

  (provide-fun* gtk-lib
    (gtk_init        "gtk_init"         _pointer _pointer -> _void)
    (gtk_window_new  "gtk_window_new"   _int -> _pointer)
    (gtk_widget_show "gtk_widget_show"  _pointer -> _void)
    (gtk_main        "gtk_main"         -> _void))

  (provide-fun* gobject-lib
    (g_signal_connect_object "g_signal_connect_object"
      _pointer
      _string
      ; This is not general enough, but it's good enough for the example
      (_fun _pointer _pointer _pointer -> _bool)
      _pointer
      _int
      -> _ulong))

  (provide-constant*
    (GTK_WINDOW_TOPLEVEL 0))

  ) ;; end module

(module hello-world mzscheme
  (require (lib "foreign.ss"))
  (require "gtk.ss")

  (gtk_init #f #f)
  (define window (gtk_window_new GTK_WINDOW_TOPLEVEL))
  (g_signal_connect_object
    window
    "delete_event"
    (lambda (a b c)
      (printf "delete event callback called~n")
      #t)
    #f
    0)
  (gtk_widget_show window)
  (gtk_main)

  ) ;; end module

With this code I get the error:
Seg fault (internal error) at 0x9d1b
Aborted

I apologize if I'm just missing something simple, but this is really
getting on my nerves.

Have a nice day,
    Henk Boom

P.S.: Also, is there a way to have the external object names in the
above macros automatically generated from the name given for the
procedure? I know it's simple with define-macro, but I'm not sure how
to do it with define-syntax.


Posted on the users mailing list.